Skip to content

Commit a9eeac8

Browse files
YuriNiellaYuriNiella
committed
Re-upload pull request files
Lost files in the previous version when fetched origin
1 parent 10c3754 commit a9eeac8

File tree

16 files changed

+1283
-450
lines changed

16 files changed

+1283
-450
lines changed

‎R/build_urls.R‎

Lines changed: 29 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -135,7 +135,7 @@
135135
url_list <-
136136
paste0(base, "catalog.html") %>%
137137
read_html() %>%
138-
as_list() %$%
138+
xml2::as_list() %$%
139139
html %$%
140140
body %$%
141141
table %>%
@@ -177,52 +177,58 @@
177177
##
178178
if(var_name %in% "rs_current"){
179179
## check if IMOS Ocean Current DM data covers detection data range
180-
## Ocean current: 1993-01-01 - 2020-12-31
180+
## Ocean current (delayed mode): 1993-01-01 - 2020-12-31
181+
## IMOS near real time data: 2011-09-01 ongoing
182+
183+
181184
## example : "http://thredds.aodn.org.au/thredds/catalog/IMOS/OceanCurrent/GSLA/DM/"
185+
#
182186
if(date_range[1] < as.Date("1993-01-01")){
183187
warning("IMOS ocean current data is currently only available from 1993-01-01 onwards,\ndetections prior to this date will not have current data associated")
184-
} else if(date_range[2] > as.Date("2020-12-31") & !.nrt) {
188+
}
189+
if(date_range[2] > as.Date("2020-12-31") & !.nrt) {
185190
warning("IMOS Ocean Current Delayed-Mode data is currently only available from 1993-01-01 to 2020-12-31,\ndetections after this date range will not have current data associated")
186191
}
192+
if(date_range[2] > as.Date("2020-12-31") & .nrt) {
193+
message("IMOS Ocean Current Near-real-time data will be used for locations after 2020-12-31")
194+
}
195+
187196
sub_dates <- dates[dates > as.Date("1993-01-01")]
188-
197+
189198
## IDJ - 19/05/2023: directory name on thredds server has changed from: http://thredds.aodn.org.au/thredds/catalog/IMOS/OceanCurrent/GSLA/DM00/
190199
## to http://thredds.aodn.org.au/thredds/catalog/IMOS/OceanCurrent/GSLA/DM/
191200
catalog <-
192201
tibble(date = sub_dates,
193-
fdates = format(date, "%Y%m%d"),
194-
year = format(date, "%Y"),
195-
base_url = paste0("http://thredds.aodn.org.au/thredds/catalog/IMOS/OceanCurrent/GSLA/DM/", year, "/"),
196-
start_url = paste0("http://thredds.aodn.org.au/thredds/fileServer/IMOS/OceanCurrent/GSLA/DM/", year, "/"))
197-
202+
fdates = format(date, "%Y%m%d"),
203+
year = format(date, "%Y"),
204+
base_url = paste0("http://thredds.aodn.org.au/thredds/catalog/IMOS/OceanCurrent/GSLA/DM/", year, "/IMOS_OceanCurrent_HV_"),
205+
start_url = paste0("http://thredds.aodn.org.au/thredds/fileServer/IMOS/OceanCurrent/GSLA/DM/", year, "/IMOS_OceanCurrent_HV_"))
206+
#end_url = "000000Z_GSLA_FV02_DM02.nc")
207+
198208
## if .nrt == TRUE then substitute NRT data for DM when year > 2020
199209
if(.nrt) {
200-
catalog <- catalog %>%
201-
mutate(base_url = ifelse(year > 2020,
202-
paste0("http://thredds.aodn.org.au/thredds/catalog/IMOS/OceanCurrent/GSLA/NRT/", year, "/"),
203-
paste0("http://thredds.aodn.org.au/thredds/catalog/IMOS/OceanCurrent/GSLA/DM/", year, "/")
204-
)) %>%
205-
mutate(start_url = ifelse(year > 2020,
206-
paste0("http://thredds.aodn.org.au/thredds/fileServer/IMOS/OceanCurrent/GSLA/NRT/", year, "/"),
207-
paste0("http://thredds.aodn.org.au/thredds/fileServer/IMOS/OceanCurrent/GSLA/DM/", year, "/")
208-
))
209-
210-
}
210+
catalog$base_url[catalog$year > 2020] <- paste0(paste0("http://thredds.aodn.org.au/thredds/catalog/IMOS/OceanCurrent/GSLA/NRT/", catalog$year[catalog$year > 2020], "/IMOS_OceanCurrent_HV_"))
211+
catalog$start_url[catalog$year > 2020] <- paste0(paste0("http://thredds.aodn.org.au/thredds/catalog/IMOS/OceanCurrent/GSLA/NRT/", catalog$year[catalog$year > 2020], "/IMOS_OceanCurrent_HV_"))
212+
# catalog$end_url[catalog$year > 2020] <- "T000000Z_GSLA_FV02_NRT.nc"
213+
}
211214

