How to return value conditionally from module's server function

shiny
1

I would like to return a reactive value from the function conditionally. If input$select > 1 return " reactive({paste0(input$select)}), but if input$select1 > 1 reactive({paste0(input$select1)}). What I tried does not work. I get the error: condition is of length zero. Could you please help me to extract the length of the input from the first selectInput and from the selectInput in the conditional panel? Thanks.

firstServer <- function(input, output, session, a) {
  ns = session$ns

  output$first <- renderUI({
   tagList(
    #  selectInput(ns("select"), h4("Select"), paste0(isolate(a()), letters[1:4]))
    selectInput(ns("select"), h5(strong("PLEASE CHOSE FILES TO COMBINE. To undo selection select the selected file again and press delete")),c(Choose='', list.files("~/Folder1/Folder2/Folder3/Folder4")), multiple=TRUE, selectize=TRUE),
   
    conditionalPanel(sprintf("input['%s'].length == '1'", ns("select")),
                     selectInput(ns("select1"),label = h5(strong("Must select more than one data set. Try again.. To undo selection select the selected file again and press delete")),c(Choose='', list.files("~/Folder1/Folder2/Folder3/Folder4")), multiple=TRUE, selectize=TRUE)
          )
    )
})
  
  if(input$select.length > 1){
    returnedValue <- reactive({paste0(input$select)})
  }
  if(input$select1.length > 1)
  returnedValue <- reactive({ paste0(input$select1) })
  return(returnedValue)
}
1 Like
2

There are a few things that need to be changed here. Without seeing a full reproducible example, it's a bit difficult to answer your question, but I'll do my best.

Reactive expressions in Shiny will automatically re-execute when upstream reactives (including values like input$x) change. So instead of this:

if (length(input$select) > 1) {
  res <- reactive({paste0(input$select)})
}

you probably should be doing something like this:

res <- reactive({
  if (length(input$select) > 1) {
    paste0(input$select)
  } else {
     ""
  }
})

Then in any reactive code where you use res(), it will automatically re-execute when input$select changes.

Next, as you may have noticed, I used length(input$select) above, instead of input$select.length. The .length part used in the conditionalPanel's condition is actually JavaScript code. On the R side, you'll want to call length(input$select).

3

@winston.
Thank you for your response to my previous question. I could not reply in the right place because upon pressing the reply button I do not get an empty editor, but the posting.

There is another problem I do not how to solve. Please see code below. I would like for the addRmBtnUI("addRm") button to be hidden until it can be unhidden afterwards. I know how to use shinyjs::show(""), but it does not seem to apply in this case because addRmBtnUI is a function in the module. How could I hide the button the function defines and display it later after " textInput("moreThanOneSelected", label = h5(strong("Enter a value to designate combined set", value = "", width = '300px')))),
verbatimTextOutput("manySelected")," has executed?

I have tried:

 textInput("a", label = "Enter a value to designate combined set. To delete set, please press the REMOVE button", value = "", width = '300px')),
    verbatimTextOutput("nameOfSet"),
    conditionalPanel(
      condition = "input.a == true",
      addRmBtnUI("addRm")
    ),

but it does not work.

ui <- fluidPage(

  textInput("moreThanOneSelected", label = h5(strong("Enter a value to designate combined set", value = "", width = '300px')))),
    verbatimTextOutput("manySelected"),
    hidden(
    addRmBtnUI("addRm")),
     hidden(
    textInput("a", label = "Enter a value to designate combined set. To delete set, please press the REMOVE        button", value = "", width = '300px')),
    verbatimTextOutput("nameOfSet"),
 verbatimTextOutput("text", placeholder = TRUE),


)

library(shiny)

firstUI <- function(id) { uiOutput(NS(id, "first")) }

