RStudio Shiny 和 JavaScript 通信问题

Question

I would like to make a Shiny app which makes as much HTML div object as the lenght of selected the database, but there could be a communication problem between Shiny and JavaScript.

I tried to use Shiny.addCustomMessageHandler but It seems to be only sends information within the function. My goal is to modify the msg variable value to ncol(database() )

Here is a minimal example:

server.r

library(shiny)

shinyServer(
function(input, output, session) {
   database <- reactive({
      get(input$database)
    })

   observe({
     session$sendCustomMessage(type = 'testmessage', message = ncol(database()))
   })
})

ui.r

library(shiny)

shinyUI(fluidPage(
  tags$head(tags$script(src="script.js")),

  fluidRow(
  # TITLE
  titlePanel("title"),

  # SIDEBAR
  sidebarPanel(width = 2,
      selectInput("database", "Select sample database:", choices = c("mtcars","iris","Titanic","AirPassengers"))
    )
  ),

  # MAIN-PANEL
  column(width = 8,  
    tabsetPanel(type = "pills",  
       tabPanel("view",        
           tags$div(id="target")
        )
  ))
))

script.js

$(document).on('shiny:connected', function(event) {

          var msg;
            Shiny.addCustomMessageHandler("testmessage",
              function(message) {
                msg = message;                                      
              }
            );

          for(var i =1; i<= msg; i++){
             $('#target').append($('<div/>', { id: 'targ' + i, 'class' : 'col-md-4'}))
          }
}); 

Thanks for any suggestion!

UPDATE1:

When I generates plots like this:

$(document).ready(function() {
    Shiny.addCustomMessageHandler("testmessage",
    function(message) {
      updateTargetDiv(message);
    }
    );
});

function updateTargetDiv(msg){
      node = document.getElementById('target');
      while (node.hasChildNodes()) {
          node.removeChild(node.lastChild);
      }
      for(var i =1; i<= msg; i++){
         $('#target').append($('<div/>', { id: 'targ' + i, 'class' : 'col-md-4'}));
      }

            for(var i =1; i<= msg; i++){
                 $('#targ' + i).append($('<div/>', { id: 'plot' + i, 'class' : 'col-md-3 shiny-plot-output'}))
                 $('#targ' + i).append($('<div/>', { id: 'summary' + i, 'class' : 'col-md-1 shiny-html-output'}))
            }
}

server.r

observe({
      for (i in 1:ncol(database())) {
        local({
            my_i = i
            output[[paste0('plot',i)]]  <- renderPlot({
              db = database()
              ggplot(data = db, 
                     aes_string(colnames(db)[my_i])) +
              geom_histogram()
            }) 

            output[[paste0('summary',i)]]  <- renderTable({
              db = database()
              mat = matrix(NA,6,2)
              mat[,1] = names(summary(db[,my_i]))
              mat[,2] = summary(db[,my_i])
              mat
            }, include.colnames=FALSE)
        })
      }
    })

I cannot se any plots. Why? (It works without JavaScript dynamic div script)

Answer 1

Based on your description, I think the main problem is that you only call your JavaScript function once. .on('shiny:connected' ... is only called once at the start.

Another issue is that you are only ever adding to the target div , so it will keep growing unless you clear its children div elements.

I think the code below will suit your needs. It creates the CustomMessageHandler once and will call the updateTargetDiv any time a new value is passed in. It also clears the children div elements from target before creating the new ones.

$(document).ready(function() {
  Shiny.addCustomMessageHandler("testmessage",
    function(message) {
      updateTargetDiv(message);
    }
  );
});

function updateTargetDiv(msg){
      node = document.getElementById('target');
      while (node.hasChildNodes()) {
          node.removeChild(node.lastChild);
      }
      for(var i =1; i<= msg; i++){
         $('#target').append($('<div/>', { id: 'targ' + i, 'class' : 'col-md-4'}));
      }
}

Visual: