在反应输出中使用 setSliderColor 更改滑块颜色 [英] Change sliderbar color with setSliderColor within reactive output
问题描述
我正在构建一个闪亮的应用程序，它有一个响应式滑块，我希望条形颜色为红色.我正在尝试使用 ShinyWidgets 包中的 setSliderColor() 函数，但它不起作用.我的假设是它没有选择滑块 ID，因为它不是:
<预><代码>图书馆(闪亮)图书馆(闪亮的小部件)ui <-流体页面(setSliderColor(c(green"), sliderId = c(1)),侧边栏布局(侧边栏面板(textInput(inputId = "问候",label = "打个招呼！"),actionButton(inputId = "提交",label = "提交"),uiOutput("num_slider"),),主面板()))服务器 <- 功能(输入，输出){输出$num_slider <- renderUI({闪亮::请求(输入$问候)闪亮::请求(输入$提交)if(input$greeting == "hi!") {滑块输入(inputId =num_filter2"，label = "按数字过滤",分钟 = 1,最大 = 10,值 = c(1, 10))} 别的 {滑块输入(inputId =num_filter2"，label = "按数字过滤",分钟 = 1,最大 = 5,值 = c(1, 5))}})}# 运行应用程序闪亮应用(用户界面 = 用户界面，服务器 = 服务器)但是，奇怪的事情来了.如果我在 UI 中放入一个常规滑块，它会突然检测到两者——但是如果我点击两次提交，颜色就会变回蓝色:
<预><代码>图书馆(闪亮)图书馆(闪亮的小部件)ui <-流体页面(setSliderColor(c("green", "red"), sliderId = c(1, 2)),侧边栏布局(侧边栏面板(textInput(inputId = "问候",label = "打个招呼！"),actionButton(inputId = "提交",label = "提交"),uiOutput("num_slider"),滑块输入(inputId =num_filter1"，label = "现在可以了！",分钟 = 1,最大 = 10,值 = c(1, 10))),主面板()))服务器 <- 功能(输入，输出){输出$num_slider <- renderUI({闪亮::请求(输入$问候)闪亮::请求(输入$提交)if(input$greeting == "hi!") {滑块输入(inputId =num_filter2"，label = "按数字过滤",分钟 = 1,最大 = 10,值 = c(1, 10))} 别的 {滑块输入(inputId =num_filter2"，label = "按数字过滤",分钟 = 1,最大 = 5,值 = c(1, 5))}})}# 运行应用程序闪亮应用(用户界面 = 用户界面，服务器 = 服务器)关于如何解决这个问题的任何解决方法?如果它避免了长时间的 HTML，我也愿意接受其他解决方案，例如 answer.
该函数并非设计为与 renderUI() 一起使用.每次调用时都需要更新参数.
一个快速的解决方法是预先分配用户永远不会达到的非常大的向量(比如 100 万)或者像这样使用 reactiveValues():
注意:当嗨！"时，滑块将变为绿色.作为输入传递.
图书馆(闪亮)图书馆(闪亮的小部件)ui <-流体页面(侧边栏布局(侧边栏面板(textInput(inputId = "问候",label = "打个招呼！"),actionButton(inputId = "提交",label = "提交"),uiOutput("num_slider"),滑块输入(inputId =num_filter1"，label = "现在可以了！",分钟 = 1,最大 = 10,值 = c(1, 10))),主面板()))服务器 <- 功能(输入，输出){i <-reactiveValues()i$color <- 1i$color_name <- '绿色'观察事件(输入$提交，{i$color <- c(i$color, i$color[[length(i$color)]] + 1)i$color_name <- c(i$color_name, 'green')#left 用于演示目的打印(我$颜色)打印(i$color_name)闪亮::请求(输入$问候)闪亮::请求(输入$提交)输出$num_slider <- renderUI({if(input$greeting == "hi!") {流体页面(setSliderColor(i$color_name，sliderId = i$color)，滑块输入(inputId =num_filter2"，label = "按数字过滤",分钟 = 1,最大 = 10,值 = c(1, 10)))}}) })}# 运行应用程序闪亮应用(用户界面 = 用户界面，服务器 = 服务器)I'm building a shiny app that has a reactive slider that I want the bar color to be red. I'm trying to use the setSliderColor() function from the shinyWidgets package, but it's not working. My assumption is that it isn't picking up on the sliderId because it isn't:
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)
But, here's the weird thing. If I put in a regular slider in the UI, it suddenly detects both--but then changes the color back to blue if I click submit twice:
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)
Any fix on how address this? I'm also open to other solutions if it avoids long bouts of HTML, like this answer.
The function is just not designed to work with renderUI(). The arguments need to be updated in each call.
a quick fix would be preallocate very large vectors that the user will never reach (like 1 million) or use reactiveValues() like this:
note: The sliders will turn green when "hi!" is passed as an input.
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)
这篇关于在反应输出中使用 setSliderColor 更改滑块颜色的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
