rshiny

How to use variable from server to create a new input widget?


I successfully got a variable from Shiny server back to the client with the function session$sendCustomMessage in server.R

Now I want to use this leftChoices variable in the ui.R client to create a widget chooserInput to create a [custom input control][1] but this is not working [1]: http://shiny.rstudio.com/gallery/custom-input-control.html

I've tried to use Shiny.chooserInput but in vain. the script doesn't recognize chooserInput and I don't know how to make it work.

Here is ui.R

source("chooser.R")
library(shiny)
shinyUI(fluidPage(sidebarLayout(sidebarPanel(
                            fileInput("file1", "Choose file to upload",
                                      accept = c('text/csv','.csv')
                                     )
                              ),
                  mainPanel(
                            tabPanel("Data",shiny::dataTableOutput("contents")),
                            tags$script(src = "initcsv.js"),
                            chooserInput("mychoice", "Available", "Selected ",
                    colnames(message.leftChoices) , c(), size = 10, multiple = TRUE
                                                 )
                            )
                 )
  )
)

Here is ny server.R

library(shiny)
source("chooser.R")
shinyServer(function(input, output, session) {
  data <- reactive ({
    inFile <- input$file1
    if (is.null(inFile))
      return(NULL)
    read.csv(inFile$datapath)
    
  })
  observe({
    session$sendCustomMessage(type = "MyDatasetUpdated", 
                              message = list(
                                leftChoices=colnames(data())
                                            )
                              )
  })
  output$contents <- renderDataTable(
    data(), options = list(iDisplayLength = 5)
  )
})

Here is INITCSV.JS

Shiny.addCustomMessageHandler("MyDatasetUpdated",
                              function(message) {
                                if  (message.leftChoices != null)
                                //chooserInput("mychoice", "Available", "Selected ",
                                //c() , c(), size = 10, multiple = TRUE
                                //       ),
                                  alert(JSON.stringify(message.leftChoices));
                                })

Solution

  • Alright, the primary reason your code is not returning a message is because of your assignment to leftChoices within your server.R file. Assuming you have the chooser.R file in your working directory the following provides the widget in the sidebar and provides a popup with the current 'left choices'. Please note that given that there are no choices when no dataset has been loaded, I have placed the chooseInput call within a renderUI. This way, you avoid any potential error from not having a dataset loaded. I have made comments within the code to clarify.

    ui.R

    require(shiny)
    source("chooser.R")
    shinyUI(fluidPage(
      sidebarLayout(sidebarPanel(
        fileInput("file1", "choose file to upload",
                  accept = c('text/csv', '.csv')
        )
    
        # here is where the widget currently sits
        ,uiOutput("choices")
      ),
    
      mainPanel(
        tabPanel("Data", dataTableOutput("contents")),
        tags$script(src = "initcsv.js")
      )
      )
    )
    )
    

    server.R

    require(shiny)
    shinyServer(function(input, output, session) {  
      data <- reactive ({
        inFile <- input$file1
        if (is.null(inFile))
          return(NULL)
        read.csv(inFile$datapath)
    
      })
    
      # The renderUI call of chooserInput thereby making it dependent 
      # on a dataset existing
      output$choices <- renderUI({
        if (is.null(data())){
          return(NULL)
        }else{
          chooserInput("mychooser", "Available", "Selected",
                       colnames(data()), c(), size = 10, multiple = TRUE
          )
        }
      })
    
      # note the leftChoices assignment.  You must refer to 
      # mychooser$left for the left choices.  This identifier is
      # defined in the chooser.R file
      observe({
        session$sendCustomMessage(type = "MyDatasetUpdated", 
                                  message = list(
                                    leftChoices=input$mychooser$left
                                  )
        )
      })
    
      output$contents <- renderDataTable(
        data(), options = list(iDisplayLength = 5)
      )
    }
    )
    

    INITCSV.js - I only slightly modified your alert statement to be more specific (as you are only showing the left choices in this case.

    Shiny.addCustomMessageHandler("MyDatasetUpdated",
                                  function(message) {
                                    if  (message.leftChoices != null)
                                      //chooserInput("mychoice", "Available", "Selected ",
                                                     //c() , c(), size = 10, multiple = TRUE
                                                     //       ),
                                    alert("Left Choices: " + JSON.stringify(message.leftChoices));
                                  })