Shiny: Passing Reactivevalues to Conditionalpanel

Passing reactive values to conditionalPanel condition

If you want to send a Boolean value from server to client to determine the status of a conditionalPanel you can just use regular Shiny output, and tell Shiny to not suspend the value like so:

library(shiny)
server = shinyServer(function(input, output, session) {

  output$color_pr <- renderPrint({
    req(input$select1)
    input$select1
  })

  output$panelStatus <- reactive({
    input$select1=="show"
  })
  outputOptions(output, "panelStatus", suspendWhenHidden = FALSE)

})

ui=shinyUI(fluidPage(

  radioButtons("select1", "Show text?",
               c("Yes" = "show", "No" = "noshow")),

  conditionalPanel(

    condition = 'output.panelStatus'
    ,
    verbatimTextOutput("color_pr"))
))

shinyApp(ui=ui,server=server)

shiny: passing reactiveValues to conditionalPanel

As @jdharrison pointed out, you have the problem, that you have reactive values or any other data on the server side and the conditional panel is a JS condition + some HTML on the client side. Hence, if you want to dynamically update the JS condition according to some value you calculated on the server side, you need to get the data from the server to the client. I think what you could do is use an still undocumented feature of shiny to pass custom data from the server to the client. I wrote a blog post on how to do that: http://ryouready.wordpress.com/2013/11/20/sending-data-from-client-to-server-and-back-using-shiny/

I guess you could use that approach to dynamically update the JS panel condition. You would need to write a JS function that does this after the data has been passed. So this boils down to replacing the data-display-if attribute of the conditionalPanel output with the values you want.

Another idea: If your UI strongly depends on calculations on the server side you may want to consider creating the (sidebar) content dynamically using renderUI.

EDIT: Btw, that's what @jdharrison referred to in his second comment.

R Shiny ConditionalPanel based on Server value / Reactive value

output.HandRail evaluates to true as soon as it's not empty:

Any object of which the value is not undefined or null, including a
Boolean object whose value is false, evaluates to true when passed to
a conditional statement.

[Source]

It needs a conditional check also in JS: output.HandRail == true:

library(shiny)
# library(tidyverse)
library(dplyr)

TestData <- tibble(SPO = c(101, 102),
                   HandRail = c(0, 1))

ui <- fluidPage(titlePanel("Order Acceptance"),
                sidebarLayout(
                  sidebarPanel(
                    numericInput("SPONumber",
                                 "SPO",
                                 value = NULL,
                                 step = 1),
                    
                    conditionalPanel(
                      condition = "output.HandRail == true",
                      checkboxInput(
                        "MobileHandrail",
                        "Mobile Handrail Allowed?",
                        value = FALSE,
                        width = NULL
                      ),
                      style = "display: none;"
                    )
                  ),
                  mainPanel(h3(
                    textOutput("OutputText", container = span)
                  ))
                ))

server <- function(input, output, session) {
  output$HandRail <- reactive({
    HandRailNeeded <- ifelse(
      input$SPONumber > 0 &
        input$SPONumber %in% TestData$SPO &
        TestData$HandRail[TestData$SPO == input$SPONumber] == 1,
      TRUE,
      FALSE
    )
    print(HandRailNeeded)
    return(HandRailNeeded)
  })
  
  outputOptions(output, "HandRail", suspendWhenHidden = FALSE)
  OutputText <- renderText({
    "Just to serve as mainpanel"
  })
  
}

shinyApp(ui = ui, server = server)

Please find a related answer here.

Shiny: reactiveValues() which depends on a reactive()

post the last edit :

  observe({
    test$m=
      if (toggle() & dat_avail()) {
        mean(new_dat()$x)
      }
    else {
      NULL
    }
  })
  

R Shiny - conditionalPanel and conditional values

Ok, with the help of the Shiny Google-Group I figured out how to do it. Here's a working example:

server.R:

library(shiny)
shinyServer(function(input, output) {

  output$ttable1 = renderTable({

    output$num_2_ui <- renderUI({
      num_2 <- ifelse(input$yes_or_no == 0, 0, input$num_2)
      numericInput("num_2", "Value num_2", value=num_2, min=0)
    })

    yes_or_no <- input$yes_or_no
    num_2 <- input$num_2

    table1 <- data.frame(yes_or_no, num_2)
    print(t(table1))

  })
})

