闪亮的条件面板绕过多个相关的滑块
Posted
技术标签:
【中文标题】闪亮的条件面板绕过多个相关的滑块【英文标题】：Shiny conditionalpanel to bypass multiple dependent sliders 【发布时间】：2018-05-21 20:50:00 【问题描述】：我正在构建一个相对复杂的应用程序，我希望用户拖动耦合滑块来设置某些计算的权重。这些总和应始终为 100%。我查看了this 和that，但我在反应性和隔离方面确实存在问题，并且updateslider 选项似乎适用于两个滑块。
因此，我转而提出了问题。我将向用户发送消息，如果他们不这样做，则权重需要总和为 100%，如果他们这样做，则显示示例 plotoutput。简单吧？嗯，不，因为条件不符合。查看this 和this 和this 后，我无法让它工作。
我在下面提供了一个可重现的示例来演示这个问题 - 我怀疑这是因为我对反应性和闪亮的观察者感到尴尬。
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("testing 1 2 3"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
),
# Show a plot of the generated distribution
mainPanel(
fluidRow(
column(width = 2,
offset = 0,
align = "center",
sliderInput(inputId = "sld_1",
label = "weight",
min = 0,
max = 1,
value = 0.25,
step = 0.05,
animate = TRUE)
,
sliderInput(inputId = "sld_2",
label = "weight",
min = 0,
max = 1,
value = 0.25,
step = 0.05,
animate = TRUE)
,
sliderInput(inputId = "sld_3",
label = "weight",
min = 0,
max = 1,
value = 0.25,
step = 0.05,
animate = TRUE)
,
sliderInput(inputId = "sld_4",
label = "weight",
min = 0,
max = 1,
value = 0.25,
step = 0.05,
animate = TRUE)
) #slider columns
,
column(width = 9,
offset = 0,
align = "center",
conditionalPanel(
condition = "output.myCondition == FALSE",
textOutput(outputId = "distPrint")
) #conditional1
,
conditionalPanel(
condition = "output.myCondition == TRUE",
plotOutput(outputId = "distPlot")
) #conditional2
) #column
)#fluidrow
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output,session)
dister <- reactive(
if( !is.null(input$sld_1) &&
!is.null(input$sld_2) &&
!is.null(input$sld_3) &&
!is.null(input$sld_4) &&
sum(input$sld_1,input$sld_2,input$sld_3,input$sld_4)==1
)
rnorm(input$sld_1*1000)
else c(0,1,2,3,4,5)
)
output.myCondition <- reactive(
if( !is.null(input$sld_1) &&
!is.null(input$sld_2) &&
!is.null(input$sld_3) &&
!is.null(input$sld_4) &&
sum(input$sld_1,input$sld_2,input$sld_3,input$sld_4)==1
)
TRUE
else FALSE
)
output$distPlot <- renderPlot(
x<-dister()
hist(x)
)
output$distPrint <- renderText(
print("The weights must sum to 100%")
)
# Run the application
shinyApp(ui = ui, server = server)
【问题讨论】：
【参考方案1】：这是一个稍微不同的方法，使用shinyjs 包：
所以：
library(shiny)
library(shinyjs)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("testing 1 2 3"),
shinyjs::useShinyjs(),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
),
# Show a plot of the generated distribution
mainPanel(
fluidRow(
column(width = 2,
offset = 0,
align = "center",
sliderInput(inputId = "sld_1",
label = "weight",
min = 0,
max = 1,
value = 0.25,
step = 0.05,
animate = TRUE)
,
sliderInput(inputId = "sld_2",
label = "weight",
min = 0,
max = 1,
value = 0.25,
step = 0.05,
animate = TRUE)
,
sliderInput(inputId = "sld_3",
label = "weight",
min = 0,
max = 1,
value = 0.25,
step = 0.05,
animate = TRUE)
,
sliderInput(inputId = "sld_4",
label = "weight",
min = 0,
max = 1,
value = 0.25,
step = 0.05,
animate = TRUE)
) #slider columns
,
column(width = 9,
offset = 0,
align = "center",
div(id="plotdiv",
plotOutput(outputId = "distPlot")
),
shinyjs::hidden(
div(id="errordiv",
p("The weights must sum to one!")
)
)
) #column
)#fluidrow
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output,session)
dister <- reactiveVal()
observeEvent(
input$sld_1
input$sld_2
input$sld_3
input$sld_4,
if( !is.null(input$sld_1) &&
!is.null(input$sld_2) &&
!is.null(input$sld_3) &&
!is.null(input$sld_4) &&
sum(input$sld_1,input$sld_2,input$sld_3,input$sld_4)==1
)
dister(rnorm(input$sld_1*1000))
shinyjs::show("plotdiv")
shinyjs::hide("errordiv")
else
shinyjs::hide("plotdiv")
shinyjs::show("errordiv")
)
output$distPlot <- renderPlot(
x<-dister()
hist(x)
)
# Run the application
shinyApp(ui = ui, server = server)
我希望这会有所帮助！
【讨论】：
【参考方案2】：你快到了。您需要做的是在renderText 中使用您的反应式表达式output.myCondition，如下所示：
output$distPrint <- renderText(
if(output.myCondition())
print("")
else
print("The weights must sum to 100%")
)
[编辑]：
我似乎误解了您的问题。我知道这个问题已经得到解答，我想我会为可能在这里偶然发现的任何人提供替代解决方案。在这里，我根据output.myCondition() 的输出在renderText 和renderPlot 中添加了if else。这是更新的服务器代码。
server <- function(input, output,session)
dister <- reactive(
if( !is.null(input$sld_1) &&
!is.null(input$sld_2) &&
!is.null(input$sld_3) &&
!is.null(input$sld_4) &&
sum(input$sld_1,input$sld_2,input$sld_3,input$sld_4)==1
)
rnorm(input$sld_1*1000)
else c(0,1,2,3,4,5)
)
output.myCondition <- reactive(
if( !is.null(input$sld_1) &&
!is.null(input$sld_2) &&
!is.null(input$sld_3) &&
!is.null(input$sld_4) &&
sum(input$sld_1,input$sld_2,input$sld_3,input$sld_4)==1
)
TRUE
else FALSE
)
output$distPlot <- renderPlot(
if(output.myCondition())
x<-dister()
hist(x)
else
NULL
)
output$distPrint <- renderText(
if(output.myCondition())
print("")
else
print("The weights must sum to 100%")
)
【讨论】：
谢谢你。然而，这并不是我所追求的。我需要显示文本或情节，这就是条件想要捕捉的内容。如果我用您提供的代码替换此代码，我仍然会得到两者。 @J.Doe。我添加了一个新答案作为上述已接受答案的替代解决方案。以上是关于闪亮的条件面板绕过多个相关的滑块的主要内容，如果未能解决你的问题，请参考以下文章