问题描述
我有多个滑块可以响应我想要更改颜色的其他数据。我试图避免长时间的 CSS 代码，所以我想使用 ShinyWidget 的 setSliderColor() 函数是可能的。当我只有一个滑块时，此 answer 有效，但现在我有两个滑块，它不起作用。这是一个可重现的示例：
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),min = 100,max = 10000,value = c(100,10000)))}
})
}
# Run the application
shinyApp(ui = ui,server = server)
我已经尝试将滑块 ID 更改为 1，甚至从 -100:100 开始，但我只能让它更改一个滑块。奇怪的是，在我的真实仪表板中，它只更改了最后一个滑块，而没有更改前面的滑块，但在这个滑块中，它只更改了第一个滑块。我想知道它是否可以与我编码的顺序有关？任何帮助将不胜感激！
解决方法
我通过将两个颜色开关合并为一个 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",min = 100,max = 10000,value = c(100,10000)))}
})
}
# Run the application
shinyApp(ui = ui,server = server)
我调整了代码，使其在输出中可以有不同的持久颜色。请注意不属于 renderUI 一部分的滑块输入如何更改颜色。我还删除了 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",uiOutput("num_slider"),sliderInput(inputId = "num_filter1",label = "Now it works!",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),10)),sliderInput(inputId = "num_filter2",10)))}
}) })
}
# Run the application
shinyApp(ui = ui,server = server)