1

我有多个滑块，它们对我想要更改颜色的其他数据有反应。我试图避免冗长的 CSS 代码，所以我想使用 shinyWidget 的 setSliderColor() 函数是可能的。这个答案在我只有一个滑块时有效，但现在我有两个滑块，它就不起作用了。这是一个可重现的示例：

library(shiny)
library(shinyWidgets)


ui <- fluidPage(
    
    
    sidebarLayout(
        sidebarPanel(
            textInput(inputId = "greeting",
                      label = "Say hi!"),
            actionButton(inputId = "submit", 
                         label = "Submit"),
            
            uiOutput("num_slider"),
            uiOutput("num_slider2"),
            
            
        ),
        mainPanel(DT::DTOutput("table"))
    ))

server <- function(input, output) {
    
        data <- reactive({
            req(input$submit)
            if(input$greeting == "hi!") {
            tibble(name = c("Justin", "Corey", "Sibley"),
                       grade = c(50, 100, 100))}
        })
        
        output$table <- renderDT({
            datatable(data())
        })
        
        
        output$num_slider <- renderUI({
            
            if(length(data()) > 0) {
                
                fluidPage(setSliderColor("#CA001B", sliderId = 1),
                          sliderInput(inputId = "num_filter2",
                                      label = "Filter by Number",
                                      min = 1,
                                      max = 10,
                                      value = c(1, 10)))}
            
        })
        
        output$num_slider2 <- renderUI({
            
            if(length(data()) > 0) {
                #This one won't change color
                fluidPage(setSliderColor("#CA001B", sliderId = 2),
                          sliderInput(inputId = "num_filter2",
                                      label = "Filter by Number",
                                      min = 100,
                                      max = 10000,
                                      value = c(100, 10000)))}
            
        })
    
}

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

我尝试将sliderId 都更改为1，甚至从-100:100 开始，但我只能更改一个滑块。奇怪的是，在我的真实仪表板中，它只更改了最后一个，但不更改较早的滑块，但在这个中，它只更改了第一个。我想知道它是否可以与我编码的顺序有关？任何帮助，将不胜感激！

4

2 回答 2

1

我调整了代码，以便它可以在输出中具有不同的持久颜色。注意不属于 renderUI 的 sliderInput 也如何改变颜色。我还删除了 renderUI 中的 FluidPage 调用，因为它会影响输入的大小并且不是真正需要的（因为setSliderColor返回一个 tags$head() 对象）。

library(shiny)
library(shinyWidgets)


ui <- fluidPage(
    setSliderColor('orange', sliderId = c(1)),
    
    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 <- 'violet'
    
    
    observeEvent(input$submit, {
        
        i$color <- c(i$color, i$color[[length(i$color)]] + 1, i$color[[length(i$color)]] + 2)
        i$color_name <- c(i$color_name, 'green', 'red')
        
        #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!") {
                
                tagList(setSliderColor(i$color_name, sliderId = i$color),
                          sliderInput(inputId = "num_filter1",
                                      label = "Filter by Number",
                                      min = 1,
                                      max = 10,
                                      value = c(1, 10)),
            
               
                      sliderInput(inputId = "num_filter2",
                                  label = "Filter by Number",
                                  min = 1,
                                  max = 10,
                                  value = c(1, 10)))}
            
            
        }) }) 
    
}

# Run the application 
shinyApp(ui = ui, server = server)
于 2021-06-12T00:51:51.937 回答
1

我通过将两个颜色开关合二为一来运行您的代码setSliderColor()。像这样，在不同的条件下进行更改并不是那么舒服。

library(shiny)
library(shinyWidgets)
library(DT) # added DT lib

ui <- fluidPage(
  
  
  sidebarLayout(
    sidebarPanel(
      textInput(inputId = "greeting",
                label = "Say hi!",value = "hi!"), #to not always click
      actionButton(inputId = "submit", 
                   label = "Submit"),
      
      uiOutput("num_slider1"),
      uiOutput("num_slider2"),
      
      
    ),
    mainPanel(DT::DTOutput("table"))
  ))

server <- function(input, output) {
  
  data <- reactive({
    req(input$submit |  0==0) #to not always click
    if(input$greeting == "hi!") {
      tibble(name = c("Justin", "Corey", "Sibley"),
             grade = c(50, 100, 100))}
  })
  
  output$table <- renderDT({
    datatable(data())
  })
  
  
  output$num_slider1 <- renderUI({
    
    if(length(data()) > 0) {
      
      fluidPage(setSliderColor(c("#CA001B","green"), sliderId = c(1,2)), #put vectors here to change the colors
                sliderInput(inputId = "num_slider1",
                            label = "Filter by Number",
                            min = 1,
                            max = 10,
                            value = c(1, 10)))}
    
  })
  
  output$num_slider2 <- renderUI({
    
    if(length(data()) > 0) {
      #This one won't change color
      #fluidPage(setSliderColor("yellow", sliderId = 2),
                sliderInput(inputId = "num_slider2",
                            label = "Filter by Number",
                            min = 100,
                            max = 10000,
                            value = c(100, 10000)))}
    
  })
  
}

# Run the application 
shinyApp(ui = ui, server = server)
于 2021-06-11T23:46:53.037 回答