firstServer <- function(input, output, session, val){#, a) {
  ns = session$ns
 # returnedValue = NULL
  output$first <- renderUI({
    
       # selectInput(ns("select"), h4("Select"), paste0(isolate(a()), letters[1:4]))
       selectInput(ns("select"), h5(strong("PLEASE CHOSE FILES TO COMBINE. IF YOU WANT TO MAKE MORE SETS, PLEASE PRESS THE ADD BUTTON TO DISPLAY FILES. To undo selection select the selected file again and press delete")),c(Choose='', list.files("~/Development/fileTest/GLYCOUNT/DATA")), multiple=TRUE, selectize=TRUE)
       
})
 # res <- reactive({
  #  if (length(input$select) > 1) {
   #   paste0(input$select)
    #} else {
     # ""
  #  }
#  })
  returnedValue <- reactive({paste0(input$select)})
  return(returnedValue)
}


removeFirstUI <- function(id) {
  removeUI(selector = paste0('#', NS(id, "first")))
}

addRmBtnUI <- function(id) {
  ns <- NS(id)
  tags$div(
    actionButton(inputId = ns('insertParamBtn'), label = "Add"),
    actionButton(ns('removeParamBtn'), label = "Remove"),
    hr(),
    tags$div(id = ns('placeholder'))
  )
}

addRmBtnServer <- function(input, output, session, moduleToReplicate, ...) {
  ns = session$ns
  params <- reactiveValues(btn = 0, inputFiles = list())
  observeEvent(input$insertParamBtn, {
    params$btn <- params$btn + 1
    params$inputFiles[[params$btn]] <- callModule(moduleToReplicate$server, id = params$btn, ...)
    if(moduleToReplicate[[val]] > 1)
    insertUI(
      selector = paste0('#', ns('placeholder')),
      ui = moduleToReplicate$ui(ns(params$btn))
    )
  })
  
  observeEvent(input$removeParamBtn, {
    moduleToReplicate$remover(ns(params$btn))
    params$btn <- params$btn - 1
  })
  
  return(params)
}


server <- function(input, output, session){

    comp <- callModule(
    addRmBtnServer, id = "addRm",
      moduleToReplicate = list(
      ui = firstUI,
      server = firstServer,
      remover = removeFirstUI
     )
    )

    
    output$nameOfSet <- renderPrint({
      if(comp$btn>0 && length(comp$inputFiles[[comp$btn]]())  > 1)
        shinyjs::show("a")
      else
        shinyjs::hide("a")
      if(comp$btn>0 && length(comp$inputFiles[[comp$btn]]())  > 1 && input$a != "")
       paste(input$a, " --To delete set, plese press the REMOVE button")
    })
     output$text <- renderText({
       if(comp$btn>0 && length(comp$inputFiles[[comp$btn]]())  > 1)
           paste(
            "file_name = ", comp$inputFiles[[comp$btn]](),
            "comp = ", comp$btn,
             "set_length = ", length(comp$inputFiles[[comp$btn]]()),
             "set_name = ", input$a
           )
        if(comp$btn > 0 && length(comp$inputFiles[[comp$btn]]())  == 1 )
          paste("Must select more than 1 file.  Please press the add button again and select more than 1 file")
       
       
     })
}
4

I made a change and I thought this time it worked, but it did not.

     # 
     # conditionalPanel(
     #   condition = "output.name != ''",
     #   addRmBtnUI("addRm")
     # ),
5

I have tried something different this time: please see below, but it does not work either.

ui <- fluidPage(
selectInput("filescombine",label = h5(strong("PLEASE CHOSE FILES TO COMBINE. To undo selection select the selected file again and press delete.
                                                 If you wish to make more sets, PLEASE PRESS ADD BUTTON AND CHOSE FILES TO COMBINE")),c(Choose='', list.files("~/Development/fileTest/GLYCOUNT/DATA")), multiple=TRUE, selectize=TRUE),
    verbatimTextOutput("filesToCombine"),

conditionalPanel(
      condition = "input.toCombine",
      addRmBtnUI("addRm")),

server <- function(input, output, session{
output$filesToCombine <- renderPrint({
               FTC <- input$combinefiles
              if(FTC == "Y"){
                shinyjs::show("filescombine")
              }
        
           })
             
             output$toCombine <- reactive({
               return(length(input$filescombine))
             })
      outputOptions(output, "toCombine", suspendWhenHidden = FALSE)
}

)

6

It is fixed. The problem was here: I should not use input.toCombine but output.toCombine

      condition = "output.toCombine",
      addRmBtnUI("addRm")),