Commit 43079e5e authored by Conor Anderson's avatar Conor Anderson

More plumbing

parent f9186509
......@@ -4,4 +4,3 @@ deploy.sh
local_settings.R
packrat/lib*/
packrat/src/
.cache
get_cache <- function(key) {
if (debug_flag) message("Asking plumber for ", key)
r <- POST(URLencode(paste0(plumber_address, "/cacheget?key=", key)),
config = list(add_headers(accept = "application/json")))
stop_for_status(r)
unserialize(content(r))
}
set_cache <- function(key, table) {
if (debug_flag) message("Asking plumber to save ", key)
r <- POST(URLencode(paste0(plumber_address, "/cacheset?key=", key)),
body = jsonlite::toJSON(table), encoding = "json",
config = list(add_headers(accept = "application/json")))
stop_for_status(r)
if (r$status_code != 200) warning("There was an error saving this table.")
}
......@@ -4,13 +4,6 @@ get_metadata <- function(choices, coords, baseline = NULL,
if (debug_flag) message("get_metadata")
## FIXME: This is the nuclear option.
if (!cache$exists("cache_ver") || cache$get("cache_ver") != cache_ver) {
message("Metadata cache is invalid. Deleting.")
cache$clear()
cache$set("cache_ver", cache_ver)
}
var <- unique(choices$Variable)
if (is.null(model)) model <- unique(choices$Model)
......@@ -22,15 +15,14 @@ get_metadata <- function(choices, coords, baseline = NULL,
distinct()
if (!is.null(baseline)) {
coyote <- (!is.null(baseline) && paste0(baseline[length(baseline)], "12") > "200512")
coyote <- (!is.null(baseline) && paste0(baseline[2], "12") > "200512")
gcm_baseline_key <- if (coyote) {
paste0("lookup_table_files_baseline_coyote_", var)
} else {
paste0("lookup_table_files_baseline_", var)
}
baseline_shorts_key <- paste0(gcm_baseline_key, "_known_shorts_",
min(baseline), "_", max(baseline))
baseline[1], "_", baseline[2])
short_cases <- if (coyote) {
mutate(cases,
......@@ -42,15 +34,16 @@ get_metadata <- function(choices, coords, baseline = NULL,
filter(cases, Scenario == "historical")
}
if (cache$exists(gcm_baseline_key)) {
gcm_baseline_files <- cache$get(gcm_baseline_key)
known_shorts <- if (cache$exists(baseline_shorts_key)) {
cache$get(baseline_shorts_key)
} else {
NULL
gcm_baseline_files <- get_cache(gcm_baseline_key)
if (all(gcm_baseline_files != "NULL")) {
known_shorts <- get_cache(baseline_shorts_key)
if (all(known_shorts == "NULL")) {
known_shorts <- NULL
}
hist_files <- semi_join(gcm_baseline_files, short_cases) %>%
filter(Start <= paste0(min(baseline), "01") & End >= paste0(max(baseline), "12"))
filter(Start <= paste0(baseline[1], "01") & End >= paste0(baseline[2], "12"))
short_cases <- anti_join(short_cases, hist_files)
if (!is.null(known_shorts)) short_cases <- anti_join(short_cases, known_shorts)
} else {
......@@ -69,12 +62,11 @@ get_metadata <- function(choices, coords, baseline = NULL,
distinct(Model, Scenario, Ensemble, Start, End, .keep_all = TRUE)
gcm_baseline_files <- bind_rows(gcm_baseline_files, new_hist_files) %>%
distinct(Model, Scenario, Ensemble, Start, End, .keep_all = TRUE)
cache$set(key = gcm_baseline_key, value = gcm_baseline_files)
set_cache(gcm_baseline_key, gcm_baseline_files)
}
short_cases <- anti_join(short_cases, hist_files %>% dplyr::select(Model, Scenario, Ensemble))
if (nrow(short_cases) > 0) {
cache$set(key = baseline_shorts_key,
value = bind_rows(known_shorts, short_cases) %>% distinct)
set_cache(baseline_shorts_key, bind_rows(known_shorts, short_cases) %>% distinct)
}
}
} else {
......@@ -85,19 +77,20 @@ get_metadata <- function(choices, coords, baseline = NULL,
gcm_projection_key <- paste0("lookup_table_files_projection_", var)
projection_shorts_key <- paste0(gcm_projection_key, "_known_shorts_",
min(projection), "_", max(projection))
projection[1], "_", projection[2])
short_cases <- filter(cases, Scenario != "historical")
if (cache$exists(gcm_projection_key)) {
gcm_projection_files <- cache$get(gcm_projection_key)
known_shorts <- if (cache$exists(projection_shorts_key)) {
cache$get(projection_shorts_key)
} else {
NULL
gcm_projection_files <- get_cache(gcm_projection_key)
if (all(gcm_projection_files != "NULL")) {
known_shorts <- get_cache(projection_shorts_key)
if (all(known_shorts == "NULL")) {
known_shorts <- NULL
}
proj_files <- semi_join(gcm_projection_files, short_cases) %>%
filter(Start <= paste0(min(projection), "01") & End >= paste0(max(projection), "12"))
filter(Start <= paste0(projection[1], "01") & End >= paste0(projection[2], "12"))
short_cases <- anti_join(short_cases, proj_files)
if (!is.null(known_shorts)) short_cases <- anti_join(short_cases, known_shorts)
} else {
......@@ -116,12 +109,11 @@ get_metadata <- function(choices, coords, baseline = NULL,
distinct(Model, Scenario, Ensemble, Start, End, .keep_all = TRUE)
gcm_projection_files <- bind_rows(gcm_projection_files, new_proj_files) %>%
distinct(Model, Scenario, Ensemble, Start, End, .keep_all = TRUE)
cache$set(key = gcm_projection_key, value = gcm_projection_files)
set_cache(gcm_projection_key, gcm_projection_files)
}
short_cases <- anti_join(short_cases, proj_files %>% dplyr::select(Model, Scenario, Ensemble))
if (nrow(short_cases) > 0) {
cache$set(key = projection_shorts_key,
value = bind_rows(known_shorts, short_cases) %>% distinct)
set_cache(projection_shorts_key, bind_rows(known_shorts, short_cases) %>% distinct)
}
}
} else {
......@@ -138,8 +130,14 @@ get_metadata <- function(choices, coords, baseline = NULL,
latlon_cells <- bounds_tab %>% group_by(Model) %>% summarize(Lat_Cell = which(unlist(Lat_Bot) <= coords$lat & unlist(Lat_Top) >= coords$lat),
Lon_Cell = which(unlist(Lon_Lef) <= lon & unlist(Lon_Rig) >= lon))
left_join(bind_rows(hist_files, proj_files), latlon_cells) %>% add_column(Var = var, .before = 1)
meta <- left_join(bind_rows(hist_files, proj_files), latlon_cells) %>% add_column(Var = var, .before = 1)
} else {
bind_rows(hist_files, proj_files)
meta <- bind_rows(hist_files, proj_files)
}
meta %>%
mutate(No_of_Files = lengths(Files)) %>%
arrange(Model, Scenario, Ensemble, No_of_Files) %>%
group_by(Model, Scenario, Ensemble) %>%
summarize_all(head, 1) %>%
dplyr::select(-No_of_Files)
}
......@@ -13,23 +13,6 @@ Source: CRAN
Version: 1.0.0
Hash: 6abedd7919c4457604c0aa44529a6683
Package: R.methodsS3
Source: CRAN
Version: 1.7.1
Hash: 99f841ba1614c005e6672c5fb01b352a
Package: R.oo
Source: CRAN
Version: 1.22.0
Hash: c37ded09136c4ae98b9c73cf42dee3c8
Requires: R.methodsS3
Package: R.utils
Source: CRAN
Version: 2.6.0
Hash: 7d46f5c3a914a82db092e1404d6ae624
Requires: R.methodsS3, R.oo
Package: R6
Source: CRAN
Version: 2.2.2
......@@ -175,12 +158,6 @@ Version: 1.4.4
Hash: 4df5ab2c8c35382dacab75d414da6748
Requires: iterators
Package: gdalUtils
Source: CRAN
Version: 2.0.1.14
Hash: 910ebbf1a56ea0c97f8f67e827c30d53
Requires: R.utils, foreach, raster, rgdal, sp
Package: gdtools
Source: CRAN
Version: 0.1.7
......@@ -341,11 +318,6 @@ Source: CRAN
Version: 0.5
Hash: 463550cf44fb6f0a2359368f42eebe62
Package: mnormt
Source: CRAN
Version: 1.5-5
Hash: d0d5efbb1fb26d2dc5f9394c223084b5
Package: munsell
Source: CRAN
Version: 0.5.0
......@@ -426,12 +398,6 @@ Version: 1.0.1
Hash: 5390b18faf114da060f57954f970ea3b
Requires: R6, Rcpp, later, magrittr, rlang
Package: psych
Source: CRAN
Version: 1.8.4
Hash: eb0040e47d327c4416ea68c9cb01316f
Requires: mnormt
Package: purrr
Source: CRAN
Version: 0.2.5
......@@ -524,12 +490,6 @@ Version: 0.2-0
Hash: 865569ffef797a91b8c4e35bbe1693b2
Requires: abind, classInt, ncdf4, ncmeta, rlang, sf, units
Package: storr
Source: CRAN
Version: 1.2.1
Hash: 76ffa40827f4102989daa97896baf696
Requires: R6, digest
Package: stringi
Source: CRAN
Version: 1.2.4
......
......@@ -15,7 +15,6 @@ library("purrr")
library("raster")
library("RColorBrewer")
library("readr")
library("storr")
library("stringr")
library("tibble")
library("tidyr")
......@@ -218,8 +217,8 @@ shinyServer(function(input, output, session) {
meta <- get_metadata(choices = get_choices_anoms(),
coords = get_coords(input$anom_city_in),
baseline = (if (lim == "fore") NULL else input$baseline_in[1]:input$baseline_in[2]),
projection = (if (lim == "hind") NULL else input$projection_in[1]:input$projection_in[2]),
baseline = (if (lim == "fore") NULL else input$baseline_in),
projection = (if (lim == "hind") NULL else input$projection_in),
model = input$mod_filter_in,
scenario = input$scen_filter_in,
ensemble = input$run_filter_in)
......
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