Building a datatable using input values bound by Shiny.bindAll

[David Zornek]

I have created a datatable which has selectInput widgets in one of the columns. Another column of the datatable should take inputs given in the first column, and use them to look up a number from my data source. The inputs are binding correctly in Shiny, by using preDrawCallback and drawCallback functions, but lookup values are not updating when the inputs change. Strangely, they do update when I do the lookup in a separate data table. A reproducible example is here:

    library(shiny)

    library(DT)

    

    data <- data.frame(c(1:7),c(21:27))

    

    shinyApp(

      server = shinyServer(function(input, output) {

          output$table <- DT::renderDataTable({

            

            Rows <- c(1:7)

            temp <- data.frame(Rows)  

            temp[,"Item"] <- ""

            temp[,"Value"] <- ""

            temp$Rows <- NULL

            

            sapply(1:7, FUN = function(i) {

              temp$Item[i] <<- as.character(selectInput(paste("Item.1.1",i, sep = "."), "",

                                                           choices = setNames(c(1:7),c(1:7)),

                                                           selected = 1,

                                                           multiple = FALSE))

            })

            

             sapply(1:7, FUN = function(i) {

               temp$Value[i] <<- data[eval(parse(text = paste("input$Item.1.1",i, sep = "."))),2]

             })

            

            datatable(temp, escape = FALSE, rownames = FALSE,

                      options = list(sort = FALSE, paging = FALSE, searching = FALSE, dom = 't',

                                     columnDefs = list(list(className = 'dt-center', targets = 0:1)),

                                     preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),

                                     drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')

                      ))

        }, server = FALSE)

      }),

      ui = fluidPage(

        dataTableOutput("table")

      )

    )

That gives the error "Error in temp$Value[i] <<- data[eval(parse(text = paste("input$Item.1.1",  : 

  replacement has length zero".

My best guess is that unbindAll is clearing out all of my input$Item values before the Value column is created, but bindAll isn't taking affect until after trying to create Value.

Regardless of whether my guess is right, I much appreciate any help that can be offered.

P.S. I have tried creating a second datatable, which is built from the Input$Item's, and it seems to update fine---provided I comment out the code that builds my Value column. Things are *much* simplified for my user when I can have them all in the same datatable, so I really don't want to have to do this if it can be avoided. I'll provide this half-working example in another post following shortly.

[David Zornek]

Here is the example where a second data table updates values correctly. I'd like for the Value column in the first example to behave exactly as the other datatable behaves in this example:

library(shiny)

library(DT)

data <- data.frame(c(1:7),c(21:27))

names(data) <- c("Col1","Col2")

shinyApp(

  server = shinyServer(function(input, output) {

    

    test <- reactive({

      data.frame(c(data[input$Item.1.1.1,2],

                   data[input$Item.1.1.2,2],

                   data[input$Item.1.1.3,2],

                   data[input$Item.1.1.4,2],

                   data[input$Item.1.1.5,2],

                   data[input$Item.1.1.6,2],

                   data[input$Item.1.1.7,2])

      )

    })

    

    output$test <- DT::renderDataTable(

      datatable(test())

    )

    

    output$table <- DT::renderDataTable({

      

      Rows <- c(1:7)

      temp <- data.frame(Rows)  

      temp[,"Item"] <- ""

      temp[,"Value"] <- ""

      temp$Rows <- NULL

      

      sapply(1:7, FUN = function(i) {

        temp$Item[i] <<- as.character(selectInput(paste("Item.1.1",i, sep = "."), "",

                                                  choices = setNames(c(1:7),c(1:7)),

                                                  selected = 1,

                                                  multiple = FALSE))

      })

      

#       sapply(1:7, FUN = function(i) {

#         temp$Value[i] <<- data[eval(parse(text = paste("input$Item.1.1",i, sep = "."))),2]

#       })

      

      datatable(temp, escape = FALSE, rownames = FALSE,

                options = list(sort = FALSE, paging = FALSE, searching = FALSE, dom = 't',

                               columnDefs = list(list(className = 'dt-center', targets = 0:1)),

                               preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),

                               drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')

                ))

    }, server = FALSE)

  }),

  ui = fluidPage(

    dataTableOutput("test"),

    dataTableOutput("table")

  )

)

[Yihui Xie]

For the record: cross-posted at http://stackoverflow.com/q/32279266/559676

Regards,
Yihui

> --
> You received this message because you are subscribed to the Google Groups
> "Shiny - Web Framework for R" group.
> To unsubscribe from this group and stop receiving emails from it, send an
> email to shiny-discus...@googlegroups.com.
> To view this discussion on the web visit
> https://groups.google.com/d/msgid/shiny-discuss/b8e091e1-bcf8-4404-a57f-4b4dadaaa2bc%40googlegroups.com.
>
> For more options, visit https://groups.google.com/d/optout.