-
Notifications
You must be signed in to change notification settings - Fork 1
/
util.r
278 lines (264 loc) · 8.57 KB
/
util.r
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
cimis.tz = "Etc/GMT+8"
empty.record = tibble(
Date = as.Date(character(0)),
Hour = character(0),
Julian = integer(0),
Station = character(0),
Standard = character(0),
ZipCodes = character(0),
Scope = character(0),
Item = character(0),
Value = character(0),
Qc = character(0)
)
#' Quick Fix to as_tibble
#'
#' Handle empty lists when coercing to tibble. See
#' [tibble issue 851](https://github.com/tidyverse/tibble/issues/851).
#'
#' @param d An object to coerce to a tibble.
#' @return a tibble.
#' @importFrom purrr modify_if
#' @keywords internal
as_tibble_fix = function(d) {
as_tibble(modify_if(d, ~ identical(.x, list()),
~ list(NULL)))
}
#' To Datetime
#'
#' Collapse The Date and Hour columns to a single DateTime Column.
#'
#' @param d A data frame of CIMIS data results.
#' @return The data frame, with a new `"Datetime"` column replacing
#' the `"Date"` and `"Hour"` columns.
#'
#' @details According to the
#' [CIMIS Report FAQs](https://cimis.water.ca.gov/Default.aspx),
#' all CIMIS data is based on Pacific Standard Time (PST).
#'
#' @examples
#' if(is_key_set()) {
#' d = cimis_data(targets = 170, start.date = Sys.Date() - 4,
#' end.date = Sys.Date() - 1, items = "hly-air-tmp")
#' cimis_to_datetime(d)
#' }
#' @importFrom dplyr select mutate if_else rename
#' @importFrom stringr str_c
#' @export
cimis_to_datetime = function(d) {
if (!("Hour" %in% names(d)))
d = mutate(d, Hour = "0000")
rename(select(mutate(d,
Hour = if_else(is.na(.data$Hour), "0000", .data$Hour),
Date = as.POSIXct(str_c(.data$Date, " ", .data$Hour),
format = "%Y-%m-%d %H%M", tz = cimis.tz)),
-.data$Hour
), Datetime = .data$Date)
}
#' Record to Data Frame
#'
#' Convert a single record, containing one or more data items, to a to
#' a single data frame.
#'
#' @param record A single CIMIS record, in list format.
#' @return A data frame. The column `"Item"` identifies the data item.
#'
#' @importFrom tidyr unnest
#' @importFrom dplyr mutate bind_rows setdiff as_tibble
#' @importFrom purrr map
#' @importFrom rlang .data
#' @keywords internal
record_to_df = function(record) {
if (identical(record, list())) {
return(empty.record)
}
fixed = c("Date", "Hour", "Julian", "Station", "Standard",
"ZipCodes", "Scope")
data.names = setdiff(names(record), fixed)
other.names = setdiff(names(record), data.names)
unnest(mutate(as_tibble(record[other.names]),
Date = as.Date(.data$Date),
Julian = as.integer(.data$Julian),
Data = list(bind_rows(map(record[data.names], as_tibble),
.id = "Item"))
), cols = c(.data$Data))
}
#' Bind Records
#'
#' Bind CIMIS records into a single data frame. This function
#' is used internally.
#'
#' @param result CIMIS query results.
#' @return A data frame.
#'
#' @importFrom tidyr unnest
#' @importFrom purrr map_dfr
#' @importFrom dplyr mutate bind_rows as_tibble case_when
#' across matches
#' @importFrom rlang .data
#' @keywords internal
bind_records = function(result) {
mutate(unnest(mutate(
map_dfr(result[[c("Data", "Providers")]], as_tibble),
Records = map(.data$Records, record_to_df)),
cols = c(.data$Records)), across(matches("Value"), as.numeric))
}
#' Split CIMIS Query
#'
#' Split a large CIMIS query into multiple smaller queries based on a
#' time interval.
#'
#' @inheritParams cimis_data
#' @param max.records The maximum number of records returned by a
#' query. The default value is the the maximum data limit allowed by
#' the CIMIS Web API (1,750 records).
#' @return A data frame with columns "targets", "start.date",
#' "end.date", and "items".
#'
#' @details Queries are not split by `targets` or `items`, i.e. each
#' resulting query will include all targets and items.
#'
#' @examples
#' cimis_split_query(170, "2000-01-01", "2010-12-31", "day-air-tmp-avg")
#' cimis_split_query(c(149, 170), "2018-01-01", "2018-12-31",
#' c("day-air-tmp-avg", "hly-air-tmp", "hly-rel-hum"))
#'
#' @importFrom dplyr tibble n mutate bind_rows
#' @export
cimis_split_query = function(targets, start.date, end.date, items,
max.records = 1750L) {
hourly.items = intersect(items, cimis_items("Hourly")[["Data Item"]])
daily.items = intersect(items, cimis_items("Daily")[["Data Item"]])
if (length(hourly.items) > 0L) {
hourly.ranges = mutate(date_seq(start.date, end.date, max.records,
24 * length(targets) * length(hourly.items)),
items = rep(list(hourly.items), n()))
} else {
hourly.ranges = NULL
}
if (length(daily.items) > 0L) {
daily.ranges = mutate(date_seq(start.date, end.date, max.records,
length(targets) * length(daily.items)),
items = rep(list(daily.items), n()))
} else {
daily.ranges = NULL
}
mutate(bind_rows(daily.ranges, hourly.ranges),
targets = rep(list(targets), n()))
}
#' @importFrom dplyr tibble
#' @importFrom utils head tail
#' @keywords internal
date_seq = function(start.date, end.date, max.length, multiplier) {
start.date = as.Date(start.date)
end.date = as.Date(end.date)
num.records = as.numeric(end.date - start.date) * multiplier
if (num.records < max.length) {
tibble(start.date = start.date, end.date = end.date)
} else {
num.queries = as.integer(ceiling(num.records / max.length))
seq.start = seq(start.date, end.date, length.out = num.queries + 1)
starts = head(seq.start, -1)
ends = c(head(tail(seq.start, -1), -1) - 1, tail(seq.start, 1))
tibble(start.date = starts, end.date = ends)
}
}
#' Compass Direction To Degrees
#'
#' Convert the Compass direction labels to degrees.
#'
#' @param x A vector of compass directions, i.e. the data item labels
#' "DayWindNnw", "DayWindSse", etc. Recognized directions are
#' North-northeast (NNE), East-northeast (ENE), East-southeast (ESE),
#' South-southeast (SSE), South-southwest (SSW), West-southwest (WSW),
#' West-northwest (WNW), and North-northwest (NNW).
#'
#' @return A numeric vector of degrees corresponding to the middle
#' azimuth of the corresponding compass direction.
#'
#' @examples
#' cimis_compass_to_degrees("day-wind-nne")
#' cimis_compass_to_degrees(c("SSE", "SSW", "wsw", "Wnw", "nnw"))
#'
#' @seealso [cimis_degrees_to_compass()]
#'
#' @importFrom dplyr case_when
#' @importFrom stringr str_to_upper str_detect
#' @export
cimis_compass_to_degrees = function(x) {
x = str_to_upper(x)
res = case_when(
str_detect(x, "NNE$") ~ 22.5,
str_detect(x, "ENE$") ~ 67.5,
str_detect(x, "ESE$") ~ 112.5,
str_detect(x, "SSE$") ~ 157.5,
str_detect(x, "SSW$") ~ 202.5,
str_detect(x, "WSW$") ~ 247.5,
str_detect(x, "WNW$") ~ 292.5,
str_detect(x, "NNW$") ~ 337.5,
TRUE ~ NA_real_
)
if (any(is.na(res)))
stop("Unrecognized values in arugment \"x\".")
res
}
#' Degrees to Compass Direction
#'
#' Convert decimal degrees to Compass direction.
#'
#' @param x A vector of directions in decimal degrees.
#' @return A factor vector of compass directions.
#'
#' @details Degrees are labeled with their corresponding
#' Primary InterCardinal compass direction, following the
#' convention of the CIMIS daily wind data items.
#'
#' @examples
#' cimis_degrees_to_compass(c(30, 83, 120, 140, 190, 240, 300, 330))
#' cimis_degrees_to_compass(cimis_compass_to_degrees(c("NNE", "ENE",
#' "ESE", "SSE", "SSW", "WSW", "WNW", "NNW")))
#'
#' @seealso [cimis_compass_to_degrees()]
#' @export
cimis_degrees_to_compass = function(x) {
breaks = c(0, 45, 90, 135, 180, 225, 270, 315, 360)
labels = c("NNE", "ENE", "ESE", "SSE", "SSW", "WSW", "WNW", "NNW")
cut(x, breaks, labels, include.lowest = TRUE)
}
#' Format CIMIS Station Location
#'
#' Format the latitude and longitude of station in
#' Decimal Degrees (DD) or Hour Minutes Seconds (HMS).
#'
#' @inheritParams cimis_to_datetime
#' @param format The format to use, either Decimal Degrees (`"DD"`)
#' or Hour Minutes Seconds (`"HMS"`).
#'
#' @return The data frame, with a new `"Latitude"` and `"Longitude"`
#' columns replacing the `"HmsLatitude"` and `"HmsLongitude"`
#' columns.
#'
#' @examples
#' if(is_key_set()) {
#' d = cimis_station(170)
#' cimis_format_location(d, "DD")
#' cimis_format_location(d, "HMS")
#' }
#'
#' @importFrom dplyr mutate_at rename
#' @importFrom stringr str_split str_replace
#' @export
cimis_format_location = function(d, format = c("DD", "HMS")) {
format = match.arg(str_to_upper(format), c("DD", "HMS"))
if (format == "HMS") {
fun = function(x)
str_replace(str_split(x, " / ", simplify = TRUE)[, 1], "^-", "")
} else {
fun = function(x)
as.numeric(str_split(x, " / ", simplify = TRUE)[, 2])
}
rename(
mutate_at(d, c("HmsLatitude", "HmsLongitude"), fun),
Latitude = .data$HmsLatitude, Longitude = .data$HmsLongitude
)
}