闪亮的条件面板绕过多个依赖滑块

Question

我正在构建一个相对复杂的应用程序，我希望用户拖动耦合的滑块来设置某些计算的权重。这些总和应始终为 100%。我查看了 this and that，但我在反应性和隔离方面确实存在问题，updateslider 选项似乎适用于两个滑块。

因此，我转置了问题。如果用户不这样做，我会告诉用户权重总和需要达到 100%，如果这样做，我会显示示例 plotoutput。简单吧？嗯，不，因为条件不符合。查看 this and this and this 后，我无法让它工作。

我在下面提供了一个可重现的例子来证明这个问题 - 我怀疑这是因为我对 shiny 中的反应性和观察者的尴尬。

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)

Answer 1

你快到了。您需要做的是在 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%")
        }

      })
    }

Answer 2

这里有一个稍微不同的方法，使用 shinyjs 包：

我们创建两个 div，一个用于绘图 (plotdiv)，一个用于错误 (errordiv)
我们创建一个 reactiveVal 来保存分配
仅当我们的滑块发生变化且它们总和为 1 时，observeEvent 才会更新 reactiveVal。在这种情况下，我们隐藏错误div，并显示绘图div。否则，我们显示错误并隐藏绘图。

所以：

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)

希望对您有所帮助！

闪亮的条件面板绕过多个依赖滑块

Shiny conditionalpanel to bypass multiple dependent sliders

syntax

logic

conditional

r

shiny