Skip to content

Commit e71184e

Browse files
committed
bit more clean up
1 parent c1713ef commit e71184e

File tree

3 files changed

+47
-72
lines changed

3 files changed

+47
-72
lines changed

R/realtime.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -101,7 +101,7 @@ realtime_stations <- function(prov_terr_state_loc = NULL) {
101101
prov <- prov_terr_state_loc
102102

103103
realtime_link <- "https://dd.weather.gc.ca/hydrometric/doc/hydrometric_StationList.csv"
104-
resp_str <- tidyhydat_realtime_csv_parser(realtime_link)
104+
resp_str <- realtime_parser(realtime_link)
105105

106106
net_tibble <- readr::read_csv(
107107
resp_str,

R/utils-realtime.R

Lines changed: 45 additions & 70 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,7 @@
1111
# See the License for the specific language governing permissions and limitations under the License.
1212

1313
###############################################
14-
tidyhydat_realtime_csv_parser <- function(file) {
14+
realtime_parser <- function(file) {
1515
req <- httr2::request(file)
1616
req <- httr2::req_user_agent(req, "https://github.com/ropensci/tidyhydat")
1717
req <- httr2::req_error(req, is_error = function(resp) FALSE)
@@ -58,78 +58,46 @@ single_realtime_station <- function(station_number) {
5858
)
5959

6060
# Define column names as the same as HYDAT
61-
colHeaders <-
62-
c(
63-
"STATION_NUMBER",
64-
"Date",
65-
"Level",
66-
"Level_GRADE",
67-
"Level_SYMBOL",
68-
"Level_CODE",
69-
"Flow",
70-
"Flow_GRADE",
71-
"Flow_SYMBOL",
72-
"Flow_CODE"
73-
)
61+
colHeaders <- realtime_cols_headers()
7462

75-
h_resp_str <- tidyhydat_realtime_csv_parser(infile[1])
63+
h_resp_str <- realtime_parser(infile[1])
7664
if (is.na(h_resp_str)) {
7765
h <- dplyr::tibble(
7866
A = station_number, B = NA, C = NA, D = NA, E = NA,
7967
F = NA, G = NA, H = NA, I = NA, J = NA
8068
)
8169
colnames(h) <- colHeaders
70+
h <- readr::type_convert(h, realtime_cols_types())
8271
} else {
8372
h <- readr::read_csv(
8473
h_resp_str,
74+
skip = 1,
8575
col_names = colHeaders,
86-
col_types = readr::cols(
87-
STATION_NUMBER = readr::col_character(),
88-
Date = readr::col_datetime(),
89-
Level = readr::col_double(),
90-
Level_GRADE = readr::col_character(),
91-
Level_SYMBOL = readr::col_character(),
92-
Level_CODE = readr::col_integer(),
93-
Flow = readr::col_double(),
94-
Flow_GRADE = readr::col_character(),
95-
Flow_SYMBOL = readr::col_character(),
96-
Flow_CODE = readr::col_integer()
97-
)
76+
col_types = realtime_cols_types()
9877
)
9978
}
10079

10180

10281
# download daily file
103-
p_resp_str <- tidyhydat_realtime_csv_parser(infile[2])
82+
p_resp_str <- realtime_parser(infile[2])
10483

10584
if (is.na(p_resp_str)) {
10685
d <- dplyr::tibble(
10786
A = station_number, B = NA, C = NA, D = NA, E = NA,
10887
F = NA, G = NA, H = NA, I = NA, J = NA
10988
)
110-
colnames(h) <- colHeaders
89+
colnames(d) <- colHeaders
90+
d <- readr::type_convert(d, realtime_cols_types())
11191
} else {
11292
d <- readr::read_csv(
11393
p_resp_str,
94+
skip = 1,
11495
col_names = colHeaders,
115-
col_types = readr::cols(
116-
STATION_NUMBER = readr::col_character(),
117-
Date = readr::col_datetime(),
118-
Level = readr::col_double(),
119-
Level_GRADE = readr::col_character(),
120-
Level_SYMBOL = readr::col_character(),
121-
Level_CODE = readr::col_integer(),
122-
Flow = readr::col_double(),
123-
Flow_GRADE = readr::col_character(),
124-
Flow_SYMBOL = readr::col_character(),
125-
Flow_CODE = readr::col_integer()
126-
)
96+
col_types = realtime_cols_types()
12797
)
12898
}
12999

130-
131-
132-
# now merge the hourly + daily (hourly data overwrites daily where dates are the same)
100+
# now append the hourly + daily (hourly data overwrites daily where dates are the same)
133101
p <- dplyr::filter(d, Date < min(h$Date))
134102
output <- dplyr::bind_rows(p, h)
135103

@@ -141,45 +109,52 @@ all_realtime_station <- function(PROV) {
141109
base_url <- "https://dd.weather.gc.ca/hydrometric/csv/"
142110
prov_url <- paste0(base_url, PROV, "/daily/", PROV, "_daily_hydrometric.csv")
143111

144-
res <- tidyhydat_realtime_csv_parser(prov_url)
112+
res <- realtime_parser(prov_url)
145113

146114
# Define column names as the same as HYDAT
147-
colHeaders <-
148-
c(
149-
"STATION_NUMBER",
150-
"Date",
151-
"Level",
152-
"Level_GRADE",
153-
"Level_SYMBOL",
154-
"Level_CODE",
155-
"Flow",
156-
"Flow_GRADE",
157-
"Flow_SYMBOL",
158-
"Flow_CODE"
159-
)
115+
colHeaders <- realtime_cols_headers()
160116

161117
output <- readr::read_csv(
162118
res,
163119
col_names = colHeaders,
164-
col_types = readr::cols(
165-
STATION_NUMBER = readr::col_character(),
166-
Date = readr::col_datetime(),
167-
Level = readr::col_double(),
168-
Level_GRADE = readr::col_character(),
169-
Level_SYMBOL = readr::col_character(),
170-
Level_CODE = readr::col_integer(),
171-
Flow = readr::col_double(),
172-
Flow_GRADE = readr::col_character(),
173-
Flow_SYMBOL = readr::col_character(),
174-
Flow_CODE = readr::col_integer()
175-
)
120+
col_types = realtime_cols_types()
176121
)
177122

178123

179124
## Offloading tidying to another function
180125
realtime_tidy_data(output, PROV)
181126
}
182127

128+
realtime_cols_types <- function() {
129+
readr::cols(
130+
STATION_NUMBER = readr::col_character(),
131+
Date = readr::col_datetime(),
132+
Level = readr::col_double(),
133+
Level_GRADE = readr::col_character(),
134+
Level_SYMBOL = readr::col_character(),
135+
Level_CODE = readr::col_integer(),
136+
Flow = readr::col_double(),
137+
Flow_GRADE = readr::col_character(),
138+
Flow_SYMBOL = readr::col_character(),
139+
Flow_CODE = readr::col_integer()
140+
)
141+
}
142+
143+
realtime_cols_headers <- function() {
144+
c(
145+
"STATION_NUMBER",
146+
"Date",
147+
"Level",
148+
"Level_GRADE",
149+
"Level_SYMBOL",
150+
"Level_CODE",
151+
"Flow",
152+
"Flow_GRADE",
153+
"Flow_SYMBOL",
154+
"Flow_CODE"
155+
)
156+
}
157+
183158

184159
realtime_tidy_data <- function(data, prov) {
185160
## Create symbols

R/zzz.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@
1818
packageStartupMessage(info("Checking for a new version of HYDAT..."))
1919

2020
base_url <- "http://collaboration.cmc.ec.gc.ca/cmc/hydrometrics/www/"
21-
x <- tidyhydat_realtime_csv_parser(base_url)
21+
x <- realtime_parser(base_url)
2222

2323
## Extract newest HYDAT
2424
new_hydat <- as.Date(substr(gsub(

0 commit comments

Comments
 (0)