diff --git a/CLAUDE.md b/CLAUDE.md new file mode 100644 index 0000000..35a584a --- /dev/null +++ b/CLAUDE.md @@ -0,0 +1,218 @@ +# witchplot — Developer Guide for Claude + +## What this repo is + +**witchplot** is an R package (~4,200 lines across 23 files) for interactive visualization of GAMS IAM (Integrated Assessment Model) results. It wraps GDX file reading into Shiny dashboards, supporting four models: WITCH, RICE50+, FIDELIO, IIASADB. + +Entry points: `run_witch()`, `run_rice()`, `run_fidelio()`, `run_iiasadb()` — all defined in `R/witchplot.R`. + +--- + +## Directory layout + +``` +R/ # All package logic (23 files) +inst/gdxcompaR/ + witch/ # WITCH Shiny app (global.R, ui.R, server.R) + rice/ # RICE50+ Shiny app + fidelio/ # FIDELIO Shiny app + iiasadb/ # IIASA database viewer + config/ # CSV variable mapping files +data/ # Historical GDX files (bundled) +data-raw/ # Scripts to regenerate historical data +man/ # Roxygen docs +tests/ # Minimal (framework only, no real tests) +``` + +--- + +## Key R files + +| File | Role | +|------|------| +| `witchplot.R` | `run_*()` launchers, global state cleanup | +| `session_init.R` | `.initialize_witchplot_session()` — sets all globals | +| `gdx_loader_new.R` | Modern GDX discovery and session setup | +| `gdx_file_loader.R` | Legacy GDX loader (still used) | +| `get_witch.R` | **Core data loader** `get_witch()` — reads variables from GDX | +| `shiny_modules.R` | **Plot pipeline** — `prepare_plot_data()`, `create_gdx_plot()`, etc. | +| `shiny_ui_helpers.R` | UI generators — `create_variable_selector()`, `create_region_selector()` | +| `auxiliary_functions.R` | `unit_conversion()`, `ttoyear()`, `yeartot()`, `saveplot()` | +| `add_historical_values.R` | Merges historical data into model output | +| `region_palettes.R` | `witch_region_longnames`, `get_region_palette()` | +| `energy_plots.R` | `Primary_Energy_Mix()`, `Electricity_Mix()`, etc. | +| `emission_plots.R` | `Plot_Global_Emissions()`, `Sectoral_Emissions()`, etc. | +| `policy_cost.R` | `Policy_Cost()`, `Carbon_Price()` | +| `inequality_plots.R` | `plot_inequality()`, Gini/Lorenz analysis | +| `map_functions.R` | `witchmap()`, `map_simple()` | + +--- + +## Data flow + +``` +results_dir/*.gdx + → .discover_gdx_files() / .load_gdx_files() + creates: scenlist, witch_regions, all_var_descriptions, year0, tstep + → run_*() calls .initialize_witchplot_session(), launches Shiny + +Shiny server.R: + user picks variable/scenario/region/index + → get_witch(variable) # reads GDX, memoized + → add_historical_values() # appends historical rows (file="historical") + → prepare_plot_data() + → extract_additional_sets() # finds extra set dimensions (e, j, ghg, …) + → subset_by_additional_sets() + → compute_regional_aggregates() + → unit_conversion() + → create_gdx_plot() # returns ggplot object +``` + +--- + +## Data structures + +All variables are returned as **data.table** with these columns: +- `t` — time index (integer, 1-based); convert with `ttoyear(t)` / `yeartot(year)` +- `n` — region name (lowercase, e.g. `"usa"`, `"china"`, `"World"`) +- `file` — scenario name (or `"historical"` / `"historical_primap"` etc.) +- `value` — the numeric result +- `pathdir` — only present when multiple `results_dir` paths are used +- `tlen` — time-step length in years (loaded from GDX or defaulting to `tstep`) +- additional columns — set dimensions like `e`, `j`, `ghg`, `iq` (model-dependent) + +--- + +## Sets / indexes + +Sets are additional dimensions beyond time and region: + +| Set | Meaning | Typical values | +|-----|---------|----------------| +| `e` | Emission type (WITCH) | `co2_ffi`, `co2_luc`, `ch4`, `n2o` | +| `ghg` | GHG type (RICE) | `co2`, `ch4`, `n2o` | +| `j` | Technology / fuel | `coal`, `gas`, `wind`, `solar`, `nuclear` | +| `f` | Fuel | used in energy variables | +| `iq` | Income quintile | `q1`–`q5`, `y` | + +`extract_additional_sets()` discovers which sets a variable has at runtime. Sets are sorted alphabetically, so when nothing is selected the fallback is `set_elements[1]` (alphabetically first, e.g. `ch4` before `co2`). + +--- + +## Global variables (set by session init) + +These are set in `.GlobalEnv` and consumed everywhere: + +``` +results_dir # character vector of paths to GDX results +filelist # named list: path → filename +scenlist # named list: scenario label → filename +witch_regions # character vector of region codes +display_regions # regions shown by default +region_palette # named color vector +year0, tstep # time parameters (WITCH: 2005/5, RICE: 2015/5) +yearmin, yearmax # display range defaults +all_var_descriptions # data.frame(name, description) from GDX metadata +reg_id # regional aggregation ID ("witch17", "ed58", etc.) +add_historical # logical: load historical data? +deploy_online # logical: running on server (disables some features)? +``` + +Cleaned up by `.cleanup_witchplot_globals()` before each new session. + +--- + +## Shiny apps — WITCH vs RICE differences + +| | WITCH (`witch/`) | RICE (`rice/`) | +|--|--|--| +| Default variable | `Q_EMI` | `E` | +| Region aggregates | World, EU | World only | +| Extra UI controls | — | Growth rate, stacked plot | +| Variable list fn | `get_gdx_variable_list()` (filtered) | `get_gdx_variable_list_simple()` | +| Index selector placement | Outside `renderPlot` (has `set_info_reactive`) | Inside `renderPlot` (also has `set_info_reactive` now) | +| Time range | 1970–2150 | 1970–2300 | +| reg_id | `witch17` | `ed58` | + +Both apps share the same `shiny_modules.R` pipeline and `shiny_ui_helpers.R` components. + +--- + +## Shiny server.R architecture (both apps) + +``` +variable_selected_reactive # reactive wrapping input$variable_selected +set_info_reactive # reactive: loads variable, extracts set info +output$choose_additional_set # renderUI: index selector (uses set_info_reactive) +output$varname # renderText: plot title (uses set_info_reactive for accurate fallback) +output$gdxcompaRplot # renderPlot: main time-series plot +output$gdxcompaRstackedplot # renderPlot: stacked area plot (RICE) +output$gdxompaRplotly # renderPlot: secondary plot (ggplotly-compatible) +output$gdxcompaRmap # renderPlot: geographic map +output$diagnostics # renderPlot: diagnostic overview +``` + +**Plot title format**: `VARNAME — Description [index_element] — Region` + +--- + +## Historical data + +- Bundled in `data/`: `witch17.gdx`, `ed58.gdx`, `r5.gdx`, `global.gdx` +- Mapped via `inst/config/map_var_hist_rice.csv` and `map_var_hist_iiasadb.csv` +- Historical rows have `file = "historical"` (or `"historical_{source}"`) +- For RICE variable `E` and similar: if no `ghg` column exists in source data, defaults to `"co2"` (see `get_witch.R`) +- `add_historical_values()` is called inside `get_witch()` when `add_historical=TRUE` + +--- + +## Unit conversion + +`unit_conversion(variable_name)` returns `list(unit, convert)`: + +| GDX unit | Display unit | Factor | +|----------|-------------|--------| +| TWh | EJ | 0.0036 | +| T$ | billion USD | 1000 | +| GtCe | GtCO2 | 3.67 | +| T$/GTon | $/tCO2 | 272.73 | +| °C | °C | 1 | + +Growth rate mode overrides unit to `" % p.a."`. + +--- + +## Time handling + +```r +ttoyear(t) # t (1-based integer) → calendar year +yeartot(year) # calendar year → t +# Uses globals: year0, tstep (or tlen column in data) +``` + +WITCH: `year0=2005`, `tstep=5` → t=1 is 2005, t=2 is 2010, … +RICE: `year0=2015`, `tstep=5` → t=1 is 2015, t=2 is 2020, … + +--- + +## Naming conventions + +- **Function names**: `CamelCase` for plot functions (`Primary_Energy_Mix`), `snake_case` for utilities (`get_witch`, `unit_conversion`) +- **Internal helpers**: `.dot_prefix` (e.g. `.load_gdx_files`, `.initialize_witchplot_session`) +- **GDX files**: discovered by pattern `restrict_files="results_"` (default) +- **Scenario names**: derived by stripping `removepattern` from filename +- **Region codes**: lowercase (`usa`, `china`, `europe`); long names via `witch_region_longnames` + +--- + +## Common patterns to follow + +1. **Adding a new plot tab**: add `renderPlot` in server.R + `tabPanel` in ui.R; use `prepare_plot_data()` for data prep. +2. **Accessing set info in server.R**: always use `set_info_reactive()` — never compute `extract_additional_sets()` inside a reactive that also computes plot data. +3. **Effective index selection**: `input$additional_set_id_selected` can be NULL when nothing selected; always apply the same fallback as the plot (`set_info$set_elements[1]`). +4. **New variable special-casing**: add handling in `get_witch.R` near the `E`/`EIND` block if the variable needs a default index column added. +5. **Historical mapping**: add a row in `inst/config/map_var_hist_rice.csv` (or iiasadb variant). + + +## Important to note +We are currently focussing on RICE, not WITCH. \ No newline at end of file diff --git a/R/gdx_file_loader.R b/R/gdx_file_loader.R index 47e9dc9..e763f26 100644 --- a/R/gdx_file_loader.R +++ b/R/gdx_file_loader.R @@ -118,7 +118,8 @@ mygdx <- gdxtools::gdx(file.path(results_dir[1], paste0(filelist[1], ".gdx"))) all_var_descriptions <- rbind( data.frame(name = mygdx$variables$name, description = mygdx$variables$text), - data.frame(name = mygdx$parameters$name, description = mygdx$parameters$text) + data.frame(name = mygdx$parameters$name, description = mygdx$parameters$text), + data.frame(name = mygdx$sets$name, description = mygdx$sets$text) ) assign("all_var_descriptions", all_var_descriptions, envir=.GlobalEnv) @@ -174,6 +175,21 @@ }) } + # Try to read region long names from data_{reg_id}/n.inc element text + # (gdxtools does not expose set element text from GDX files) + tryCatch({ + n_inc_path <- file.path(results_dir[1], paste0("data_", reg_id), "n.inc") + if(file.exists(n_inc_path)) { + lines <- readLines(n_inc_path, warn=FALSE) + matches <- regmatches(lines, regexec("^\\s*(\\w+)\\s+'(.+)'", lines)) + valid <- Filter(function(x) length(x) == 3, matches) + if(length(valid) > 0) { + name_map <- setNames(sapply(valid, `[`, 3), sapply(valid, `[`, 2)) + assign("rice_region_names", name_map, envir=.GlobalEnv) + } + } + }, error = function(e) NULL) + # Apply nice region names if they exist if(exists("nice_region_names", envir=.GlobalEnv)) { nice_region_names <- get("nice_region_names", envir=.GlobalEnv) diff --git a/R/gdx_loader_new.R b/R/gdx_loader_new.R index 8c1e812..798d38b 100644 --- a/R/gdx_loader_new.R +++ b/R/gdx_loader_new.R @@ -11,38 +11,55 @@ .discover_gdx_files <- function(results_dir, restrict_files = "results_", exclude_files = "") { message("Searching for GDX files in: ", results_dir) - # Find all GDX files - all_files <- gsub("\\.gdx$", "", list.files( - path = results_dir, - pattern = "\\.gdx$", - full.names = FALSE, - recursive = FALSE - )) + # Helper: list GDX basenames in dir, return relative paths (with optional prefix) + .find_gdx_in_dir <- function(dir, prefix = "") { + if (!dir.exists(dir)) return(character(0)) + found <- gsub("\\.gdx$", "", list.files( + path = dir, pattern = "\\.gdx$", full.names = FALSE, recursive = FALSE + )) + if (length(found) > 0 && nchar(prefix) > 0) found <- file.path(prefix, found) + found + } + + # Files directly in results_dir + all_files <- .find_gdx_in_dir(results_dir) + + # Also search results_dir/results/ and its immediate subdirectories + results_subdir <- file.path(results_dir, "results") + if (dir.exists(results_subdir)) { + all_files <- c(all_files, .find_gdx_in_dir(results_subdir, "results")) + sub_dirs <- list.dirs(results_subdir, full.names = FALSE, recursive = FALSE) + for (sub_dir in sub_dirs[nchar(sub_dirs) > 0]) { + all_files <- c(all_files, .find_gdx_in_dir( + file.path(results_subdir, sub_dir), file.path("results", sub_dir) + )) + } + } if (length(all_files) == 0) { stop("No GDX files found in: ", results_dir) } - # ALWAYS filter to files starting with "results_" first - all_files <- all_files[stringr::str_starts(all_files, "results_")] + # Filter on basename: must contain "results_" (matches old str_detect behaviour) + all_files <- all_files[stringr::str_detect(basename(all_files), "results_")] if (length(all_files) == 0) { stop("No GDX files starting with 'results_' found in: ", results_dir) } - # Apply additional inclusion filters (if restrict_files is not "results_") + # Apply additional inclusion filters on basename (if restrict_files is not "results_") if (!is.null(restrict_files) && restrict_files != "" && restrict_files != "results_") { patterns <- if (is.character(restrict_files)) restrict_files else unlist(restrict_files) filtered <- all_files for (pattern in patterns) { - filtered <- filtered[stringr::str_detect(filtered, pattern)] + filtered <- filtered[stringr::str_detect(basename(filtered), pattern)] } all_files <- unique(filtered) } - # Apply exclusion filter + # Apply exclusion filter on basename if (!is.null(exclude_files) && exclude_files != "") { - all_files <- all_files[!stringr::str_detect(all_files, paste(exclude_files, collapse = "|"))] + all_files <- all_files[!stringr::str_detect(basename(all_files), paste(exclude_files, collapse = "|"))] } if (length(all_files) == 0) { @@ -72,10 +89,25 @@ valid_files <- intersect(names(scenlist_custom), filelist) scenlist <- scenlist_custom[valid_files] } else { - # Auto-generate scenario names from filenames - scenario_names <- filelist + # Auto-generate scenario names from basename only (strip path prefix first) + basenames <- basename(filelist) + scenario_names <- basenames if (!is.null(removepattern) && removepattern != "") { - scenario_names <- gsub(paste(removepattern, collapse = "|"), "", filelist) + scenario_names <- gsub(paste(removepattern, collapse = "|"), "", basenames) + } + # Disambiguate duplicate names by prepending the subfolder group label + dups <- duplicated(scenario_names) | duplicated(scenario_names, fromLast = TRUE) + if (any(dups)) { + group_labels <- sapply(filelist, function(f) { + parts <- strsplit(f, "/", fixed = TRUE)[[1]] + if (length(parts) >= 3) parts[length(parts) - 1L] + else if (length(parts) == 2) parts[1L] + else "" + }) + for (i in which(dups)) { + if (nchar(group_labels[i]) > 0) + scenario_names[i] <- paste0(scenario_names[i], " [", group_labels[i], "]") + } } scenlist <- setNames(scenario_names, filelist) } @@ -83,6 +115,27 @@ scenlist } +#' Extract subfolder group labels for each file in filelist +#' +#' Files directly in results_dir or in results_dir/results/ get group label "". +#' Files in results_dir/results/subdir/ get group label "subdir". +#' +#' @param filelist Character vector of GDX file IDs (as returned by .discover_gdx_files) +#' @return Named character vector: fileid -> group label +#' @keywords internal +.get_scenlist_groups <- function(filelist) { + group_labels <- sapply(filelist, function(f) { + parts <- strsplit(f, "/", fixed = TRUE)[[1]] + # 1 part: "results_foo" → top-level root → "" + # 2 parts: "results/results_foo" → directly in results/ → "results" + # 3 parts: "results/bar/results_foo" → in subdir → "bar" + if (length(parts) >= 3) parts[length(parts) - 1L] + else if (length(parts) == 2) parts[1L] + else "" + }) + setNames(group_labels, filelist) +} + #' Load GDX session data #' #' Main function that discovers files, creates scenario list, and loads metadata. @@ -156,6 +209,7 @@ region_palette = region_info$palette, region_palette_short = region_info$palette_short, region_palette_long = region_info$palette_long, + rice_region_names = region_info$rice_region_names, stochastic_files = metadata$stochastic_files, var_descriptions = metadata$var_descriptions ) @@ -241,6 +295,19 @@ # Get regions from GDX files regions <- .get_regions_from_gdx(filelist, results_dir) + # Try to read region long names from data_{reg_id}/n.inc element text + # (gdxtools does not expose set element text from GDX files) + rice_region_names <- tryCatch({ + n_inc_path <- file.path(results_dir[1], paste0("data_", reg_id), "n.inc") + if(file.exists(n_inc_path)) { + lines <- readLines(n_inc_path, warn=FALSE) + matches <- regmatches(lines, regexec("^\\s*(\\w+)\\s+'(.+)'", lines)) + valid <- Filter(function(x) length(x) == 3, matches) + if(length(valid) > 0) + setNames(sapply(valid, `[`, 3), sapply(valid, `[`, 2)) + else NULL + } else NULL + }, error = function(e) NULL) # Create color palettes palette <- get_region_palette(regions, reg_id) @@ -263,7 +330,8 @@ reg_id = reg_id, palette = palette, palette_short = palette_short, - palette_long = palette_long + palette_long = palette_long, + rice_region_names = rice_region_names ) } @@ -307,6 +375,7 @@ .set_global_session_vars <- function(session_data) { assign("filelist", session_data$filelist, envir = .GlobalEnv) assign("scenlist", session_data$scenlist, envir = .GlobalEnv) + assign("scenlist_groups", .get_scenlist_groups(session_data$filelist), envir = .GlobalEnv) assign("file_group_columns", session_data$file_group_columns, envir = .GlobalEnv) assign("reg_id", session_data$reg_id, envir = .GlobalEnv) assign("witch_regions", session_data$regions, envir = .GlobalEnv) @@ -316,5 +385,7 @@ assign("region_palette_longnames", session_data$region_palette_long, envir = .GlobalEnv) assign("stochastic_files", session_data$stochastic_files, envir = .GlobalEnv) assign("all_var_descriptions", session_data$var_descriptions, envir = .GlobalEnv) + if(!is.null(session_data$rice_region_names)) + assign("rice_region_names", session_data$rice_region_names, envir = .GlobalEnv) invisible(NULL) } diff --git a/R/shiny_ui_helpers.R b/R/shiny_ui_helpers.R index b65afd9..9366b48 100644 --- a/R/shiny_ui_helpers.R +++ b/R/shiny_ui_helpers.R @@ -1,18 +1,50 @@ create_scenario_selector <- function(scenlist) { - selectInput(inputId="scenarios_selected", label="Scenarios:", choices=unname(scenlist), size=length(scenlist), selectize=FALSE, multiple=TRUE, selected=unname(scenlist)) + scenarios <- unname(scenlist) + groups <- if (exists("scenlist_groups", envir = .GlobalEnv)) get("scenlist_groups", envir = .GlobalEnv) else NULL + if (!is.null(groups)) { + grp_labels <- groups[names(scenlist)] + grp_labels[is.na(grp_labels)] <- "" + if (any(grp_labels != "")) { + grp_labels[grp_labels == ""] <- "root" + root_scens <- scenarios[grp_labels == "root"] + other_scens <- scenarios[grp_labels != "root"] + other_labels <- grp_labels[grp_labels != "root"] + choices <- c(setNames(as.list(root_scens), root_scens), split(other_scens, other_labels)) + return(selectInput(inputId="scenarios_selected", label="Scenarios:", choices=choices, + size=min(length(scenlist), 10), selectize=FALSE, multiple=TRUE, selected=scenarios)) + } + } + selectInput(inputId="scenarios_selected", label="Scenarios:", choices=scenarios, + size=min(length(scenlist), 10), selectize=FALSE, multiple=TRUE, selected=scenarios) } -create_variable_selector <- function(list_of_variables, default_var="Q_EMI", use_picker=TRUE) { +create_variable_selector <- function(list_of_variables, default_var="Q_EMI", use_picker=TRUE, descriptions=NULL) { if(use_picker) { - pickerInput(inputId="variable_selected", label="Variable:", choices=list_of_variables, selected=default_var, options=list(`live-search`=TRUE)) + space_tokens <- gsub("_", " ", list_of_variables) + picker_opts <- list(`live-search`=TRUE, `live-search-style`='contains') + if(!is.null(descriptions) && nrow(descriptions) > 0) { + desc_text <- descriptions$description[match(list_of_variables, descriptions$name)] + desc_text[is.na(desc_text)] <- "" + pickerInput(inputId="variable_selected", label="Variable:", choices=list_of_variables, selected=default_var, + options=picker_opts, choicesOpt=list(subtext=desc_text, tokens=space_tokens)) + } else { + pickerInput(inputId="variable_selected", label="Variable:", choices=list_of_variables, selected=default_var, + options=picker_opts, choicesOpt=list(tokens=space_tokens)) + } } else { selectInput(inputId="variable_selected", label="Variable:", choices=list_of_variables, size=1, selectize=FALSE, multiple=FALSE, selected=default_var) } } create_region_selector <- function(witch_regions, include_aggregates=c("World", "EU"), default_region="World") { - if(length(include_aggregates)>0) { - regions_for_selector <- list(Aggregate=as.list(include_aggregates), `Native regions`=witch_regions) + region_names_map <- if(exists("rice_region_names")) rice_region_names else witch_region_longnames + long_names <- region_names_map[witch_regions] + display_labels <- ifelse(!is.na(long_names), + paste0(witch_regions, " - ", long_names), + witch_regions) + named_regions <- setNames(as.list(witch_regions), display_labels) + if(length(include_aggregates) > 0) { + regions_for_selector <- list(Aggregate=as.list(setNames(include_aggregates, include_aggregates)), `Native regions`=named_regions) } else { - regions_for_selector <- c(witch_regions, include_aggregates) + regions_for_selector <- named_regions } selectInput(inputId="regions_selected", label="Regions:", regions_for_selector, size=max(10, length(regions_for_selector)), selectize=FALSE, multiple=TRUE, selected=default_region) } diff --git a/R/witchplot.R b/R/witchplot.R index 0b50296..4cbaae3 100644 --- a/R/witchplot.R +++ b/R/witchplot.R @@ -37,7 +37,7 @@ tryCatch({ "results_dir", "restrict_files", "exclude_files", "removepattern", "deploy_online", "figure_format", "add_historical", "write_plotdata_csv", "reg_id", "year0", "tstep", "yearmin", "yearmax", - "filelist", "scenlist", "file_group_columns", + "filelist", "scenlist", "scenlist_groups", "file_group_columns", "witch_regions", "display_regions", "region_palette", "region_palette_specific_short", "region_palette_longnames", "stochastic_files", "all_var_descriptions", diff --git a/README.md b/README.md index ee3c9bb..d8dc7df 100644 --- a/README.md +++ b/README.md @@ -61,15 +61,22 @@ library(witchplot) run_witch() # Uses defaults: results_dir="./" - # Or specify custom paths: - run_witch( results_dir=c("results", "results_v2"), ) -``` +# To run the development version use +devtools::load_all("path/to/witchplot") +run_witch() + +# or for RICE: +devtools::load_all("path/to/witchplot") +run_rice() + + +``` ### RICE50+ Model diff --git a/inst/gdxcompaR/data_browser_module.R b/inst/gdxcompaR/data_browser_module.R new file mode 100644 index 0000000..1db3302 --- /dev/null +++ b/inst/gdxcompaR/data_browser_module.R @@ -0,0 +1,342 @@ +# Data Browser Shiny Module +# +# Browses two categories of GDX data: +# - Historical/validation data: witchplot's bundled data_historical_values_*.gdx +# - Model input data: data_{reg_id}/*.gdx found relative to results_dir +# +# Removal: delete this file and remove the three tagged lines: +# global.R : source("../data_browser_module.R") # DATA_BROWSER +# ui.R : tabPanel("Data Browser", ...) # DATA_BROWSER +# server.R : dataBrowserServer("data_browser") # DATA_BROWSER + +# ---- Helpers ---------------------------------------------------------------- + +# Convert model time index t to calendar year using globals year0/tstep. +.db_t_to_year <- function(t_vals) { + y0 <- if (exists("year0")) get("year0") else 2005 + tstep <- if (exists("tstep")) get("tstep") else 5 + (as.numeric(t_vals) - 1) * tstep + y0 +} + +# Detect the "time" column and its type: "year" (calendar), "t" (model index), or NULL. +.db_time_col <- function(d) { + if ("year" %in% names(d)) return(list(col = "year", type = "year")) + if ("t" %in% names(d)) return(list(col = "t", type = "t")) + # Heuristic: any non-value column whose numeric values all fall in 1800-2200 + for (col in setdiff(names(d), "value")) { + vals <- suppressWarnings(as.numeric(as.character(d[[col]]))) + if (!all(is.na(vals)) && min(vals, na.rm = TRUE) >= 1800 && + max(vals, na.rm = TRUE) <= 2200) + return(list(col = col, type = "year")) + } + NULL +} + +# Build display labels for GDX parameters. +# Historical: "q_emi_valid_primap" -> "q_emi [primap]" +# Model: "ssp_ykali" -> "ssp_ykali" +.db_param_choices <- function(param_names) { + has_valid <- grepl("_valid_", param_names) + labels <- ifelse( + has_valid, + paste0(gsub("_valid_.*$", "", param_names), " [", + gsub("^.*_valid_", "", param_names), "]"), + param_names + ) + setNames(param_names, labels) +} + +# Discover GDX files and return a grouped list suitable for selectInput. +# Groups: "Historical data" (bundled) and "Model input (data_{reg_id}/)" (local). +.db_discover_files <- function() { + result <- list(hist = character(0), model = character(0), model_label = "Model input") + + # 1. Bundled historical files + pkg_dir <- system.file("data", package = "witchplot") + if (nchar(pkg_dir) > 0) { + files <- list.files(pkg_dir, pattern = "data_historical_values_.*\\.gdx$", + full.names = TRUE) + nms <- gsub("data_historical_values_(.*)\\.gdx$", "\\1", basename(files)) + result$hist <- setNames(files, nms) + } + + # 2. Local data_{reg_id}/ directory (relative to results_dir or cwd) + reg <- if (exists("reg_id")) get("reg_id") else NULL + rdirs <- if (exists("results_dir")) get("results_dir") else NULL + if (!is.null(reg) && !is.null(rdirs)) { + data_dirname <- paste0("data_", reg) + candidates <- unique(c( + file.path(rdirs[1], data_dirname), + file.path(dirname(normalizePath(rdirs[1], mustWork = FALSE)), data_dirname), + file.path(getwd(), data_dirname) + )) + local_dir <- candidates[dir.exists(candidates)][1] + if (length(local_dir) > 0 && !is.na(local_dir)) { + files <- list.files(local_dir, pattern = "\\.gdx$", full.names = TRUE) + nms <- gsub("\\.gdx$", "", basename(files)) + result$model <- setNames(files, nms) + result$model_label <- paste0("Model input (", data_dirname, "/)") + } + } + result +} + +# ---- UI (split into sidebar + main so they can slot into pageWithSidebar) --- + +# Sidebar controls — drop into conditionalPanel inside sidebarPanel +dataBrowserSidebarUI <- function(id) { + ns <- NS(id) + tagList( + strong("Data source:"), + selectInput(ns("gdx_file"), NULL, + choices = character(0), selectize = FALSE, size = 6), + hr(), + strong("Parameter:"), + uiOutput(ns("param_selector")), + hr(), + uiOutput(ns("region_filter")), + uiOutput(ns("extra_filters")), + uiOutput(ns("time_slider")) + ) +} + +# Main panel content — drop into conditionalPanel inside mainPanel +dataBrowserMainUI <- function(id) { + ns <- NS(id) + tabsetPanel( + tabPanel("Plot", plotOutput(ns("data_plot"), height = "80vh")), + tabPanel("Table", br(), uiOutput(ns("table_info")), uiOutput(ns("data_table_ui"))) + ) +} + +# ---- Server ----------------------------------------------------------------- + +dataBrowserServer <- function(id) { + moduleServer(id, function(input, output, session) { + ns <- session$ns + + # File inventory (built once at startup) + file_inventory <- .db_discover_files() + + # Column-name map for historical parameters + set_deps <- local({ + dep_file <- system.file("data", "historical_data_set_dependencies.rds", + package = "witchplot") + if (file.exists(dep_file)) readRDS(dep_file) else list() + }) + + # Populate file selector with grouped choices + observe({ + inv <- file_inventory + ch <- list() + if (length(inv$hist) > 0) ch[["Historical data"]] <- as.list(inv$hist) + if (length(inv$model) > 0) ch[[inv$model_label]] <- as.list(inv$model) + if (length(ch) == 0) return() + first <- if (length(inv$model) > 0) inv$model[[1]] else inv$hist[[1]] + updateSelectInput(session, "gdx_file", choices = ch, selected = first) + }) + + # GDX object for selected file + gdx_meta <- reactive({ + req(input$gdx_file) + tryCatch(gdx(input$gdx_file), error = function(e) NULL) + }) + + # Parameter selector + output$param_selector <- renderUI({ + g <- gdx_meta(); req(!is.null(g)) + ch <- .db_param_choices(g$parameters$name) + req(length(ch) > 0) + selectInput(ns("param_name"), NULL, + choices = ch, selected = ch[1], selectize = TRUE) + }) + + # Raw data for selected parameter (with named columns applied) + raw_data <- reactive({ + req(input$param_name, input$gdx_file) + g <- gdx_meta(); req(!is.null(g)) + d <- tryCatch(g[input$param_name], error = function(e) NULL) + if (is.null(d) || nrow(d) == 0) return(NULL) + + # Apply set_dependencies names where available (historical files) + dep_names <- set_deps[[input$param_name]] + if (!is.null(dep_names) && length(dep_names) == ncol(d) - 1) + colnames(d)[seq_along(dep_names)] <- dep_names + + d + }) + + # Summarise dimension structure + dim_info <- reactive({ + d <- raw_data(); req(d) + tc <- .db_time_col(d) + cols <- setdiff(names(d), "value") + list( + time = tc, + has_n = "n" %in% cols, + extra = setdiff(cols, c(if (!is.null(tc)) tc$col, "n")) + ) + }) + + # ---- Dynamic filter UIs ------------------------------------------------- + + output$region_filter <- renderUI({ + info <- dim_info() + if (!info$has_n) return(NULL) + d <- raw_data() + regions <- sort(unique(as.character(d$n))) + tagList( + strong("Region:"), + selectInput(ns("n_filter"), NULL, + choices = regions, + selected = regions[1:min(5, length(regions))], + multiple = TRUE, + size = min(8, length(regions)), + selectize = FALSE) + ) + }) + + output$extra_filters <- renderUI({ + d <- raw_data(); req(d) + info <- dim_info() + if (length(info$extra) == 0) return(NULL) + tagList(lapply(info$extra, function(col) { + vals <- sort(unique(as.character(d[[col]]))) + tagList( + strong(paste0(col, ":")), + selectInput(ns(paste0("filter_", col)), NULL, + choices = c("(all)" = "__all__", setNames(vals, vals)), + selected = "__all__", + multiple = TRUE, + size = min(6, length(vals) + 1), + selectize = FALSE) + ) + })) + }) + + output$time_slider <- renderUI({ + info <- dim_info() + if (is.null(info$time)) return(NULL) + d <- raw_data() + tc <- info$time + raw_t <- suppressWarnings(as.numeric(as.character(d[[tc$col]]))) + yr <- if (tc$type == "t") .db_t_to_year(raw_t) else raw_t + yr <- yr[!is.na(yr)] + yr_min <- min(yr); yr_max <- max(yr) + step <- if (tc$type == "t") .db_t_to_year(2) - .db_t_to_year(1) else 1 + tagList( + strong("Year range:"), + sliderInput(ns("year_range"), NULL, + min = yr_min, max = yr_max, + value = c(max(yr_min, 1960), yr_max), + step = step, sep = "") + ) + }) + + # ---- Filtered data ------------------------------------------------------ + + filtered_data <- reactive({ + d <- raw_data(); req(d) + info <- dim_info() + + if (!is.null(info$time) && !is.null(input$year_range)) { + tc <- info$time + raw <- suppressWarnings(as.numeric(as.character(d[[tc$col]]))) + yr <- if (tc$type == "t") .db_t_to_year(raw) else raw + d <- d[!is.na(yr) & yr >= input$year_range[1] & yr <= input$year_range[2], ] + } + if (info$has_n && !is.null(input$n_filter) && length(input$n_filter) > 0) + d <- d[d$n %in% input$n_filter, ] + for (col in info$extra) { + sel <- input[[paste0("filter_", col)]] + if (!is.null(sel) && !("__all__" %in% sel)) + d <- d[d[[col]] %in% sel, ] + } + d + }) + + # ---- Plot --------------------------------------------------------------- + + output$data_plot <- renderPlot({ + d <- filtered_data(); req(d, nrow(d) > 0) + info <- dim_info() + + if (!is.null(info$time)) { + tc <- info$time + raw_t <- suppressWarnings(as.numeric(as.character(d[[tc$col]]))) + d$year <- if (tc$type == "t") .db_t_to_year(raw_t) else raw_t + d <- d[!is.na(d$year), ] + + active_extra <- Filter(function(col) length(unique(d[[col]])) > 1, info$extra) + + # Aggregate over extra dims if too many combinations + if (length(active_extra) > 0) { + n_combos <- prod(sapply(active_extra, function(col) length(unique(d[[col]])))) + if (n_combos > 12) { + grp <- c("year", if (info$has_n) "n") + d <- d %>% + group_by(across(all_of(grp))) %>% + summarise(value = sum(value, na.rm = TRUE), .groups = "drop") + active_extra <- character(0) + } + } + + color_col <- if (info$has_n && length(unique(d$n)) > 1) "n" else + if (length(active_extra) > 0) active_extra[1] else NULL + + p <- ggplot(d, aes(x = year, y = value)) + if (!is.null(color_col)) p <- p + aes(color = .data[[color_col]]) + p <- p + geom_line(linewidth = 1) + + xlab("Year") + ylab("Value") + + theme(text = element_text(size = 14), + legend.position = "bottom", + legend.title = element_blank()) + + guides(color = guide_legend(nrow = 4)) + if (!is.null(color_col) && length(unique(d[[color_col]])) > 20) + p <- p + theme(legend.position = "none") + + } else { + x_col <- if (info$has_n) "n" else setdiff(names(d), "value")[1] + p <- ggplot(d, aes(x = .data[[x_col]], y = value)) + + geom_col(fill = "steelblue") + + xlab(x_col) + ylab("Value") + + theme(text = element_text(size = 14), + axis.text.x = element_text(angle = 45, hjust = 1)) + } + print(p) + }) + + # ---- Table -------------------------------------------------------------- + + output$table_info <- renderUI({ + d <- filtered_data(); req(d) + tags$p(style = "color: grey;", + sprintf("%d rows × %d columns", nrow(d), ncol(d))) + }) + + output$data_table_ui <- renderUI({ + if (requireNamespace("DT", quietly = TRUE)) + DT::dataTableOutput(ns("data_table_dt")) + else + tagList( + tags$p(style = "color: grey; font-size: 0.85em;", + "(Install the DT package for an interactive table)"), + tableOutput(ns("data_table_plain")) + ) + }) + + if (requireNamespace("DT", quietly = TRUE)) { + output$data_table_dt <- DT::renderDataTable({ + d <- filtered_data(); req(d) + DT::datatable(d, options = list(pageLength = 20, scrollX = TRUE), + rownames = FALSE) + }) + } + + output$data_table_plain <- renderTable({ + d <- filtered_data(); req(d) + head(d, 500) + }) + + }) +} diff --git a/inst/gdxcompaR/fidelio/server.R b/inst/gdxcompaR/fidelio/server.R index 9c4dc26..90e6f15 100644 --- a/inst/gdxcompaR/fidelio/server.R +++ b/inst/gdxcompaR/fidelio/server.R @@ -1,14 +1,45 @@ shinyServer(function(input, output, session) { +# Re-initialize on session start to pick up new files (supports F5) +.initialize_witchplot_session() + +# Reactive trigger for file refresh +refresh_trigger <- reactiveVal(0) + +# Observe refresh button +observeEvent(input$refresh_files, { + withProgress(message = 'Refreshing GDX files...', value = 0, { + .initialize_witchplot_session() + refresh_trigger(refresh_trigger() + 1) + }) +}) + verbose <- FALSE growth_rate <- FALSE -list_of_variables <- get_gdx_variable_list_simple(results_dir, filelist) -list_of_variables <- str_subset(list_of_variables, pattern="_t$") -output$select_scenarios <- renderUI({selectInput("scenarios_selected", "Select scenarios", unname(scenlist), size=length(scenlist), selectize=FALSE, multiple=TRUE, selected=unname(scenlist))}) + +# Make list of variables reactive so it updates on refresh +list_of_variables_reactive <- reactive({ + refresh_trigger() + vars <- get_gdx_variable_list_simple(results_dir, filelist) + str_subset(vars, pattern="_t$") +}) + +output$select_scenarios <- renderUI({ + refresh_trigger() + selectInput("scenarios_selected", "Select scenarios", unname(scenlist), size=length(scenlist), selectize=FALSE, multiple=TRUE, selected=unname(scenlist)) +}) + output$select_variable <- renderUI({ + list_of_variables <- list_of_variables_reactive() default_var <- if("GDPr_t" %in% list_of_variables) "GDPr_t" else list_of_variables[1] selectInput("variable_selected", "Select variable", list_of_variables, size=1, selectize=FALSE, multiple=FALSE, selected=default_var) }) -output$select_regions <- renderUI({regions_for_selector <- c(witch_regions, "World"); selectInput("regions_selected", "Select regions", regions_for_selector, size=min(17, length(regions_for_selector)), selectize=FALSE, multiple=TRUE, selected=witch_regions)}) + +output$select_regions <- renderUI({ + refresh_trigger() + regions_for_selector <- c(witch_regions, "World") + selectInput("regions_selected", "Select regions", regions_for_selector, size=min(17, length(regions_for_selector)), selectize=FALSE, multiple=TRUE, selected=witch_regions) +}) + variable_selected_reactive <- reactive({input$variable_selected}) variable_input <- reactive({return(input$variable_selected)}) output$varname <- renderText({ @@ -42,7 +73,7 @@ ylim_zero <- input$ylim_zero field_show <- input$field growth_rate <- input$growth_rate variable <- input$variable_selected -if(is.null(variable)) variable <- list_of_variables[1] +if(is.null(variable)) variable <- list_of_variables_reactive()[1] afd <- get_witch(variable, , field=field_show) if(verbose) print(str_glue("Variable {variable} loaded.")) @@ -54,7 +85,7 @@ if(!has_time) { set_info <- extract_additional_sets(afd, file_group_columns) output$choose_additional_set <- renderUI({ variable <- variable_input() - if(is.null(variable)) variable <- list_of_variables[1] + if(is.null(variable)) variable <- list_of_variables_reactive()[1] sel <- input$additional_set_id_selected if(is.null(sel)){ if("co2_ffi" %in% set_info$set_elements) sel <- "co2_ffi" else sel <- set_info$set_elements[1] @@ -64,12 +95,11 @@ if(!has_time) { }) output$choose_additional_set2 <- renderUI({ variable <- variable_input() - if(is.null(variable)) variable <- list_of_variables[1] + if(is.null(variable)) variable <- list_of_variables_reactive()[1] sel2 <- input$additional_set_id_selected2 size_elements2 <- min(length(set_info$set_elements2), 5) selectInput(inputId="additional_set_id_selected2", label="Index 2:", choices=set_info$set_elements2, size=size_elements2, selectize=FALSE, multiple=TRUE, selected=sel2) }) - filtered_data <- afd # Order pathdir factor according to results_dir vector if("pathdir" %in% names(filtered_data) && length(results_dir) > 1) { @@ -80,7 +110,6 @@ if(!has_time) { additional_set_selected2 <- input$additional_set_id_selected2 regions <- input$regions_selected scenarios <- input$scenarios_selected - if(is.null(additional_set_selected)) additional_set_selected <- set_info$set_elements[1] if(set_info$additional_set_id != "na") { filtered_data[[set_info$additional_set_id]] <- tolower(filtered_data[[set_info$additional_set_id]]) @@ -101,21 +130,21 @@ if(!has_time) { # Show plot as usual set_info <- extract_additional_sets(afd, file_group_columns) output$choose_additional_set <- renderUI({ - variable <- variable_input() - if(is.null(variable)) variable <- list_of_variables[1] - sel <- input$additional_set_id_selected - if(is.null(sel)){ - if("co2_ffi" %in% set_info$set_elements) sel <- "co2_ffi" else sel <- set_info$set_elements[1] - } - size_elements <- min(length(set_info$set_elements), 5) - selectInput(inputId="additional_set_id_selected", label="Index 1:", choices=set_info$set_elements, size=size_elements, selectize=FALSE, multiple=TRUE, selected=sel) + variable <- variable_input() + if(is.null(variable)) variable <- list_of_variables_reactive()[1] + sel <- input$additional_set_id_selected + if(is.null(sel)){ + if("co2_ffi" %in% set_info$set_elements) sel <- "co2_ffi" else sel <- set_info$set_elements[1] + } + size_elements <- min(length(set_info$set_elements), 5) + selectInput(inputId="additional_set_id_selected", label="Index 1:", choices=set_info$set_elements, size=size_elements, selectize=FALSE, multiple=TRUE, selected=sel) }) output$choose_additional_set2 <- renderUI({ - variable <- variable_input() - if(is.null(variable)) variable <- list_of_variables[1] - sel2 <- input$additional_set_id_selected2 - size_elements2 <- min(length(set_info$set_elements2), 5) - selectInput(inputId="additional_set_id_selected2", label="Index 2:", choices=set_info$set_elements2, size=size_elements2, selectize=FALSE, multiple=TRUE, selected=sel2) + variable <- variable_input() + if(is.null(variable)) variable <- list_of_variables_reactive()[1] + sel2 <- input$additional_set_id_selected2 + size_elements2 <- min(length(set_info$set_elements2), 5) + selectInput(inputId="additional_set_id_selected2", label="Index 2:", choices=set_info$set_elements2, size=size_elements2, selectize=FALSE, multiple=TRUE, selected=sel2) }) yearlim <- input$yearlim additional_set_selected <- input$additional_set_id_selected @@ -128,23 +157,23 @@ if(!has_time) { afd <- plot_data$data unit_conv <- plot_data$unit_conv if(growth_rate){ - unit_conv$unit <- " % p.a." - unit_conv$convert <- 1 + unit_conv$unit <- " % p.a." + unit_conv$convert <- 1 } afd$n <- ifelse(afd$n=="World", "World", toupper(afd$n)) if(regions[1]=="World" | length(regions)==1){ - p <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(year, value, colour=file)) + geom_line(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + xlim(yearlim[1], yearlim[2]) - if(ylim_zero) p <- p + ylim(0, NA) - if(show_historical) { - p <- p + geom_line(data=subset(afd, n %in% regions & str_detect(file, "historical")), aes(year, value, colour=file), stat="identity", linewidth=1.0, linetype="solid") - } - p <- p + theme(text=element_text(size=16), legend.position="bottom", legend.direction="horizontal", legend.box="vertical", legend.key=element_rect(colour=NA), legend.title=element_blank()) + guides(color=guide_legend(title=NULL)) + p <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(year, value, colour=file)) + geom_line(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + xlim(yearlim[1], yearlim[2]) + if(ylim_zero) p <- p + ylim(0, NA) + if(show_historical) { + p <- p + geom_line(data=subset(afd, n %in% regions & str_detect(file, "historical")), aes(year, value, colour=file), stat="identity", linewidth=1.0, linetype="solid") + } + p <- p + theme(text=element_text(size=16), legend.position="bottom", legend.direction="horizontal", legend.box="vertical", legend.key=element_rect(colour=NA), legend.title=element_blank()) + guides(color=guide_legend(title=NULL)) }else{ - p <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(year, value, colour=n, linetype=file)) + geom_line(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + scale_colour_manual(values=region_palette) + xlim(yearlim[1], yearlim[2]) - if(show_historical) { - p <- p + geom_line(data=subset(afd, n %in% regions & str_detect(file, "historical")), aes(year, value, colour=n, group=interaction(n, file)), linetype="solid", stat="identity", linewidth=1.0) - } - p <- p + theme(text=element_text(size=16), legend.position="bottom", legend.direction="horizontal", legend.box="vertical", legend.key=element_rect(colour=NA), legend.title=element_blank()) + guides(color=guide_legend(title=NULL, nrow=2), linetype=guide_legend(title=NULL)) + p <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(year, value, colour=n, linetype=file)) + geom_line(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + scale_colour_manual(values=region_palette) + xlim(yearlim[1], yearlim[2]) + if(show_historical) { + p <- p + geom_line(data=subset(afd, n %in% regions & str_detect(file, "historical")), aes(year, value, colour=n, group=interaction(n, file)), linetype="solid", stat="identity", linewidth=1.0) + } + p <- p + theme(text=element_text(size=16), legend.position="bottom", legend.direction="horizontal", legend.box="vertical", legend.key=element_rect(colour=NA), legend.title=element_blank()) + guides(color=guide_legend(title=NULL, nrow=2), linetype=guide_legend(title=NULL)) } if(length(results_dir)!=1) p <- p + facet_grid(. ~ pathdir) if(nrow(afd)>0) { @@ -156,13 +185,13 @@ output$gdxcompaRstackedplot <- renderPlot({ show_historical <- input$add_historical # Checkbox controls plot visibility ylim_zero <- input$ylim_zero variable <- input$variable_selected -if(is.null(variable)) variable <- list_of_variables[1] +if(is.null(variable)) variable <- list_of_variables_reactive()[1] afd <- get_witch(variable, ) if(verbose) print(str_glue("Variable {variable} loaded.")) set_info <- extract_additional_sets(afd, file_group_columns) output$choose_additional_set <- renderUI({ variable <- variable_selected_reactive() -if(is.null(variable)) variable <- list_of_variables[1] +if(is.null(variable)) variable <- list_of_variables_reactive()[1] sel <- input$additional_set_id_selected size_elements <- min(length(set_info$set_elements), 5) selectInput("additional_set_id_selected", "Index 1:", set_info$set_elements, size=size_elements, selectize=FALSE, multiple=TRUE, selected=sel) @@ -216,7 +245,7 @@ growth_rate <- input$growth_rate field_show <- input$field plotly_dynamic <- input$plotly_dynamic variable <- input$variable_selected -if(is.null(variable)) variable <- list_of_variables[1] +if(is.null(variable)) variable <- list_of_variables_reactive()[1] plot_data <- prepare_plot_data(variable, field_show, input$yearlim, input$scenarios_selected, "na", "na", NULL, NULL, input$regions_selected, growth_rate, time_filter=TRUE, compute_aggregates=TRUE, verbose=verbose) afd <- plot_data$data unit_conv <- plot_data$unit_conv diff --git a/inst/gdxcompaR/fidelio/ui.R b/inst/gdxcompaR/fidelio/ui.R index ac10e00..f9d196c 100644 --- a/inst/gdxcompaR/fidelio/ui.R +++ b/inst/gdxcompaR/fidelio/ui.R @@ -30,7 +30,10 @@ shinyUI(fluidPage( value = FALSE)), div(style="display:inline-block",checkboxInput("growth_rate", "Show growth rates", value = F)), div(style="display:inline-block",radioButtons("field", "", choiceNames = c("l","up","lo"), choiceValues = c("l","up","lo"), inline = TRUE)), - div(style="display:inline-block",actionButton("button_saveplotdata", "Save Plot")) + div(style="margin-top: 10px;", + div(style="display:inline-block",actionButton("button_saveplotdata", "Save Plot")), + div(style="display:inline-block",actionButton("refresh_files", "Refresh Files", icon=icon("sync"))) + ) ), diff --git a/inst/gdxcompaR/rice/global.R b/inst/gdxcompaR/rice/global.R index f96ceba..a58ed93 100644 --- a/inst/gdxcompaR/rice/global.R +++ b/inst/gdxcompaR/rice/global.R @@ -19,3 +19,4 @@ suppressPackageStartupMessages({ if(requireNamespace("rnaturalearth", quietly=TRUE)) library(rnaturalearth) if(requireNamespace("sf", quietly=TRUE)) library(sf) }) +source("../data_browser_module.R") # DATA_BROWSER diff --git a/inst/gdxcompaR/rice/server.R b/inst/gdxcompaR/rice/server.R index f63810f..977ddc1 100644 --- a/inst/gdxcompaR/rice/server.R +++ b/inst/gdxcompaR/rice/server.R @@ -1,18 +1,80 @@ shinyServer(function(input, output, session) { +# Re-initialize on session start to pick up new files (supports F5) +.initialize_witchplot_session() + +# Reactive trigger for file refresh +refresh_trigger <- reactiveVal(0) + +# Observe refresh button +observeEvent(input$refresh_files, { + withProgress(message = 'Refreshing GDX files...', value = 0, { + .initialize_witchplot_session() + refresh_trigger(refresh_trigger() + 1) + }) +}) + +dataBrowserServer("data_browser") # DATA_BROWSER verbose <- FALSE growth_rate <- FALSE -list_of_variables <- get_gdx_variable_list_simple(results_dir, filelist) -output$select_scenarios <- renderUI({create_scenario_selector(scenlist)}) -output$select_variable <- renderUI({create_variable_selector(list_of_variables, default_var="E", use_picker=TRUE)}) -output$select_regions <- renderUI({create_region_selector(witch_regions, include_aggregates=c("World"), default_region="World")}) + +# Make list of variables reactive so it updates on refresh +list_of_variables_reactive <- reactive({ + refresh_trigger() + get_gdx_variable_list_simple(results_dir, filelist) +}) + +output$select_scenarios <- renderUI({ + refresh_trigger() + create_scenario_selector(scenlist) +}) + +output$select_variable <- renderUI({ + list_of_variables <- list_of_variables_reactive() + create_variable_selector(list_of_variables, default_var="E", use_picker=TRUE, descriptions=if(exists("all_var_descriptions")) all_var_descriptions else NULL) +}) + +output$select_regions <- renderUI({ + refresh_trigger() + create_region_selector(witch_regions, include_aggregates=c("World"), default_region="World") +}) + variable_selected_reactive <- reactive({input$variable_selected}) + +set_info_reactive <- reactive({ + refresh_trigger() + variable <- variable_selected_reactive() + list_of_variables <- list_of_variables_reactive() + if(is.null(variable)) variable <- list_of_variables_reactive()[1] + field_show <- input$field + afd <- get_witch(variable, , field=field_show) + extract_additional_sets(afd, file_group_columns) +}) + output$varname <- renderText({ - var_text <- paste0("Variable: ", variable_selected_reactive()) - if(!is.null(input$additional_set_id_selected) && input$additional_set_id_selected[1] != "na") { - var_text <- paste0(var_text, " - Element: ", paste(input$additional_set_id_selected, collapse=",")) + var <- variable_selected_reactive() + if(is.null(var) || length(var) == 0) return("") + desc <- "" + if(exists("all_var_descriptions") && !is.null(var) && var %in% all_var_descriptions$name) { + d <- all_var_descriptions$description[all_var_descriptions$name == var] + if(length(d) > 0 && nchar(d[1]) > 0) desc <- paste0(" \u2014 ", d[1]) + } + var_text <- paste0(var, desc) + set_info <- set_info_reactive() + # Apply same fallback logic as renderPlot so the title always reflects what is shown + eff_sel <- input$additional_set_id_selected + if(is.null(eff_sel) || (set_info$additional_set_id != "na" && (eff_sel[1] == "na" || !(eff_sel[1] %in% set_info$set_elements)))) { + eff_sel <- set_info$set_elements[1] + } + if(set_info$additional_set_id != "na") { + var_text <- paste0(var_text, " [", paste(eff_sel, collapse=", "), "]") + } + if(set_info$additional_set_id2 != "na") { + eff_sel2 <- input$additional_set_id_selected2 + if(is.null(eff_sel2) || eff_sel2[1] == "na") eff_sel2 <- set_info$set_elements2[1] + var_text <- paste0(var_text, " [", paste(eff_sel2, collapse=", "), "]") } if(!is.null(input$regions_selected) && length(input$regions_selected)==1) { - var_text <- paste0(var_text, " - Region: ", input$regions_selected[1]) + var_text <- paste0(var_text, " \u2014 ", input$regions_selected[1]) } var_text }) @@ -28,7 +90,7 @@ field_show <- input$field growth_rate <- input$growth_rate stacked_plot <- input$stacked_plot variable <- input$variable_selected -if(is.null(variable)) variable <- list_of_variables[1] +if(is.null(variable)) variable <- list_of_variables_reactive()[1] afd <- get_witch(variable, , field=field_show) # Always loads with historical if add_historical was TRUE at startup if(verbose) print(str_glue("Variable {variable} loaded.")) @@ -40,12 +102,16 @@ if(!has_time) { set_info <- extract_additional_sets(afd, file_group_columns) output$choose_additional_set <- renderUI({ variable <- variable_selected_reactive() - if(is.null(variable)) variable <- list_of_variables[1] + if(is.null(variable)) variable <- list_of_variables_reactive()[1] sel <- input$additional_set_id_selected size_elements <- min(length(set_info$set_elements), 5) - selectInput("additional_set_id_selected", "Index 1:", set_info$set_elements, size=size_elements, selectize=FALSE, multiple=TRUE, selected=sel) + label1 <- set_info$additional_set_id + if(exists("all_var_descriptions") && label1 %in% all_var_descriptions$name) { + d <- all_var_descriptions$description[all_var_descriptions$name == label1] + if(length(d) > 0 && nchar(d[1]) > 0) label1 <- paste0(label1, " (", d[1], ")") + } + selectInput("additional_set_id_selected", paste0(label1, ":"), set_info$set_elements, size=size_elements, selectize=FALSE, multiple=TRUE, selected=sel) }) - filtered_data <- afd # Order pathdir factor according to results_dir vector if("pathdir" %in% names(filtered_data) && length(results_dir) > 1) { @@ -55,7 +121,6 @@ if(!has_time) { additional_set_selected <- input$additional_set_id_selected regions <- input$regions_selected scenarios <- input$scenarios_selected - if(is.null(additional_set_selected)) additional_set_selected <- set_info$set_elements[1] if(set_info$additional_set_id != "na") { filtered_data[[set_info$additional_set_id]] <- tolower(filtered_data[[set_info$additional_set_id]]) @@ -72,46 +137,72 @@ if(!has_time) { # Show plot as usual set_info <- extract_additional_sets(afd, file_group_columns) output$choose_additional_set <- renderUI({ - variable <- variable_selected_reactive() - if(is.null(variable)) variable <- list_of_variables[1] - sel <- input$additional_set_id_selected - size_elements <- min(length(set_info$set_elements), 5) - selectInput("additional_set_id_selected", "Index 1:", set_info$set_elements, size=size_elements, selectize=FALSE, multiple=TRUE, selected=sel) + if(set_info$additional_set_id == "na") return(NULL) + variable <- variable_selected_reactive() + if(is.null(variable)) variable <- list_of_variables_reactive()[1] + sel <- input$additional_set_id_selected + size_elements <- min(length(set_info$set_elements), 5) + label1 <- set_info$additional_set_id + if(exists("all_var_descriptions") && label1 %in% all_var_descriptions$name) { + d <- all_var_descriptions$description[all_var_descriptions$name == label1] + if(length(d) > 0 && nchar(d[1]) > 0) label1 <- paste0(label1, " (", d[1], ")") + } + selectInput("additional_set_id_selected", paste0(label1, ":"), set_info$set_elements, size=size_elements, selectize=FALSE, multiple=TRUE, selected=sel) + }) + output$choose_additional_set2 <- renderUI({ + if(set_info$additional_set_id2 == "na") return(NULL) + sel2 <- input$additional_set_id_selected2 + size_elements2 <- min(length(set_info$set_elements2), 5) + label2 <- set_info$additional_set_id2 + if(exists("all_var_descriptions") && label2 %in% all_var_descriptions$name) { + d <- all_var_descriptions$description[all_var_descriptions$name == label2] + if(length(d) > 0 && nchar(d[1]) > 0) label2 <- paste0(label2, " (", d[1], ")") + } + selectInput("additional_set_id_selected2", paste0(label2, ":"), set_info$set_elements2, size=size_elements2, selectize=FALSE, multiple=TRUE, selected=sel2) }) yearlim <- input$yearlim additional_set_selected <- input$additional_set_id_selected + additional_set_selected2 <- input$additional_set_id_selected2 regions <- input$regions_selected scenarios <- input$scenarios_selected if(is.null(regions)) regions <- display_regions if(is.null(additional_set_selected)) additional_set_selected <- set_info$set_elements[1] if((set_info$additional_set_id!="na" & additional_set_selected[1]=="na") | !(additional_set_selected[1] %in% set_info$set_elements)) additional_set_selected <- set_info$set_elements[1] - plot_data <- prepare_plot_data(variable, field_show, yearlim, scenarios, set_info$additional_set_id, additional_set_selected, NULL, NULL, regions, growth_rate, time_filter=TRUE, compute_aggregates=TRUE, verbose=verbose) + if(set_info$additional_set_id2 != "na" && (is.null(additional_set_selected2) || additional_set_selected2[1] == "na")) additional_set_selected2 <- set_info$set_elements2[1] + plot_data <- prepare_plot_data(variable, field_show, yearlim, scenarios, set_info$additional_set_id, additional_set_selected, set_info$additional_set_id2, additional_set_selected2, regions, growth_rate, time_filter=TRUE, compute_aggregates=TRUE, verbose=verbose) afd <- plot_data$data unit_conv <- plot_data$unit_conv if(growth_rate){ - unit_conv$unit <- " % p.a." - unit_conv$convert <- 1 + unit_conv$unit <- " % p.a." + unit_conv$convert <- 1 + } + # Pre-compute year column (respects tlen for variable time steps) + if(!"year" %in% names(afd)) { + if("tlen" %in% names(afd)) { + afd$year <- ttoyear(afd$t, afd$tlen) + } else { + afd$year <- ttoyear(afd$t) + } } - # If stacked plot is requested, use stacked area plot if(stacked_plot && length(regions) > 1){ - p <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(year, value, fill=n)) + geom_area(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + scale_fill_manual(values=region_palette) + xlim(yearlim[1], yearlim[2]) - p <- p + theme(text=element_text(size=16), legend.position="bottom", legend.direction="horizontal", legend.box="vertical", legend.key=element_rect(colour=NA), legend.title=element_blank()) + guides(fill=guide_legend(title=NULL, nrow=2)) - if(!is.null(scenarios) && length(scenarios)>1) p <- p + facet_wrap(. ~ file) + p <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(year, value, fill=n)) + geom_area(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + scale_fill_manual(values=region_palette) + scale_x_continuous(breaks = scales::breaks_pretty(n = 8), limits = c(yearlim[1], yearlim[2])) + p <- p + theme(text=element_text(size=16), legend.position="bottom", legend.direction="horizontal", legend.box="vertical", legend.key=element_rect(colour=NA), legend.title=element_blank()) + guides(fill=guide_legend(title=NULL, nrow=2)) + if(!is.null(scenarios) && length(scenarios)>1) p <- p + facet_wrap(. ~ file) } else if(regions[1]=="World" | length(regions)==1){ - p <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(year, value, colour=file)) + geom_line(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + xlim(yearlim[1], yearlim[2]) - if(ylim_zero) p <- p + ylim(0, NA) - if(show_historical) { - p <- p + geom_line(data=subset(afd, n %in% regions & str_detect(file, "historical")), aes(year, value, colour=file), stat="identity", linewidth=1.0, linetype="solid") - p <- p + geom_point(data=subset(afd, n %in% regions & str_detect(file, "valid")), aes(year, value, colour=file), size=4.0, shape=18) - } - p <- p + theme(text=element_text(size=16), legend.position="bottom", legend.direction="horizontal", legend.box="vertical", legend.key=element_rect(colour=NA), legend.title=element_blank()) + guides(color=guide_legend(title=NULL)) + p <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(year, value, colour=file)) + geom_line(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + scale_x_continuous(breaks = scales::breaks_pretty(n = 8), limits = c(yearlim[1], yearlim[2])) + if(ylim_zero) p <- p + ylim(0, NA) + if(show_historical) { + p <- p + geom_line(data=subset(afd, n %in% regions & str_detect(file, "historical")), aes(year, value, colour=file), stat="identity", linewidth=1.0, linetype="solid") + p <- p + geom_point(data=subset(afd, n %in% regions & str_detect(file, "valid")), aes(year, value, colour=file), size=4.0, shape=18) + } + p <- p + theme(text=element_text(size=16), legend.position="bottom", legend.direction="horizontal", legend.box="vertical", legend.key=element_rect(colour=NA), legend.title=element_blank()) + guides(color=guide_legend(title=NULL)) }else{ - p <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(year, value, colour=n, linetype=file)) + geom_line(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + scale_colour_manual(values=region_palette) + xlim(yearlim[1], yearlim[2]) - if(show_historical) { - p <- p + geom_line(data=subset(afd, n %in% regions & str_detect(file, "historical")), aes(year, value, colour=n, group=interaction(n, file)), linetype="solid", stat="identity", linewidth=1.0) - p <- p + geom_point(data=subset(afd, n %in% regions & str_detect(file, "valid")), aes(year, value, colour=n, shape=file), size=4.0) - } - p <- p + theme(text=element_text(size=16), legend.position="bottom", legend.direction="horizontal", legend.box="vertical", legend.key=element_rect(colour=NA), legend.title=element_blank()) + guides(color=guide_legend(title=NULL, nrow=2), linetype=guide_legend(title=NULL)) + p <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(year, value, colour=n, linetype=file)) + geom_line(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + scale_colour_manual(values=region_palette) + scale_x_continuous(breaks = scales::breaks_pretty(n = 8), limits = c(yearlim[1], yearlim[2])) + if(show_historical) { + p <- p + geom_line(data=subset(afd, n %in% regions & str_detect(file, "historical")), aes(year, value, colour=n, group=interaction(n, file)), linetype="solid", stat="identity", linewidth=1.0) + p <- p + geom_point(data=subset(afd, n %in% regions & str_detect(file, "valid")), aes(year, value, colour=n, shape=file), size=4.0) + } + p <- p + theme(text=element_text(size=16), legend.position="bottom", legend.direction="horizontal", legend.box="vertical", legend.key=element_rect(colour=NA), legend.title=element_blank()) + guides(color=guide_legend(title=NULL, nrow=2), linetype=guide_legend(title=NULL)) } if(length(results_dir)!=1 && !stacked_plot) p <- p + facet_grid(. ~ pathdir) if(nrow(afd)>0) { @@ -124,25 +215,44 @@ show_historical <- input$add_historical # Checkbox controls plot visibility ylim_zero <- input$ylim_zero field_show <- input$field variable <- input$variable_selected -if(is.null(variable)) variable <- list_of_variables[1] +if(is.null(variable)) variable <- list_of_variables_reactive()[1] afd <- get_witch(variable, , field=field_show) if(verbose) print(str_glue("Variable {variable} loaded.")) set_info <- extract_additional_sets(afd, file_group_columns) output$choose_additional_set <- renderUI({ +if(set_info$additional_set_id == "na") return(NULL) variable <- variable_selected_reactive() -if(is.null(variable)) variable <- list_of_variables[1] +if(is.null(variable)) variable <- list_of_variables_reactive()[1] sel <- input$additional_set_id_selected size_elements <- min(length(set_info$set_elements), 5) -selectInput("additional_set_id_selected", "Index 1:", set_info$set_elements, size=size_elements, selectize=FALSE, multiple=TRUE, selected=sel) +label1 <- set_info$additional_set_id +if(exists("all_var_descriptions") && label1 %in% all_var_descriptions$name) { + d <- all_var_descriptions$description[all_var_descriptions$name == label1] + if(length(d) > 0 && nchar(d[1]) > 0) label1 <- paste0(label1, " (", d[1], ")") +} +selectInput("additional_set_id_selected", paste0(label1, ":"), set_info$set_elements, size=size_elements, selectize=FALSE, multiple=TRUE, selected=sel) +}) +output$choose_additional_set2 <- renderUI({ +if(set_info$additional_set_id2 == "na") return(NULL) +sel2 <- input$additional_set_id_selected2 +size_elements2 <- min(length(set_info$set_elements2), 5) +label2 <- set_info$additional_set_id2 +if(exists("all_var_descriptions") && label2 %in% all_var_descriptions$name) { + d <- all_var_descriptions$description[all_var_descriptions$name == label2] + if(length(d) > 0 && nchar(d[1]) > 0) label2 <- paste0(label2, " (", d[1], ")") +} +selectInput("additional_set_id_selected2", paste0(label2, ":"), set_info$set_elements2, size=size_elements2, selectize=FALSE, multiple=TRUE, selected=sel2) }) yearlim <- input$yearlim additional_set_selected <- input$additional_set_id_selected +additional_set_selected2 <- input$additional_set_id_selected2 regions <- input$regions_selected scenarios <- input$scenarios_selected if(is.null(regions)) regions <- display_regions if(is.null(additional_set_selected)) additional_set_selected <- set_info$set_elements[1] if((set_info$additional_set_id!="na" & additional_set_selected[1]=="na") | !(additional_set_selected[1] %in% set_info$set_elements)) additional_set_selected <- set_info$set_elements[1] -afd <- subset_by_additional_sets(afd, set_info$additional_set_id, additional_set_selected, NULL, NULL) +if(set_info$additional_set_id2 != "na" && (is.null(additional_set_selected2) || additional_set_selected2[1] == "na")) additional_set_selected2 <- set_info$set_elements2[1] +afd <- subset_by_additional_sets(afd, set_info$additional_set_id, additional_set_selected, set_info$additional_set_id2, additional_set_selected2) # Order pathdir factor according to results_dir vector if("pathdir" %in% names(afd) && length(results_dir) > 1) { pathdir_levels <- basename(results_dir) @@ -168,7 +278,7 @@ if(scen==scenarios[1]) afd_hist_temp <- afd_hist else afd_hist_temp <- rbind(afd afd <- rbind(afd, afd_hist) unit_conv <- unit_conversion(variable) afd$value <- afd$value * unit_conv$convert -p_stacked <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(year, value, fill=n)) + geom_area(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + scale_fill_manual(values=region_palette) + xlim(yearlim[1], yearlim[2]) +p_stacked <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(year, value, fill=n)) + geom_area(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + scale_fill_manual(values=region_palette) + scale_x_continuous(breaks = scales::breaks_pretty(n = 8), limits = c(yearlim[1], yearlim[2])) p_stacked <- p_stacked + theme(text=element_text(size=16), legend.position="bottom", legend.direction="horizontal", legend.box="vertical", legend.key=element_rect(colour=NA), legend.title=element_blank()) + guides(fill=guide_legend(title=NULL, nrow=2)) if(!is.null(scenarios)) p_stacked <- p_stacked + facet_wrap(. ~ file) if(nrow(afd)>0) print(p_stacked + labs(title=variable)) @@ -180,7 +290,7 @@ field_show <- input$field growth_rate <- input$growth_rate stacked_plot <- input$stacked_plot variable <- input$variable_selected -if(is.null(variable)) variable <- list_of_variables[1] +if(is.null(variable)) variable <- list_of_variables_reactive()[1] afd <- get_witch(variable, , field=field_show) if(verbose) print(str_glue("Variable {variable} loaded.")) set_info <- extract_additional_sets(afd, file_group_columns) @@ -200,11 +310,11 @@ unit_conv$convert <- 1 } # Create plot using same logic as gdxcompaRplot if(stacked_plot && length(regions) > 1){ -p <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(ttoyear(t), value, fill=n)) + geom_area(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + scale_fill_manual(values=region_palette) + xlim(yearlim[1], yearlim[2]) +p <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(ttoyear(t), value, fill=n)) + geom_area(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + scale_fill_manual(values=region_palette) + scale_x_continuous(breaks = scales::breaks_pretty(n = 8), limits = c(yearlim[1], yearlim[2])) p <- p + theme(text=element_text(size=16), legend.position="bottom", legend.direction="horizontal", legend.box="vertical", legend.key=element_rect(colour=NA), legend.title=element_blank()) + guides(fill=guide_legend(title=NULL, nrow=2)) if(!is.null(scenarios) && length(scenarios)>1) p <- p + facet_wrap(. ~ file) } else if(regions[1]=="World" | length(regions)==1){ -p <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(ttoyear(t), value, colour=file)) + geom_line(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + xlim(yearlim[1], yearlim[2]) +p <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(ttoyear(t), value, colour=file)) + geom_line(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + scale_x_continuous(breaks = scales::breaks_pretty(n = 8), limits = c(yearlim[1], yearlim[2])) if(ylim_zero) p <- p + ylim(0, NA) if(show_historical) { p <- p + geom_line(data=subset(afd, n %in% regions & str_detect(file, "historical")), aes(year, value, colour=file), stat="identity", linewidth=1.0, linetype="solid") @@ -212,7 +322,7 @@ if(show_historical) { } p <- p + theme(text=element_text(size=16), legend.position="bottom", legend.direction="horizontal", legend.box="vertical", legend.key=element_rect(colour=NA), legend.title=element_blank()) + guides(color=guide_legend(title=NULL)) }else{ -p <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(ttoyear(t), value, colour=n, linetype=file)) + geom_line(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + scale_colour_manual(values=region_palette) + xlim(yearlim[1], yearlim[2]) +p <- ggplot(subset(afd, n %in% regions & !str_detect(file, "historical") & !str_detect(file, "valid")), aes(ttoyear(t), value, colour=n, linetype=file)) + geom_line(stat="identity", linewidth=1.5) + xlab("year") + ylab(unit_conv$unit) + scale_colour_manual(values=region_palette) + scale_x_continuous(breaks = scales::breaks_pretty(n = 8), limits = c(yearlim[1], yearlim[2])) if(show_historical) { p <- p + geom_line(data=subset(afd, n %in% regions & str_detect(file, "historical")), aes(year, value, colour=n, group=interaction(n, file)), linetype="solid", stat="identity", linewidth=1.0) p <- p + geom_point(data=subset(afd, n %in% regions & str_detect(file, "valid")), aes(year, value, colour=n, shape=file), size=4.0) diff --git a/inst/gdxcompaR/rice/ui.R b/inst/gdxcompaR/rice/ui.R index 37aa273..74c95ac 100644 --- a/inst/gdxcompaR/rice/ui.R +++ b/inst/gdxcompaR/rice/ui.R @@ -2,32 +2,50 @@ header_ui <- headerPanel("RICE50+ gdxcompaR") sidebar_ui <- sidebarPanel( - uiOutput("select_scenarios"), - uiOutput("select_variable"), - uiOutput("choose_additional_set"), - uiOutput("select_regions"), - sliderInput("yearlim", - "Time", - min = 1970, - max = 2300, - value = c(1990,2100), - step = 5), - div(style="display:inline-block",checkboxInput("add_historical", "Show historical", value = if(exists("add_historical")) add_historical else TRUE)), - div(style="display:inline-block", - checkboxInput("ylim_zero", - "ymin=0", - value = FALSE)), - div(style="display:inline-block",checkboxInput("growth_rate", "Show growth rates", value = F)), - div(style="display:inline-block",checkboxInput("stacked_plot", "Stacked plot", value = F)), - tags$div(style="display:inline-block", - tags$label("Show:", style="display:inline-block; margin-right: 5px;"), - div(style="display:inline-block", radioButtons("field", "", choiceNames = c("l","up","lo"), choiceValues = c("l","up","lo"), inline = TRUE)) + # Mode toggle # DATA_BROWSER + shinyWidgets::radioGroupButtons( # DATA_BROWSER + "app_mode", NULL, # DATA_BROWSER + choices = c("Results" = "scenarios", "Inputs" = "data"), # DATA_BROWSER + selected = "scenarios", justified = TRUE, size = "sm" # DATA_BROWSER + ), # DATA_BROWSER + hr(), + # Scenarios sidebar + conditionalPanel("input.app_mode == 'scenarios'", + uiOutput("select_scenarios"), + uiOutput("select_variable"), + uiOutput("choose_additional_set"), + uiOutput("choose_additional_set2"), + uiOutput("select_regions"), + sliderInput("yearlim", + "Time", + min = 1970, + max = 2300, + value = c(1990,2100), + step = 5), + div(style="display:inline-block",checkboxInput("add_historical", "Show historical", value = if(exists("add_historical")) add_historical else TRUE)), + div(style="display:inline-block", + checkboxInput("ylim_zero", + "ymin=0", + value = FALSE)), + div(style="display:inline-block",checkboxInput("growth_rate", "Show growth rates", value = F)), + div(style="display:inline-block",checkboxInput("stacked_plot", "Stacked plot", value = F)), + tags$div(style="display:inline-block", + tags$label("Show:", style="display:inline-block; margin-right: 5px;"), + div(style="display:inline-block", radioButtons("field", "", choiceNames = c("l","up","lo"), choiceValues = c("l","up","lo"), inline = TRUE)) + ), + div(style="margin-top: 10px;", + div(style="display:inline-block",actionButton("button_saveplotdata", "Save Plot")), + div(style="display:inline-block",actionButton("refresh_files", "Refresh Files", icon=icon("sync"))) + ) ), - div(style="display:inline-block",actionButton("button_saveplotdata", "Save Plot")) + # Data browser sidebar # DATA_BROWSER + conditionalPanel("input.app_mode == 'data'", # DATA_BROWSER + dataBrowserSidebarUI("data_browser") # DATA_BROWSER + ) # DATA_BROWSER ) - + tabs_ui <- tabsetPanel(type = "tabs", id = "tabs", - tabPanel("gdxcompaR", id = "gdxcompaR", h2(textOutput("varname")),uiOutput("gdxcompaRplot")), + tabPanel("gdxcompaR", id = "gdxcompaR", h2(textOutput("varname")), uiOutput("gdxcompaRplot")), tabPanel("Diagnostics", id = "diagnostics", plotOutput("diagnostics", width = "100%", height = "80vh")), tabPanel("Iterations", id = "iterationplot", plotOutput("iterationplot", width = "100%", height = "80vh")), tabPanel("gdxcompaR MAP", id = "gdxcompaR_map", plotOutput("gdxcompaRmap", width = "100%", height = "80vh")), @@ -35,18 +53,19 @@ tabs_ui <- tabsetPanel(type = "tabs", id = "tabs", ) ui <- fluidPage( - + pageWithSidebar( - - # Application title + header_ui, - - # Sidebar with a slider of years and set elements + sidebar_ui, - - # Show the plots - mainPanel(tabs_ui) - + + mainPanel( + conditionalPanel("input.app_mode == 'scenarios'", tabs_ui), # DATA_BROWSER + conditionalPanel("input.app_mode == 'data'", # DATA_BROWSER + dataBrowserMainUI("data_browser")) # DATA_BROWSER + ) + )) shinyUI(ui) diff --git a/inst/gdxcompaR/witch/global.R b/inst/gdxcompaR/witch/global.R index f47c3bd..8ded402 100644 --- a/inst/gdxcompaR/witch/global.R +++ b/inst/gdxcompaR/witch/global.R @@ -19,3 +19,4 @@ suppressPackageStartupMessages({ if(requireNamespace("rnaturalearth", quietly=TRUE)) library(rnaturalearth) if(requireNamespace("sf", quietly=TRUE)) library(sf) }) +source("../data_browser_module.R") # DATA_BROWSER diff --git a/inst/gdxcompaR/witch/server.R b/inst/gdxcompaR/witch/server.R index 558877b..933bbf2 100644 --- a/inst/gdxcompaR/witch/server.R +++ b/inst/gdxcompaR/witch/server.R @@ -1,4 +1,19 @@ shinyServer(function(input, output, session) { +# Re-initialize on session start to pick up new files (supports F5) +.initialize_witchplot_session() + +# Reactive trigger for file refresh +refresh_trigger <- reactiveVal(0) + +# Observe refresh button +observeEvent(input$refresh_files, { + withProgress(message = 'Refreshing GDX files...', value = 0, { + .initialize_witchplot_session() + refresh_trigger(refresh_trigger() + 1) + }) +}) + +dataBrowserServer("data_browser") # DATA_BROWSER verbose <- FALSE if(deploy_online){ suppressPackageStartupMessages(require(tidyverse)) @@ -7,18 +22,38 @@ require(shinyWidgets) add_historical_values <- function(x, varname, iiasadb, verbose){return(x)} get_witch <- function(variable, field){return(allvariables[[variable]])} } -list_of_variables <- get_gdx_variable_list(results_dir, filelist, filter_time_dependent=FALSE) -output$select_scenarios <- renderUI({create_scenario_selector(scenlist)}) -output$select_variable <- renderUI({create_variable_selector(list_of_variables, default_var="Q_EMI", use_picker=TRUE)}) -output$select_regions <- renderUI({create_region_selector(witch_regions, include_aggregates=c("World", "EU"), default_region="World")}) + +# Make list of variables reactive so it updates on refresh +list_of_variables_reactive <- reactive({ + refresh_trigger() + get_gdx_variable_list(results_dir, filelist, filter_time_dependent=FALSE) +}) + +output$select_scenarios <- renderUI({ + refresh_trigger() + create_scenario_selector(scenlist) +}) + +output$select_variable <- renderUI({ + list_of_variables <- list_of_variables_reactive() + create_variable_selector(list_of_variables, default_var="Q_EMI", use_picker=TRUE, descriptions=if(exists("all_var_descriptions")) all_var_descriptions else NULL) +}) + +output$select_regions <- renderUI({ + refresh_trigger() + create_region_selector(witch_regions, include_aggregates=c("World", "EU"), default_region="World") +}) + variable_input <- reactive({return(input$variable_selected)}) # PERFORMANCE FIX: Move index selectors OUTSIDE renderPlot # This prevents them from re-rendering every time the plot updates # Only update when variable changes set_info_reactive <- reactive({ + refresh_trigger() variable <- variable_input() - if(is.null(variable)) variable <- list_of_variables[1] + list_of_variables <- list_of_variables_reactive() + if(is.null(variable)) variable <- list_of_variables_reactive()[1] field_show <- input$field afd <- get_witch(variable, , field=field_show) extract_additional_sets(afd, file_group_columns) @@ -39,26 +74,53 @@ output$choose_additional_set <- renderUI({ } size_elements <- min(length(set_info$set_elements), 5) - selectInput(inputId="additional_set_id_selected", label="Index 1:", choices=set_info$set_elements, size=size_elements, selectize=FALSE, multiple=TRUE, selected=sel) + label1 <- if(set_info$additional_set_id != "na") set_info$additional_set_id else "Index 1" + if(exists("all_var_descriptions") && label1 %in% all_var_descriptions$name) { + d <- all_var_descriptions$description[all_var_descriptions$name == label1] + if(length(d) > 0 && nchar(d[1]) > 0) label1 <- paste0(label1, " (", d[1], ")") + } + selectInput(inputId="additional_set_id_selected", label=paste0(label1, ":"), choices=set_info$set_elements, size=size_elements, selectize=FALSE, multiple=TRUE, selected=sel) }) output$choose_additional_set2 <- renderUI({ set_info <- set_info_reactive() sel2 <- input$additional_set_id_selected2 size_elements2 <- min(length(set_info$set_elements2), 5) - selectInput(inputId="additional_set_id_selected2", label="Index 2:", choices=set_info$set_elements2, size=size_elements2, selectize=FALSE, multiple=TRUE, selected=sel2) + label2 <- if(set_info$additional_set_id2 != "na") set_info$additional_set_id2 else "Index 2" + if(exists("all_var_descriptions") && label2 %in% all_var_descriptions$name) { + d <- all_var_descriptions$description[all_var_descriptions$name == label2] + if(length(d) > 0 && nchar(d[1]) > 0) label2 <- paste0(label2, " (", d[1], ")") + } + selectInput(inputId="additional_set_id_selected2", label=paste0(label2, ":"), choices=set_info$set_elements2, size=size_elements2, selectize=FALSE, multiple=TRUE, selected=sel2) }) output$varname <- renderText({ - var_text <- paste0("Variable: ", variable_input()) - if(!is.null(input$additional_set_id_selected) && input$additional_set_id_selected[1] != "na") { - var_text <- paste0(var_text, " - Element: ", str_trunc(paste(input$additional_set_id_selected, collapse=","), 20)) + var <- variable_input() + if(is.null(var) || length(var) == 0) return("") + desc <- "" + if(exists("all_var_descriptions") && var %in% all_var_descriptions$name) { + d <- all_var_descriptions$description[all_var_descriptions$name == var] + if(length(d) > 0 && nchar(d[1]) > 0) desc <- paste0(" \u2014 ", d[1]) + } + var_text <- paste0(var, desc) + set_info <- set_info_reactive() + # Apply same fallback logic as renderPlot so the title always reflects what is shown + eff_sel <- input$additional_set_id_selected + if(is.null(eff_sel) || length(eff_sel) == 0 || eff_sel[1] == "na" || !(eff_sel[1] %in% set_info$set_elements)) { + eff_sel <- set_info$set_elements[1] } - if(!is.null(input$additional_set_id_selected2) && input$additional_set_id_selected2[1] != "na") { - var_text <- paste0(var_text, " - Element2: ", str_trunc(paste(input$additional_set_id_selected2, collapse=","), 20)) + if(set_info$additional_set_id != "na") { + var_text <- paste0(var_text, " [", str_trunc(paste(eff_sel, collapse=", "), 20), "]") + } + if(set_info$additional_set_id2 != "na") { + eff_sel2 <- input$additional_set_id_selected2 + if(is.null(eff_sel2) || length(eff_sel2) == 0 || eff_sel2[1] == "na" || !(eff_sel2[1] %in% set_info$set_elements2)) { + eff_sel2 <- set_info$set_elements2[1] + } + var_text <- paste0(var_text, " [", str_trunc(paste(eff_sel2, collapse=", "), 20), "]") } if(!is.null(input$regions_selected) && length(input$regions_selected)==1) { - var_text <- paste0(var_text, " - Region: ", input$regions_selected[1]) + var_text <- paste0(var_text, " \u2014 ", input$regions_selected[1]) } var_text }) @@ -74,7 +136,7 @@ show_historical <- input$add_historical ylim_zero <- input$ylim_zero field_show <- input$field variable <- input$variable_selected -if(is.null(variable)) variable <- list_of_variables[1] +if(is.null(variable)) variable <- list_of_variables_reactive()[1] set_info <- set_info_reactive() yearlim <- input$yearlim additional_set_selected <- input$additional_set_id_selected diff --git a/inst/gdxcompaR/witch/ui.R b/inst/gdxcompaR/witch/ui.R index 1af35ca..fdf136d 100644 --- a/inst/gdxcompaR/witch/ui.R +++ b/inst/gdxcompaR/witch/ui.R @@ -9,40 +9,57 @@ if(!exists("results_dir")){ load(file="allvariables.Rdata", envir = .GlobalEnv) #Install and load packages require_package <- function(package){ - suppressPackageStartupMessages(require(package,character.only=T, quietly = TRUE)) + suppressPackageStartupMessages(require(package,character.only=T, quietly = TRUE)) } pkgs <- c('data.table', 'stringr', 'countrycode', 'ggplot2', 'ggpubr', 'scales', 'RColorBrewer', 'dplyr', 'openxlsx', 'gsubfn', 'tidyr', 'rlang', 'shiny', 'shinythemes', 'plotly', 'purrr', 'reldist', 'tidytidbits', 'forcats', 'arrow') res <- lapply(pkgs, require_package) deploy_online <<- T -} +} header_ui <- headerPanel("WITCH gdxcompaR") sidebar_ui <- sidebarPanel( - uiOutput("select_scenarios"), - uiOutput("select_variable"), - uiOutput("choose_additional_set"), - uiOutput("choose_additional_set2"), - uiOutput("select_regions"), - sliderInput("yearlim", - "Time", - min = 1970, - max = 2150, - value = c(1990,2100), - step = 5), - div(style="display:inline-block", - checkboxInput("add_historical", - "Show historical", - value = if(exists("add_historical")) add_historical else TRUE)), - div(style="display:inline-block", - checkboxInput("ylim_zero", - "ymin=0", - value = FALSE)), - tags$div(style="display:inline-block", - tags$label("Show:", style="display:inline-block; margin-right: 5px;"), - div(style="display:inline-block", radioButtons("field", "", choiceNames = c("l","up","lo"), choiceValues = c("l","up","lo"), inline = TRUE)) + # Mode toggle # DATA_BROWSER + shinyWidgets::radioGroupButtons( # DATA_BROWSER + "app_mode", NULL, # DATA_BROWSER + choices = c("Scenarios" = "scenarios", "Data" = "data"), # DATA_BROWSER + selected = "scenarios", justified = TRUE, size = "sm" # DATA_BROWSER + ), # DATA_BROWSER + hr(), + # Scenarios sidebar + conditionalPanel("input.app_mode == 'scenarios'", + uiOutput("select_scenarios"), + uiOutput("select_variable"), + uiOutput("choose_additional_set"), + uiOutput("choose_additional_set2"), + uiOutput("select_regions"), + sliderInput("yearlim", + "Time", + min = 1970, + max = 2150, + value = c(1990,2100), + step = 5), + div(style="display:inline-block", + checkboxInput("add_historical", + "Show historical", + value = if(exists("add_historical")) add_historical else TRUE)), + div(style="display:inline-block", + checkboxInput("ylim_zero", + "ymin=0", + value = FALSE)), + tags$div(style="display:inline-block", + tags$label("Show:", style="display:inline-block; margin-right: 5px;"), + div(style="display:inline-block", radioButtons("field", "", choiceNames = c("l","up","lo"), choiceValues = c("l","up","lo"), inline = TRUE)) + ), + div(style="margin-top: 10px;", + div(style="display:inline-block",actionButton("button_saveplotdata", "Save Plot")), + div(style="display:inline-block",actionButton("refresh_files", "Refresh Files", icon=icon("sync"))) + ) ), - div(style="display:inline-block",actionButton("button_saveplotdata", "Save Plot")) + # Data browser sidebar # DATA_BROWSER + conditionalPanel("input.app_mode == 'data'", # DATA_BROWSER + dataBrowserSidebarUI("data_browser") # DATA_BROWSER + ) # DATA_BROWSER ) tabs_ui <- tabsetPanel(type = "tabs", id = "tabs", @@ -63,18 +80,19 @@ tabs_ui <- tabsetPanel(type = "tabs", id = "tabs", ) ui <- fluidPage( - + pageWithSidebar( - - # Application title + header_ui, - - # Sidebar with a slider of years and set elements + sidebar_ui, - - # Show the plots - mainPanel(tabs_ui) - + + mainPanel( + conditionalPanel("input.app_mode == 'scenarios'", tabs_ui), # DATA_BROWSER + conditionalPanel("input.app_mode == 'data'", # DATA_BROWSER + dataBrowserMainUI("data_browser")) # DATA_BROWSER + ) + )) shinyUI(ui)