r - 在反应输出中使用 setSliderColor 更改滑块颜色

Question

我正在构建一个闪亮的应用程序，它有一个反应滑块，我希望条形颜色为红色。我正在尝试使用 shinyWidgets 包中的 setSliderColor() 函数，但它不起作用。我的假设是它没有拾取sliderId，因为它不是：

            
library(shiny)
library(shinyWidgets)


ui <- fluidPage(
    setSliderColor(c("green"), sliderId = c(1)),

    sidebarLayout(
        sidebarPanel(
            textInput(inputId = "greeting",
                      label = "Say hi!"),
            actionButton(inputId = "submit", 
                         label = "Submit"),

            uiOutput("num_slider"),

        ),
    mainPanel()
))

server <- function(input, output) {
    
    output$num_slider <- renderUI({
        shiny::req(input$greeting)
        shiny::req(input$submit)
        if(input$greeting == "hi!") {
            
        sliderInput(inputId = "num_filter2",
                    label = "Filter by Number",
                    min = 1,
                    max = 10,
                    value = c(1, 10))
        } else {
            sliderInput(inputId = "num_filter2",
                        label = "Filter by Number",
                        min = 1,
                        max = 5,
                        value = c(1, 5))
        }
    })
    
}

# Run the application 
shinyApp(ui = ui, server = server)

但是，奇怪的是。如果我在 UI 中放置一个常规滑块，它会突然检测到两者——但是如果我点击两次提交，颜色就会变回蓝色：

library(shiny)
library(shinyWidgets)


ui <- fluidPage(
    setSliderColor(c("green", "red"), sliderId = c(1, 2)),

    sidebarLayout(
        sidebarPanel(
            textInput(inputId = "greeting",
                      label = "Say hi!"),
            actionButton(inputId = "submit", 
                         label = "Submit"),

            uiOutput("num_slider"),
            sliderInput(inputId = "num_filter1",
                        label = "Now it works!",
                        min = 1,
                        max = 10,
                        value = c(1, 10))

        ),
    mainPanel()
))

server <- function(input, output) {
    
    output$num_slider <- renderUI({
        shiny::req(input$greeting)
        shiny::req(input$submit)
        if(input$greeting == "hi!") {
            
        sliderInput(inputId = "num_filter2",
                    label = "Filter by Number",
                    min = 1,
                    max = 10,
                    value = c(1, 10))
        } else {
            sliderInput(inputId = "num_filter2",
                        label = "Filter by Number",
                        min = 1,
                        max = 5,
                        value = c(1, 5))
        }
    })
    
}

# Run the application 
shinyApp(ui = ui, server = server)

关于如何解决这个问题的任何修复？如果它避免长时间的 HTML，我也对其他解决方案持开放态度，比如这个答案。

标签： rshinyreactive-programmingreactiveshinywidgets

Answer 1

该功能并非旨在与renderUI(). 每次调用都需要更新参数。

一个快速的解决方法是预先分配用户永远无法达到的非常大的向量（如 100 万）或reactiveValues()像这样使用：

注意：当“嗨！”时，滑块将变为绿色。作为输入传递。

library(shiny)
library(shinyWidgets)


ui <- fluidPage(
    
    
    sidebarLayout(
        sidebarPanel(
            textInput(inputId = "greeting",
                      label = "Say hi!"),
            actionButton(inputId = "submit", 
                         label = "Submit"),
            
            uiOutput("num_slider"),
            sliderInput(inputId = "num_filter1",
                        label = "Now it works!",
                        min = 1,
                        max = 10,
                        value = c(1, 10))
            
        ),
        mainPanel()
    ))

server <- function(input, output) {
    
    i <- reactiveValues()
    i$color <- 1
    i$color_name <- 'green'
    
    
    observeEvent(input$submit, {
        
        i$color <- c(i$color, i$color[[length(i$color)]] + 1)
        i$color_name <- c(i$color_name, 'green')
        
        #left for demonstration purposes
        print(i$color)
        print(i$color_name)
        
        shiny::req(input$greeting)
        shiny::req(input$submit)
        
        
        output$num_slider <- renderUI({

            if(input$greeting == "hi!") {
                
                fluidPage(setSliderColor(i$color_name, sliderId = i$color),
                          sliderInput(inputId = "num_filter2",
                                      label = "Filter by Number",
                                      min = 1,
                                      max = 10,
                                      value = c(1, 10)))}
            
        }) }) 
    
}

# Run the application 
shinyApp(ui = ui, server = server)