212215
if(verbose){
213216
message("Finding IMOS Ocean Current data...")
214217
}
215218

216219
find_url <- function(m){
220+
221+
222+
217223
base <- unique(m$base_url)[1]
218224
url_list <-
219225
paste0(base, "catalog.html") %>%
220-
read_html() %>%
221-
as_list() %$%
226+
xml2::read_html() %>%
227+
xml2::as_list() %$%
222228
html %$%
223229
body %$%
224230
table %>%
225-
map_dfr(function(x){if(is.null(x$td$a$tt[[1]])) return(NULL)
231+
purrr::map_dfr(function(x){if(is.null(x$td$a$tt[[1]])) return(NULL)
226232
tibble(end_url = x$td$a$tt[[1]],
227233
fdates = substr(end_url, start = 22, stop = 29),
228234
date = as.Date(fdates, "%Y%m%d"))}) %>%
@@ -239,7 +245,6 @@
239245
split(., .$year) %>%
240246
map( ~ try(find_url(.x), silent = T), .progress = T)
241247

242-
243248
idx <- sapply(find_df, function(x) inherits(x, "try-error"))
244249

245250
if(any(idx)) {

‎R/ext_find.R‎

Lines changed: 62 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,62 @@
1+
##' @title Identify spatial and temporal extents of data
2+
##'
3+
##' @description Determines spatial and temporal ranges for data extraction
4+
##'
5+
##' @param .df Dataframe given as input to extract environmental data for
6+
##' @param .X Column containing logitudes
7+
##' @param .Y Column containing latitudes
8+
##' @param .datetime Column containing timestamps
9+
##' @param .full_timeperiod Whether data extraction should be performed for the entire period or not
10+
##'
11+
##' @details Internal function to determine spatial and temporal ranges for data extraction
12+
##'
13+
##' @return List of objects
14+
##'
15+
##' @keywords internal
16+
17+
ext_find <- function(.df, .X, .Y, .datetime, .full_timeperiod, verbose) {
18+
## define date range
19+
unique_dates <-
20+
.df %>%
21+
dplyr::mutate(date = date(!!as.name(.datetime))) %>%
22+
dplyr::distinct(date) %>%
23+
dplyr::pull(date)
24+
date_range <- range(unique_dates)
25+
26+
## define spatial extent and extend by 40%
27+
study_extent <- terra::ext(c(min(.df[[.X]]), max(.df[[.X]]), min(.df[[.Y]]), max(.df[[.Y]]))) * 1.4
28+
29+
## define unique positions (for quicker environmental variable extraction)
30+
unique_positions <-
31+
dplyr::ungroup(.df) %>%
32+
dplyr::mutate(date = date(!!as.name(.datetime))) %>%
33+
dplyr::distinct(!!as.name(.X), !!as.name(.Y), date) %>%
34+
dplyr::select(!!as.name(.X), !!as.name(.Y), date)
35+
36+
## define dates of detection and date range and catalog all dates between start and end if .full_timeperiod = TRUE
37+
if(.full_timeperiod){
38+
if(verbose){
39+
message("Extracting environmental data for each day between ",
40+
date_range[1], " and ", date_range[2], " (",
41+
difftime(date_range[2], date_range[1], units = "days"), " days)",
42+
"\nThis may take a little while...")
43+
}
44+
dates <- seq(date_range[1], date_range[2], by = 1)
45+
# update unique_positions to include all days
46+
all_positions <- expand.grid(date = dates, locs = paste(unique_positions$receiver_deployment_longitude,
47+
unique_positions$receiver_deployment_latitude, sep = "_"))
48+
all_positions$receiver_deployment_longitude <- as.numeric(stringr::str_split_fixed(all_positions$locs, pattern = "_", n = 2)[,1])
49+
all_positions$receiver_deployment_latitude <- as.numeric(stringr::str_split_fixed(all_positions$locs, pattern = "_", n = 2)[,2])
50+
all_positions <- all_positions[,c(3,4,1)]
51+
unique_positions <- all_positions
52+
} else {
53+
if(verbose){
54+
message("Extracting environmental data only on days detections were present; between ",
55+
date_range[1], " and ", date_range[2], " (",
56+
length(unique_dates), " days)",
57+
"\nThis may take a little while...")
58+
}
59+
dates <- unique_dates
60+
}
61+
return(list(ext = study_extent, dates = dates, unique_positions = unique_positions))
62+
}

0 commit comments

Comments
 (0)