ui.R:

library(shiny)

shinyUI(fluidPage(

  titlePanel("test"),

  sidebarLayout(
    sidebarPanel(
      uiOutput("num_2_ui"),
      radioButtons("yes_or_no", "Yes or No?", c("yes"=1, "no"=0), selected="no")

    ),

    mainPanel(
      uiOutput("ttable1")
    )
  )
))

Not sure if it's the only and best way, but for the moment it works for me.

making conditionalPanel work with input parameter in a R shiny Golem package

The beauty of get_golem_options("input") is that it can be uses inside your UI too :)

So I think you can do something simpler, like :

app_ui <- function(request) {
  tagList(
    # Leave this function for adding external resources
    golem_add_external_resources(),
    # List the first level UI elements here
    fluidPage(
      h1("testapp"),
      if (!is.null(golem::get_golem_options("input")){
          your_UI_here(...)
      }
    )
  )
}

Shiny - submitButton and conditionalPanel

To fix the issue, do the following:

1. Switch out the submit button and use an action button instead.
2. Write an output using RenderUI to either show nothing if scatter or show the radiobutton if line plot.
3. Modify #2 above so that its reference to input$plot is isolated and only updated when hitting the action button from #1.

R Shiny: Crosstable and Plot grouping with reactive values

Your code had a couple of issues, so I rewrote some parts of it:

Data

I would suggest to provide an explicit level argument to factor to make sure that the subsequent plots and tables are in order (and not sorted alphabetically which would be the default). Secondly, your subsets selected almost always the entire level set so I removed them:

set.seed(1) ## for reproducibility
levels.netusoft <- c("Sehr wenig", "Etwas", "Stark", "Sehr stark", "Verweigert", 
                     "Weiß nicht", "Keine Antwort")
levels.ppltrst <- c("1", "2", "3", "4", "5", "6", "Verweigert", "Weiß nicht", 
                    "Keine Antwort")
levels.polintr <- c("Überhaupt nicht", "Sehr wenig", "Etwas", "Stark", "Sehr stark", 
                    "Verweigert", "Weiß nicht", "Keine Antwort")
levels.psppsgva <- c("Überhaupt nicht fähig", "Wenig fähig", "Ziemlich fähig", 
                     "Sehr fähig", "Vollkommen fähig", "Verweigert", "Weiß nicht", 
                     "Keine Antwort")
levels.actrolga <- c("Wenig fähig", "Ziemlich fähig", "Sehr fähig", "Vollkommen fähig", 
                     "Verweigert", "Weiß nicht", "Keine Antwort")
levels.gndr <- c("männlich", "weiblich")

dataset <- data.frame("netusoft" = factor(sample(levels.netusoft, 100, 
                                                 replace = TRUE),
                                          levels.netusoft),
                      "ppltrst" = factor(sample(levels.ppltrst, 100, 
                                                replace = TRUE),
                                         levels.ppltrst),
                      "polintr" = factor(sample(levels.polintr, 100, 
                                                replace = TRUE),
                                         levels.polintr),
                      "psppsgva" = factor(sample(levels.psppsgva, 100, 
                                                 replace = TRUE),
                                          levels.psppsgva),
                      "actrolga" = factor(sample(levels.actrolga, 100, 
                                                 replace = TRUE),
                                          levels.actrolga),
                      "gndr" = factor(sample(levels.gndr, 100,
                                             replace = TRUE),
                                      levels.gndr),
                      check.names = FALSE)

Libs

I cleaned the list of needed libraries and added the needed likert library:

library(shiny)
library(shinydashboard)
library(dplyr)
library(likert)
library(DT)
library(ggplot2)
library(likert)

UI

Mostly unchanged, but a small thing to make your life easier and to save you some ifs later. Instead of using conditionalPanel for the question, I refered the conditional control to the server using an uiOutput/renderUI construct. In this way we can have one input$question which simply holds the proper question depending on the selection of the battery.

ui <- fluidPage(
   dashboardPage(
      dashboardHeader(title = "European Social Survey Österreich Dashboard", 
                      titleWidth = 300),
      dashboardSidebar(width = 300,
                       selectInput(inputId = "round", 
                                   label = "Wählen Sie eine ESS Runde aus",  
                                   c("ESS 1" = "1",
                                     "ESS 2" = "2",
                                     "ESS 3" = "3",
                                     "ESS 4" = "4",
                                     "ESS 5" = "5",
                                     "ESS 7" = "7",
                                     "ESS 8" = "8",
                                     "ESS 9" = "9"),
                                   selected = "9", selectize = FALSE), 
                       #end selectinput
                       conditionalPanel(
                          condition = "input.round == '9'",
                          selectInput(inputId = "battery", 
                                      label = "Wählen Sie Themenfeld aus",
                                      c("A: Medien-, Internetnutzung, Soziales Vertrauen" = "A",
                                        "B: Politische Variablen, Immigration" = "B"), 
                                      selectize = FALSE), #end selectinput
                          uiOutput("question_placeholder")
                       ),
                       checkboxInput(
                          inputId = "group",
                          label = "Daten gruppieren",
                          value = FALSE), #end checkbox
                       
                       conditionalPanel(
                          condition = "input.group == true",
                          selectInput(
                             inputId = "UV",
                             label = "Daten gruppieren nach:",
                             c("Geschlecht" = "gndr")
                          ) # end conditionalPanel
                       )
      ), # end dashboardSidebar
      dashboardBody(
         fluidRow(
            box(width = 7, status = "info", solidHeader = TRUE,
                title = "Table:",
                dataTableOutput("tabelle", width = "100%")
            ),
            box(width = 8, status = "info", solidHeader = TRUE,
                title = "Graph:",
                plotOutput("plot", width = "auto", height = 500)
            )
         ) # end fluidRow
         
      ) #end dashboardBody
   )
)

Server

Here I made some simplifications, explanations afterwards.

server <- function(input, output, session) {
   get_data <- reactive({
      req(input$question)
      if (input$group) {
         dataset %>% 
            select(Antwortkategorie = input$question, req(input$UV)) %>% 
            group_by(grp = !!as.symbol(input$UV), Antwortkategorie)
      } else {
         dataset %>% 
            select(Antwortkategorie = input$question) %>% 
            group_by(Antwortkategorie)
      } 
   })
   
   
   output$question_placeholder <- renderUI({
      if (input$battery == "A") {
         choices <- c("A2|Häufigkeit Internetnutzung" = "netusoft",
                      "A4|Vertrauen in Mitmenschen" = "ppltrst")
      } else if (input$battery == "B") {
         choices <- c("B1|Interesse an Politik" = "polintr",
                      "B2|Politische Mitsprachemöglichkeit" = "psppsgva",
                      "B3|Fähigkeit politischen Engagements " = "actrolga")
      }
      selectInput(inputId = "question", 
                  label = "Wählen Sie eine Frage aus",
                  choices,
                  selectize = FALSE)
   })
   
   output$tabelle <- renderDataTable({
      datatable(get_data() %>% 
                   summarize(n = n()) %>% 
                   mutate(Prozent = n / sum(n),
                          "Kum. Prozent" = cumsum(Prozent)),
                rownames = FALSE) %>% 
         formatPercentage(c("Prozent","Kum. Prozent"), 1) 
   })
   
   output$plot <- renderPlot({
      dat <- req(get_data())
      lik <- likert(dat %>% ungroup() %>% select(Antwortkategorie) %>% 
                       as.data.frame(),
                    grouping = if (input$group) dat %>% pull(grp))
      plot(lik)
   })
}

1. The reactive get_data returns the relevant columns from dataset. That is the proper question plus the grouping (if selected). It relies on dplyr::group_by to add the respective grouping layers. I group by Antwortkategorie as well, as I will use summarise(n = n()) instead of count(Antwortkategorie) for finer control.

2. renderUI: based on the the selection of battery we add different choices to the selectInput. With this approach we can always refer to the question as input$question and no need of additional branching later.

3. renderDataTable: uses get_data() to receive the data which is already (thanks to the logic in get_data) accordingly grouped. All we have to do is to calculate counts using n() and percentages. You can see that if you select a grouping variable the table is updated accordingly. (percentages are always relativ to the grouping)

4. renderPlot: likert knows a parameter grouping, which, if not NULL, takes care of the grouping. Thus, all we have to do is to provide it to likert. There is a nuisance with likert that it can't deal with tibbles, hence, the explicit cast to data.frame. The ungroup is necessary becaus eby default select will always select the grouping elements on top of the explicitely selected ones.

---

Related Topics