From 725d621b8093a6a9b18d438c19b81ba790414208 Mon Sep 17 00:00:00 2001 From: Lene Oestvand Date: Fri, 21 Jan 2022 14:28:51 +0100 Subject: [PATCH 1/5] added text input field for legends in colour_choices.R and update verif_data in options_bar.R --- R/colour_choices.R | 35 +++++++++++++++++++++++++---------- R/options_bar.R | 18 ++++++++++++++++++ 2 files changed, 43 insertions(+), 10 deletions(-) diff --git a/R/colour_choices.R b/R/colour_choices.R index 49a05ef..4343551 100644 --- a/R/colour_choices.R +++ b/R/colour_choices.R @@ -103,15 +103,17 @@ colour_choices <- function(input, output, session, verif_data) { shiny::req(verif_data()) fcst_models <- unique(unlist(lapply(verif_data(), function(x) unique(x[["mname"]])))) colour_table_modal( - data.frame(mname = fcst_models, colour = palette_colours()[1:length(fcst_models)], stringsAsFactors = FALSE) + data.frame(mname = fcst_models, colour = palette_colours()[1:length(fcst_models)], new_legend = fcst_models, stringsAsFactors = FALSE) ) colour_table(colour_table_modal()) lapply( seq_along(fcst_models), - function(i) shiny::observeEvent(input[[paste0("colour_", i)]], { + function(i) shiny::observeEvent(c(input[[paste0("colour_", i)]], input[[paste0("legend_", i)]]), { modified_colours <- colour_table_modal() new_colour <- input[[paste0("colour_", i)]] modified_colours$colour[modified_colours$mname == fcst_models[i]] <- new_colour + new_legend <- input[[paste0("legend_", i)]] + modified_colours$new_legend[modified_colours$mname == fcst_models[i]] <- new_legend colour_table_modal(modified_colours) }) ) @@ -136,14 +138,27 @@ colour_choices <- function(input, output, session, verif_data) { c(RColorBrewer:::quallist, "harp2", "Custom"), selected_palette() ), - lapply(seq_along(fcst_models), function(i) - colourpicker::colourInput( - ns(paste0("colour_", i)), - fcst_models[i], - value = colour_table()$colour[i], - showColour = "background", - palette = palette, - allowedCols = allowed_cols + shiny::fluidRow( + column(6, + lapply(seq_along(fcst_models), function(i) + colourpicker::colourInput( + ns(paste0("colour_", i)), + fcst_models[i], + value = colour_table()$colour[i], + showColour = "background", + palette = palette, + allowedCols = allowed_cols + ) + ) + ), + column(6, + lapply(seq_along(fcst_models), function(i) + shiny::textInput( + ns(paste0("legend_", i)), + paste("Legend",fcst_models[i]), + colour_table()$new_legend[i] + ) + ) ) ), footer = shiny::tagList( diff --git a/R/options_bar.R b/R/options_bar.R index 0e808e7..101b54d 100644 --- a/R/options_bar.R +++ b/R/options_bar.R @@ -205,6 +205,24 @@ options_bar <- function(input, output, session) { } }) + # Update mname from input to create new legends + new_verif_data <- reactiveVal(NULL) + shiny::observeEvent(colour_table(), { + shiny::req(colour_table()) + fcst_models <- unique(unlist(lapply(verif_data(), function(x) unique(x[["mname"]])))) + + new_verif_data <- verif_data() + new_verif_data <- mutate_list( + new_verif_data, + mname = msub( + mname, + fcst_models, + colour_table()$new_legend + ) + ) + verif_data(new_verif_data) + }) + return(verif_data) } From 555123969718c81bf6d0224d740fb57c93b89e49 Mon Sep 17 00:00:00 2001 From: Lene Oestvand Date: Fri, 21 Jan 2022 14:33:00 +0100 Subject: [PATCH 2/5] modal size --- R/colour_choices.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/colour_choices.R b/R/colour_choices.R index 4343551..b6c6043 100644 --- a/R/colour_choices.R +++ b/R/colour_choices.R @@ -148,8 +148,8 @@ colour_choices <- function(input, output, session, verif_data) { showColour = "background", palette = palette, allowedCols = allowed_cols + ) ) - ) ), column(6, lapply(seq_along(fcst_models), function(i) @@ -157,15 +157,15 @@ colour_choices <- function(input, output, session, verif_data) { ns(paste0("legend_", i)), paste("Legend",fcst_models[i]), colour_table()$new_legend[i] + ) ) - ) ) ), footer = shiny::tagList( shiny::actionButton(ns("colours_modal_cancel"), "Cancel"), customActionButton(ns("colours_modal_ok"), "OK", btn_class = "primary") ), - size = "s" + size = "m" ) } From 916a66aa0a1e8b197db1b80a721aeacb52136cfd Mon Sep 17 00:00:00 2001 From: Lene Oestvand Date: Fri, 21 Jan 2022 14:35:35 +0100 Subject: [PATCH 3/5] include colour_table as argument in options_bar --- R/options_bar.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/options_bar.R b/R/options_bar.R index 101b54d..9fe7748 100644 --- a/R/options_bar.R +++ b/R/options_bar.R @@ -61,7 +61,7 @@ options_barUI <- function(id) { #' @export #' #' @examples -options_bar <- function(input, output, session) { +options_bar <- function(input, output, session, colour_table) { app_start_dir <- shiny::getShinyOption("app_start_dir") volumes <- c(Home = fs::path_home(), harp_getVolumes()()) From ac32ce822a2f9bd9b7fc1ddff6872848fb2600e9 Mon Sep 17 00:00:00 2001 From: Lene Oestvand Date: Fri, 21 Jan 2022 14:36:46 +0100 Subject: [PATCH 4/5] updated server.R --- inst/shiny_apps/plot_point_verif/server.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/shiny_apps/plot_point_verif/server.R b/inst/shiny_apps/plot_point_verif/server.R index bca5f23..48d9630 100644 --- a/inst/shiny_apps/plot_point_verif/server.R +++ b/inst/shiny_apps/plot_point_verif/server.R @@ -10,7 +10,7 @@ server <- function(input, output, session) { # LOAD DATA # ############################################################ - verif_data <- shiny::callModule(harpVis::options_bar, "options_bar") + verif_data <- shiny::callModule(harpVis::options_bar, "options_bar", colour_table) ############################################################ # FILTER DATA # From 4c2a7ce1a1ce7124c0d954d81d4e90a233374900 Mon Sep 17 00:00:00 2001 From: Lene Oestvand Date: Mon, 24 Jan 2022 10:40:16 +0100 Subject: [PATCH 5/5] comment in options_bar --- R/options_bar.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/options_bar.R b/R/options_bar.R index 9fe7748..1d25008 100644 --- a/R/options_bar.R +++ b/R/options_bar.R @@ -205,7 +205,7 @@ options_bar <- function(input, output, session, colour_table) { } }) - # Update mname from input to create new legends + # Update mname from text input to create new legends new_verif_data <- reactiveVal(NULL) shiny::observeEvent(colour_table(), { shiny::req(colour_table())