为多个 Shiny 滑块动态着色？

Question

我有一个带有多个滑块的 Shiny 应用程序。我能够在第一个滑块上改变颜色，用颜色逻辑的 if else 向量化反应语句。但是，如果我尝试创建多个仅更改输入引用的反应式语句，我仍然只会看到应用于第一个语句的颜色。我做错了什么？

    library(shiny)

    ui <- fluidPage(
  
      sliderInput("slider1", "Slider 1",min = 0, max = 10, value =4, 
              step = 1),
      sliderInput("slider2", "Slider 2",min = 0, max = 10, value =4, 
              step = 1),
  
      uiOutput("abc"),
      uiOutput("abc1")
  
    )
    server <- function(input, output, session){
  
    color <- reactive({
    if(input$slider1[1] <= 4){
      tags$style(HTML(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-
               edge, .js-irs-0 .irs-bar {background: red}"))
    }else if(input$slider1[1]<=6){
      tags$style(HTML(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-
               edge, .js-irs-0 .irs-bar {background: yellow}"))
  
    }else{
      tags$style(HTML(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-
                  edge, .js-irs-0 .irs-bar {background: 
    lightgreen}"))
    }
    })
  
    color2 <- reactive({
    if(input$slider1[1] <= 4){
      tags$style(HTML(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-
               edge, .js-irs-0 .irs-bar {background: red}"))
    }else if(input$slider1[1]<=6){
      tags$style(HTML(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-
               edge, .js-irs-0 .irs-bar {background: yellow}"))
      
    }else{
      tags$style(HTML(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-
                  edge, .js-irs-0 .irs-bar {background: 
       lightgreen}"))
        }
       })
  
     output$abc <- renderUI({ 
      color()
     })
  
     output$abc1 <- renderUI({ 
      color2()
     })
  
     }
    shinyApp(ui = ui, server=server)

Answer 1

只需要在 color2 函数中将 HTML 更新为 .js-irs-1

library(shiny)
ui <- fluidPage(
    
    sliderInput("slider1", "Slider 1",min = 0, max = 10, value =4, step = 1),
    sliderInput("slider2", "Slider 2",min = 0, max = 10, value =4, step = 1),
    
    uiOutput("abc"),
    uiOutput("abc1")
   
    
)
server <- function(input, output, session){
    
    color <- reactive({
        if(input$slider1[1] <= 4){
            tags$style(HTML(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-
           edge, .js-irs-0 .irs-bar {background: red}"))
        }else if(input$slider1[1]<=6){
            tags$style(HTML(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-
           edge, .js-irs-0 .irs-bar {background: yellow}"))
            
        }else{
            tags$style(HTML(".js-irs-0 .irs-single, .js-irs-0 .irs-bar-
              edge, .js-irs-0 .irs-bar {background: 
lightgreen}"))
        }
    })
    
    color2 <- reactive({
        if(input$slider2[1] <= 4){
            tags$style(HTML(".js-irs-1 .irs-single, .js-irs-1 .irs-bar-
           edge, .js-irs-1 .irs-bar {background: red}"))
        }else if(input$slider2[1]<=6){
            tags$style(HTML(".js-irs-1 .irs-single, .js-irs-1 .irs-bar-
           edge, .js-irs-1 .irs-bar {background: yellow}"))
            
        }else{
            tags$style(HTML(".js-irs-1 .irs-single, .js-irs-1 .irs-bar-
              edge, .js-irs-1 .irs-bar {background: 
   lightgreen}"))
        }
    })
    
    output$abc <- renderUI({ 
        color()
    })
    
    output$abc1 <- renderUI({ 
        color2()
    })
    
}
shinyApp(ui = ui, server=server)

为多个 Shiny 滑块动态着色？

Dynamically color multiple Shiny sliders?

r

shiny

shinydashboard