在带有动态滑块的 R Shiny 中,如何在添加/删除滑块时存储/保存滑块的值?

问题描述

这是我试图在 R Shiny 中实现的最小可重复示例。

最终用户将能够从一个非常大的列表中选择他们想要包含或删除的输入,这将为他们创建一个滑块来选择它们的值。这就是滑块是动态的原因,因为它们一次只需要几个,但范围很大。

在下面的示例中,对于带有原始 4 辆车的认 cargroup1,假设它们将所有 4 个滑块一直向右移动到 500。
现在让我们说他们需要 1 在列表中添加更多汽车(或为此删除一辆汽车)。
所有滑块在渲染后都会自动恢复为认值。我明白为什么会这样。
我想弄清楚的是如何存储/保存活动值,以便每当添加删除汽车 selectivizeinput 中的任何内容时,已选择但尚未删除的汽车滑块将保留它们当前所处的任何值恢复到认设置。

TIA

if(!require(shiny)) install.packages("shiny")
if(!require(tidyverse)) install.packages("tidyverse")

library(shiny)
library(tidyverse)

mtcarsd <- mtcars %>% rownames_to_column(var="car") 
cargroup <- mtcars[1:4,] %>% 
  rownames_to_column(var="car") %>%
  dplyr::select(c(1,8)) %>%
  mutate(group=as_factor("cargroup1"))


cargroup <- rbind(cargroup,mtcars[5:9,] %>% 
                    rownames_to_column(var="car") %>%
                    dplyr::select(c(1,8)) %>%
                    mutate(group="cargroup2"))


ui <- fluidPage(
  
  titlePanel("Dynamic sliders"),sidebarLayout(
    sidebarPanel(
      selectizeInput('group','Car Group:',choices = levels(cargroup$group),selected = 'cargroup1',multiple = FALSE),selectizeInput("car","Select or Modify Cars",choices  = mtcarsd$car,multiple = TRUE),# Create a uIoUtput to hold the sliders
      uIoUtput("sliders")
    ),mainPanel(
      plotOutput("distPlot")
    )
  )
)

server <- shinyServer(function(input,output,session) {
  
  observe({
    r <- mtcarsd %>% 
      filter(car %in% cargroup$car[cargroup$group==input$group],) %>% 
      dplyr::select(car)
    updateSelectizeInput(session,"car","Cars",server = TRUE,choices = mtcarsd$car,selected = r$car)
  })
  
  #Render the sliders
  output$sliders <- renderUI({
    # First,create a list of sliders each with a different name
    sliders <- lapply(1:length(input$car),function(i) {
      inputName <- input$car[i]
      inputValue <- inputName %>% as_tibble() %>% left_join(select(cargroup,qsec,car),by=c("value"="car")) %>%
        dplyr::select(qsec) %>% mutate_if(is.numeric,coalesce,0) %>% .$qsec
      sliderInput(paste0("Input",i),inputName,min=0,max=500,value=inputValue,post="g")
    })
    # Create a tagList of sliders (this is important)
    do.call(tagList,sliders)
  })
  
  
  output$distPlot <- renderPlot({
    hist(rnorm(100),col = 'darkgray',border = 'white')
  })
})

shinyApp(ui,server)

解决方法

暂无找到可以解决该程序问题的有效方法,小编努力寻找整理中!

如果你已经找到好的解决方法,欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@)