Combining Default Values with the Last User Selected Values from uiOutput sliderInputs in Shiny

[abtr1]

The below will dynamically create sliderinputs via renderUI/uiOutput while not overwriting the currently selected values whenever an input is added or deleted. In order to do this the value is being passed through isolate in the renderUI. This not overwriting the selected values is one part of what I am trying to accomplish.

The second part would be figuring out how to assign the original default values based on the amount column in the cgroup input.

So the desired result is that the user selects a cgroup, and that automatically loads the selected colors and the default values. Then as the user moves the slider values around- the values will always stay with the current value even if other colors are added or some of the colors are removed.

My struggle is that I can load the default values assigned to each cgroup OR I can set it (as written below) so that adding or deleting color inputs does not overwrite the user selected values - but I cannot seem to figure out how to do both.

The only time I want to use the default values is when their is a change in the color group (cgroup) input. When that occurs I want the values to use the default. Otherwise I want it to behave like below where it uses the last selected values.

I thought I could code for this but am really struggling to get it to work and feel like I am just missing an easy solution to accomplish this. Any help you could provide would be greatly appreciated. Thank you very much.

library(shiny)
colorchoice <- c("red","blue","green","purple","orange","yellow")
colorgroup <- as_tibble_col(colorchoice[1:4],column_name = "color") %>% 
  mutate(group=as_factor("group1"), amount = case_when(color=="red" ~ 30, 
                                                       color=="blue" ~ 10,
                                                       color=="purple" ~ 150,
                                                       color=="yellow" ~ 1000,
                                                       color=="green" ~ 600,
                                                       TRUE ~ 5))

colorgroup <- rbind(colorgroup, 
                    as_tibble_col(colorchoice[2:6],column_name = "color") %>%
                      mutate(group="group2", amount = case_when(color=="red" ~ 800, 
                                                                color=="blue" ~ 952,
                                                                color=="purple" ~ 5,
                                                                color=="yellow" ~ 50,
                                                                color=="green" ~ 35,
                                                                TRUE ~ 588)))


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectizeInput('cgroup', 'Color Group:', 
                     choices = levels(colorgroup$group),  
                     selected = 'group1', 
                     multiple = FALSE),
      selectizeInput("si", "Colors", choices  = colorchoice, multiple = TRUE),
      uiOutput("col"),
    ),
    mainPanel(
      plotOutput("plot")  
    )
  )
)


length(colorchoice)
server <- function(input, output, session) {
  observe({
    r <- colorgroup %>% 
      filter(group==input$cgroup) %>% 
      dplyr::select(color)
    updateSelectizeInput(session, "si","Colors",
                         server = TRUE,
                         choices = colorchoice,
                         selected = r$color)
  })
  
  
  col_names <- reactive(paste0(input$si))
  
  
  output$col <- renderUI({
    map(col_names(), ~ sliderInput(.x, label= .x, min=0, max=1000, value = isolate(input[[.x]])))
  })
  
  output$plot <- renderPlot({
    cols <- map_chr(col_names(), ~ input[[.x]] %||% "")
    # convert empty inputs to transparent
    cols[cols == ""] <- NA
    
    barplot(
      rep(1, length(cols)), 
      col = cols,
      space = 0, 
      axes = FALSE
    )
  }, res = 96)
}

shinyApp(ui = ui, server = server)

[nirgrahamuk]

library(shiny)
library(tidyverse)
colorchoice <- c("red","blue","green","purple","orange","yellow")
colorgroup <- as_tibble_col(colorchoice[1:4],column_name = "color") %>% 
  mutate(group=as_factor("group1"), amount = case_when(color=="red" ~ 30, 
                                                       color=="blue" ~ 10,
                                                       color=="purple" ~ 150,
                                                       color=="yellow" ~ 1000,
                                                       color=="green" ~ 600,
                                                       TRUE ~ 5))

colorgroup <- rbind(colorgroup, 
                    as_tibble_col(colorchoice[2:6],column_name = "color") %>%
                      mutate(group="group2", amount = case_when(color=="red" ~ 800, 
                                                                color=="blue" ~ 952,
                                                                color=="purple" ~ 5,
                                                                color=="yellow" ~ 50,
                                                                color=="green" ~ 35,
                                                                TRUE ~ 588)))


ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectizeInput('cgroup', 'Color Group:', 
                     choices = levels(colorgroup$group),  
                     selected = 'group1', 
                     multiple = FALSE),
      selectizeInput("si", "Colors", choices  = colorchoice, multiple = TRUE),
      uiOutput("col"),
    ),
    mainPanel(
      plotOutput("plot")  
    )
  )
)


length(colorchoice)
server <- function(input, output, session) {
  observe({
    r <- colorgroup %>% 
      filter(group==input$cgroup) %>% 
      dplyr::select(color)
    updateSelectizeInput(session, "si","Colors",
                         server = TRUE,
                         choices = colorchoice,
                         selected = r$color)
  })
  
  
  col_names <- reactive(paste0(input$si))
  
  
  output$col <- renderUI({
    map(req(col_names()), ~ {
      old_val <- isolate(input[[.x]])
      if (!isTruthy(old_val)) {
        old_val <- colorgroup %>%
          filter(group == input$cgroup) %>%
          filter(color == .x) %>%
          pull(amount)
      }
      sliderInput(.x, label = .x, min = 0, max = 1000, value = old_val)
    })
  })
  
  output$plot <- renderPlot({
    cols <- map_chr(col_names(), ~ input[[.x]] %||% "")
    # convert empty inputs to transparent
    cols[cols == ""] <- NA
    
    barplot(
      rep(1, length(cols)), 
      col = cols,
      space = 0, 
      axes = FALSE
    )
  }, res = 96)
}

shinyApp(ui = ui, server = server)

[abtr1]

This is wonderful thank you so much for your help