Shiny conditionalpanel to bypass multiple dependent sliders

Question

I have a relatively complex app that I am building and I want users to drag coupled sliders to set the weights for some calculations. These should always sum to 100%. I looked at this and that but I have real problems with reactivity and isolation and the updateslider option seems to work for up two sliders.

So instead, I transposed the problem. I will message the user that the weights need to sum to 100% if they don't and show the example plotoutput if they do. Simples right? Well, no, as the conditions are not conforming. After looking at this and this and this, I cannot get it to work.

I provide a reproducible example below to demonstrate this problem - I suspect it's because of my awkwardness with reactivity and observers in 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)

SBista · Answer 1 · 2017-12-08T10:16:55.077

You were nearly ther. What you need to do is use your reactive expression output.myCondition in renderText as follows:

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

  })

[EDIT]:

I seem to have misunderstood your query. I know that this question has already been answered I thought I will provide an alternate solution for anyone whom it might stumble upon here. Here I have added if else in both renderText and renderPlot based on the output of output.myCondition().Here is the updated server code.

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%")
        }

      })
    }

Thank you for this. However, that's not exactly what I am after. I need the text or the plot to show and that was what the condition was looking to capture. If I replace this code with the one you provide, I still get both. — J. Doe., Dec 08 '17 at 09:17
@J.Doe. I have added a new answer as an alternate solution to the already accepted answer above. — SBista, Dec 08 '17 at 10:18

score 1 · Accepted Answer · answered Dec 08 '17 at 08:11

Here is a slightly different approach, using the shinyjs package:

We create two div's, one for the plot (plotdiv) and one for the error (errordiv)
We create a reactiveVal to hold the ditribution
An observeEvent updates the reactiveVal only if our sliders change and they sum to 1. In that case, we hide the errordiv, and show the plotdiv. Otherwise, we show the error and hide the plot.

So:

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)

I hope this helps!

Shiny conditionalpanel to bypass multiple dependent sliders

2 Answers2