r - 动态着色多个闪亮滑块？

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)

标签： rshinyshinydashboard

Answer 1

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

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)