Question

我正在构建一个相对复杂的应用程序，我希望用户拖动耦合滑块来设置某些计算的权重。这些应该总是达到100％。我查看了this和that，但我遇到了反应性和隔离方面的真正问题，而updatelider选项似乎适用于两个滑块。

相反，我改变了这个问题。我会告诉用户，如果他们没有，权重需要总和为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)

Answer 1

你差不多了。您需要做的是在output.myCondition中使用您的反应式renderText，如下所示：

 output$distPrint <- renderText({
    if(output.myCondition()){
      print("")
    }else
    {
      print("The weights must sum to 100%")
    }

  })

<强> [编辑]：

我似乎误解了你的查询。我知道这个问题已经得到了解答我认为我会为任何可能在这里偶然发现的人提供替代解决方案。在这里，我根据renderText的输出在renderPlot和output.myCondition()中添加了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来保存ditribution
只有当我们的滑块改变并且它们总和为1时，observeEvent才会更新reactiveVal。在这种情况下，我们隐藏errordiv，并显示plotdiv。否则，我们会显示错误并隐藏情节。

所以：

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)

我希望这有帮助！

闪亮的conditionalpanel绕过多个依赖滑块

2 个答案: