-
Notifications
You must be signed in to change notification settings - Fork 10
/
Copy pathpat_loadMonth.R
200 lines (159 loc) · 5.8 KB
/
pat_loadMonth.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
#' @export
#' @importFrom rlang .data
#' @importFrom MazamaCoreUtils logger.isInitialized
#'
#' @title Load PurpleAir time series data for a month
#'
#' @description A pre-generated PurpleAir Timeseries \emph{pat} object will be
#' loaded for the month requested with \code{datestamp} if available. Data are
#' loaded from the archive set with either \code{setArchiveBaseUrl()} or
#' \code{setArchiveBaseDir()} for locally archived files.
#'
#' The \code{datestamp} must be in the following format:
#'
#' \itemize{
#' \item{\code{"YYYYmm"}}
#' }
#'
#' By default, the current month is loaded.
#'
#' @note Archive file names are
#' generated with a unique "device-deployment" identifier by combining a unique
#' location ID with a unique device ID. These "device-deployment" identifiers
#' guarantee that movement of a sensor will result in the creation of a new
#' time series.
#'
#' Users may request a \emph{pat} object in one of two ways:
#'
#' 1) Pass in \code{id} with a valid a \code{deviceDeploymentID}
#'
#' 2) Pass in both \code{label} and \code{pas} so that the
#' \code{deviceDeploymentID} can be looked up.
#'
#' @param id PurpleAir sensor 'deviceDeploymentID'.
#' @param label PurpleAir sensor 'label'.
#' @param pas PurpleAir Synoptic \emph{pas} object.
#' @param datestamp Date string in ymd order.
#' @param timezone Timezone used to interpret \code{datestamp}.
#'
#' @return A PurpleAir Timeseries \emph{pat} object.
#'
#' @seealso \link{pat_load}
#' @seealso \link{pat_loadLatest}
#' @seealso \link{pat_createNew}
#'
#' @examples
#' \donttest{
#' # Fail gracefully if any resources are not available
#' try({
#'
#' library(AirSensor)
#'
#' setArchiveBaseUrl("https://airsensor.aqmd.gov/PurpleAir/v1")
#'
#' # Reference an older 'pas' before this sensor was dropped
#' pas <- pas_load(20190901, archival = TRUE)
#'
#' may <- pat_loadMonth(label = "SCNP_20", pas = pas, datestamp = 201905)
#' pat_multiPlot(may)
#'
#' }, silent = FALSE)
#' }
pat_loadMonth <- function(
id = NULL,
label = NULL,
pas = NULL,
datestamp = NULL,
timezone = "America/Los_Angeles"
) {
# ----- Validate parameters --------------------------------------------------
# Get the deviceDeploymentID
if ( is.null(id) && is.null(label) ) {
stop(paste0("label or id must be provided"))
} else if ( is.null(id) && !is.null(label) ) {
if ( is.null(pas) )
stop(paste0("pas must be provided when loading by label"))
if ( !label %in% pas$label )
stop(sprintf("label '%s' is not found in the 'pas' object", label))
# Get the deviceDeploymentID from the label
deviceDeploymentID <- pas_getDeviceDeploymentIDs(pas, pattern = label)
if ( length(deviceDeploymentID) > 1 )
stop(sprintf("label '%s' matches more than one sensor", label))
} else {
# Use id whenever it is defined, potentially ignoring label
deviceDeploymentID <- id
}
# ----- Create year and month stamps -----------------------------------------
# NOTE: Incoming datestamps are interpreted in the local timezone.
# Default to the current month
if ( is.null(datestamp) || is.na(datestamp) || datestamp == "" ) {
datetime <- lubridate::now(tzone = timezone)
} else {
datetime <- MazamaCoreUtils::parseDatetime(datestamp, timezone = timezone)
}
# Filename timestamps are always in UTC
datestamp <- strftime(datetime, "%Y%m%d", tz = "UTC")
monthstamp <- strftime(datetime, "%Y%m", tz = "UTC")
yearstamp <- strftime(datetime, "%Y", tz = "UTC")
mmstamp <- strftime(datetime, "%m", tz = "UTC")
# ----- Load data from URL or directory --------------------------------------
# Create filename
filename <- paste0("pat_", deviceDeploymentID, "_", monthstamp, ".rda")
# Use package internal URL
baseDir <- getArchiveBaseDir()
baseUrl <- getArchiveBaseUrl()
dataUrl <- paste0(baseUrl, '/pat/', yearstamp, '/', mmstamp)
# dataDir should be NULL if baseDir is NULL
if ( is.null(baseDir) ) {
dataDir <- NULL
} else {
dataDir <- paste0(baseDir, '/pat/', yearstamp, '/', mmstamp)
}
# Get data from URL or directory
result <- try({
suppressWarnings({
pat <- MazamaCoreUtils::loadDataFile(filename, dataUrl, dataDir)
})
}, silent = TRUE)
# NOTE: We used suppressWarnings() above so that we can have a more
# NOTE: uniform error response for the large variety of reasons that
# NOTE: loading might fail.
if ( "try-error" %in% class(result) ) {
if ( is.null(baseDir) ) {
stop(paste0("Data file could not be loaded from: ", baseUrl), call. = FALSE)
} else {
stop(paste0("Data file could not be loaded from: ", baseDir), call. = FALSE)
}
}
# ----- Return ---------------------------------------------------------------
# Guarantee that 'ID' and 'deviceID' fields are <character> as opposed to <int>
pat$meta$ID <- as.character(pat$meta$ID)
pat$meta$deviceID <- as.character(pat$meta$deviceID)
# Guarantee that 'uptime' and 'memory' are <dbl> as opposed to <int> as they
# were in an earlier version
pat$data$uptime <- as.double(pat$data$uptime)
pat$data$memory <- as.double(pat$data$memory)
# Guarantee that times are arranged properly
pat$data <-
pat$data %>%
dplyr::arrange(.data$datetime)
# Guarantee that duplicate data records are removed
pat <- pat_distinct(pat)
return(pat)
}
# ===== DEBUGGING ==============================================================
if ( FALSE ) {
library(AirSensor)
setArchiveBaseUrl("https://airsensor.aqmd.gov/PurpleAir/v1")
id <- NULL
label <- "SCNP_20"
# Reference an older 'pas' before this sensor was dropped
pas <- pas_load(20190901, archival = TRUE)
datestamp <- 201904
timezone <- "America/Los_Angeles"
pat <- pat_load(
label = "SCNP_20",
pas = pas,
startdate = 201904
)
}