11
11
# See the License for the specific language governing permissions and limitations under the License.
12
12
13
13
# ##############################################
14
- tidyhydat_realtime_csv_parser <- function (file ) {
14
+ realtime_parser <- function (file ) {
15
15
req <- httr2 :: request(file )
16
16
req <- httr2 :: req_user_agent(req , " https://github.com/ropensci/tidyhydat" )
17
17
req <- httr2 :: req_error(req , is_error = function (resp ) FALSE )
@@ -58,78 +58,46 @@ single_realtime_station <- function(station_number) {
58
58
)
59
59
60
60
# 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()
74
62
75
- h_resp_str <- tidyhydat_realtime_csv_parser (infile [1 ])
63
+ h_resp_str <- realtime_parser (infile [1 ])
76
64
if (is.na(h_resp_str )) {
77
65
h <- dplyr :: tibble(
78
66
A = station_number , B = NA , C = NA , D = NA , E = NA ,
79
67
F = NA , G = NA , H = NA , I = NA , J = NA
80
68
)
81
69
colnames(h ) <- colHeaders
70
+ h <- readr :: type_convert(h , realtime_cols_types())
82
71
} else {
83
72
h <- readr :: read_csv(
84
73
h_resp_str ,
74
+ skip = 1 ,
85
75
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()
98
77
)
99
78
}
100
79
101
80
102
81
# download daily file
103
- p_resp_str <- tidyhydat_realtime_csv_parser (infile [2 ])
82
+ p_resp_str <- realtime_parser (infile [2 ])
104
83
105
84
if (is.na(p_resp_str )) {
106
85
d <- dplyr :: tibble(
107
86
A = station_number , B = NA , C = NA , D = NA , E = NA ,
108
87
F = NA , G = NA , H = NA , I = NA , J = NA
109
88
)
110
- colnames(h ) <- colHeaders
89
+ colnames(d ) <- colHeaders
90
+ d <- readr :: type_convert(d , realtime_cols_types())
111
91
} else {
112
92
d <- readr :: read_csv(
113
93
p_resp_str ,
94
+ skip = 1 ,
114
95
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()
127
97
)
128
98
}
129
99
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)
133
101
p <- dplyr :: filter(d , Date < min(h $ Date ))
134
102
output <- dplyr :: bind_rows(p , h )
135
103
@@ -141,45 +109,52 @@ all_realtime_station <- function(PROV) {
141
109
base_url <- " https://dd.weather.gc.ca/hydrometric/csv/"
142
110
prov_url <- paste0(base_url , PROV , " /daily/" , PROV , " _daily_hydrometric.csv" )
143
111
144
- res <- tidyhydat_realtime_csv_parser (prov_url )
112
+ res <- realtime_parser (prov_url )
145
113
146
114
# 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()
160
116
161
117
output <- readr :: read_csv(
162
118
res ,
163
119
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()
176
121
)
177
122
178
123
179
124
# # Offloading tidying to another function
180
125
realtime_tidy_data(output , PROV )
181
126
}
182
127
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
+
183
158
184
159
realtime_tidy_data <- function (data , prov ) {
185
160
# # Create symbols
0 commit comments