Commit d68fc4f0 authored by Conor Anderson's avatar Conor Anderson

First attempt at move to plumber

parent cede681b
get_choices <- function(file_dir, var, lim = FALSE) {
if (debug_flag) message(sprintf("Getting choices for %s in %s", var, file_dir))
filenames <- if (lim) {
grep("200601-210012.nc$", dir(file.path(file_dir, var, "verified")), value = TRUE)
} else {
dir(file.path(file_dir, var, "verified"))
}
choices <- as_tibble(t(sapply(filenames, ncdf4.helpers::get.split.filename.cmip5)))
names(choices) <- c("Variable", "Period", "Model", "Scenario", "Ensemble", "Range", "Start", "End")
choices <- choices %>%
mutate(Model = gsub("([0-9])-([0-9])", paste0("\\1", ".", "\\2"), gsub("([0-9])-([0-9])", paste0("\\1", ".", "\\2"), Model)),
Scenario = sub("rcp([0-9])([0-9])", paste0("RCP", "\\1", ".", "\\2"), Scenario),
Filenames = filenames)
choices
get_choices <- function(var, lim = FALSE) {
if (debug_flag) message(sprintf("Getting choices for %s", var))
r <- POST(URLencode(paste0(plumber_address, "/choices?var=", var,
"&lim=", as.character(lim))),
config = list(add_headers(accept = "application/json")))
stop_for_status(r)
unserialize(content(r))
}
......@@ -22,68 +22,10 @@ get_gcm_ts <- function(meta) {
for (f in 1:length(fs)) {
key <- paste(fs[f], lat_cell, lon_cell, sep = "_")
time_tmp <- NULL
if (st_point$exists(key)) {
message("Hit the cache.")
time_tmp <- st_point$get(key)
## Invalidate old cache entries.
if (is.null(attr(time_tmp, "cache_ver")) || attr(time_tmp, "cache_ver") != cache_ver) {
message("Cached version is invalid. Deleting.")
st_point$del(key)
time_tmp <- NULL
}
}
if (is.null(time_tmp)) {
message("Missed the cache")
# Get the time
components <- get.split.filename.cmip5(fs[f])
nc_nc <- nc_open(file.path(file_dir, var, "verified", fs[f]))
nc_time <- try(nc.get.time.series(nc_nc, v = var, time.dim.name = "time"), silent = TRUE)
if (inherits(nc_time, "try-error")) {
nc_time <- ncvar_get(nc_nc, "time")
nc_time_units <- ncatt_get(nc_nc, "time", attname="units")$value
nc_time_origin <- strsplit(nc_time_units, " ")
nc_time_origin <- unlist(nc_time_origin)[3]
nc_time <- as.yearmon(ymd(nc_time_origin) + nc_time)
if (paste0(format(nc_time[1], format = "%Y"), format(nc_time[1], format = "%m")) != unname(components['tstart']) || paste0(format(nc_time[length(nc_time)], format = "%Y"), format(nc_time[length(nc_time)], format = "%m")) != unname(components['tend'])) {
stop(paste("Error processing time for", fs[f]))
}
} else {
nc_time <- as.yearmon(format(nc_time, format = "%Y-%m-%d hh:mm:ss"))
}
# Now load only that grid data
nc_var <- nc.get.var.subset.by.axes(nc_nc, var, axis.indices = list(X = lon_cell, Y = lat_cell))
# Close the nc connection
nc_close(nc_nc); rm(nc_nc)
# Note, does this still apply?
if (dim(nc_var)[1] > 1 || dim(nc_var)[2] > 1) {
warning("We got two latitud or longitude cells. We'll average across them.")
nc_var <- apply(nc_var, 3, mean)
} else {
nc_var <- nc_var[1, 1, ]
}
time_tmp <- tibble(Var = var,
Model = meta$Model[row],
Scenario = meta$Scenario[row],
Ensemble = meta$Ensemble[row],
Time = nc_time,
Year = format(as.yearmon(Time), format = "%Y"),
Month = format(as.yearmon(Time), format = "%m"),
Value = nc_var)
rm(nc_var, nc_time); gc()
attr(time_tmp, "cache_ver") <- cache_ver
st_point$set(key, time_tmp)
message("Cached data")
}
r <- POST(URLencode(paste0(plumber_address, "/timeseries?key=", key)),
config = list(add_headers(accept = "application/json")))
stop_for_status(r)
time_tmp <- unserialize(content(r))
if (f == 1) {
time_series <- time_tmp
......
......@@ -6,6 +6,7 @@ library("dplyr")
library("ggplot2")
library("googleway")
library("htmlwidgets")
library("httr")
library("leaflet")
library("lubridate")
library("mapview")
......@@ -73,7 +74,7 @@ shinyServer(function(input, output, session) {
### GCM PLOTS
plot_model_in <- callModule(singleModelSelect, "plot_model_in",
choices = reactive({get_choices(file_dir, input$var_filter_plot, lim = TRUE)}),
choices = reactive({get_choices(input$var_filter_plot, lim = TRUE)}),
coords = reactive({get_coords(input$plot_city_in)}),
projection = reactive({input$year_in[1]:input$year_in[2]}))
......@@ -153,7 +154,7 @@ shinyServer(function(input, output, session) {
get_choices_anoms <- reactive({
get_choices(file_dir, input$var_filter, lim = FALSE)
get_choices(input$var_filter, lim = FALSE)
})
output$ScenarioFilter = renderUI({
......@@ -378,7 +379,7 @@ shinyServer(function(input, output, session) {
### OVERLAY MAP
map_model_in <- callModule(singleModelSelect, "map_model_in",
choices = reactive(get_choices(file_dir, input$var_filter_map, lim = TRUE)),
choices = reactive(get_choices(input$var_filter_map, lim = TRUE)),
coords = reactiveVal(NULL),
projection = reactive(input$year_in_2[1]:input$year_in_2[2]))
......@@ -390,72 +391,13 @@ shinyServer(function(input, output, session) {
key <- paste(file, input$year_in_2[1], input$year_in_2[2], sep = "_")
if (st_avg$exists(key)) {
if (debug_flag) message("Hit the cache.")
map_data <- st_avg$get(key)
} else {
if (debug_flag) message("Missed the cache.")
nc_nc <- nc_open(file.path(file_dir, input$var_filter_map, "verified", file), readunlim = FALSE)
incProgress(1/6, detail = paste("Found the file."))
nc_time <- try(nc.get.time.series(nc_nc, v = var, time.dim.name = "time"))
if (inherits(nc_time, "try-error")) {
warning(paste(fs[f], "failed"))
break
}
nc_time <- as.yearmon(format(nc_time, format = "%Y-%m-%d hh:mm:ss"))
# Get the time that we are interested in
index_start <- min(which(format(nc_time, format = "%Y") == input$year_in_2[1]))
index_end <- max(which(format(nc_time, format = "%Y") == input$year_in_2[2]))
incProgress(1/6, detail = paste("Chose the timeline."))
nc_lat <- ncvar_get(nc_nc, "lat")
nc_lon <- ncvar_get(nc_nc, "lon")
lon_bnds <- try(ncvar_get(nc_nc, "lon_bnds"), silent = TRUE)
if (inherits(lon_bnds, "try-error")) {
lon_bnds <- ncvar_get(nc_nc, "lon_bounds")
}
lat_bnds <- try(ncvar_get(nc_nc, "lat_bnds"), silent = TRUE)
if (inherits(lat_bnds, "try-error")) {
lat_bnds <- ncvar_get(nc_nc, "lat_bounds")
}
nc_var <- nc.get.var.subset.by.axes(nc_nc, input$var_filter_map, axis.indices = list(T = index_start:index_end))
incProgress(1/6, detail = paste("Got the data."))
# Close the nc connection
nc_close(nc_nc)
rm(nc_nc)
map_data_mat <- apply(nc_var, c(1,2), mean)
incProgress(1/6, detail = paste("Calculated mean."))
map_data <- raster(t(map_data_mat),
xmn = mean(lon_bnds[,1]), xmx = mean(lon_bnds[,ncol(lon_bnds)]),
ymn = mean(lat_bnds[,1]), ymx = mean(lat_bnds[,ncol(lat_bnds)]),
crs="+proj=longlat +datum=WGS84")
incProgress(detail = paste("Converted to raster."))
# This step fails if the model outputs the corner instead of the centre point.
map_data <- try(rotate(map_data))
if(inherits(map_data, "try-error")) {
warning(paste(key,
"failed mapping using bounds!"))
map_data <- raster(t(map_data_mat), xmn = (nc_lon[2] - nc_lon[1])/2, xmx = max(nc_lon) + (nc_lon[2] - nc_lon[1])/2, ymn = min(nc_lat), ymx = max(nc_lat), crs="+proj=longlat +datum=WGS84")
map_data <- rotate(map_data)
}
map_data <- flip(map_data, 'y')
incProgress(1/6, detail = paste("Flipped and rotated."))
st_avg$set(key, map_data)
if (debug_flag) message("Cached data.")
map_data
}
r <- POST(URLencode(paste0(plumber_address, "/mapseries?key=", key)),
config = list(add_headers(accept = "application/json")))
stop_for_status(r)
map_data <- unserialize(content(r))
map_data
})
})
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment