Add some inputs into a data table using DT

[Elena]

Hi, 

I would like to add some numericInputs into a datatable. In the shiny application, I have the inputs, and the html objects created have the id i wanted to. The problem is that those id s are not in the input list, so I can't have the associated values. 

Does anyone have any solution for this problem ? 

Here's my ui and server : 

ui.R : 

library(shiny)
library(DT)


shinyUI(fluidPage(


  titlePanel("Old Faithful Geyser Data"),


  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30),
      textOutput("textres")
    ),


    mainPanel(
      DT::dataTableOutput("testDT")
    )
  )
))

server.R : 

library(shiny)
library(DT)


shinyServer(function(input, output) {


  output$testDT <- DT::renderDataTable({


    # generate bins based on input$bins from ui.R
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins + 1)


    # draw the histogram with the specified number of bins
    h = hist(x, breaks = bins, col = 'darkgray', border = 'white')


    res = cbind(h$counts, h$density, h$mids)
    colnames(res) <- c("counts", "density", "mids")
    res = data.frame(res)
    res[,"numericinput"] <- ""
   
    sapply(1:nrow(res), FUN = function(i) {
      res$numericinput[i] <<- as.character(numericInput(paste0("num", i), "", value = 5, min = 0, max = 10, step = 0.01))
    })
   
    datatable(res, escape = 4)
  })
 
  output$textres <- renderText({
   
    h = hist(x, breaks = bins, col = 'darkgray', border = 'white')
    res = ""
#     sapply(1:length(h$counts), FUN = function(i) {
#       res <<- paste(res, input[[paste0("num",i)]])
#     })
#   res
   
    paste(names(input))


  })


})

[Max Moro]

I was getting an error with you code, I fixed it with a reactive function. But I was unable to solve it. Sorry. I see there is no input$ with the values.

## DT Server Side

# multi select is not suggested for server-side. when user changes page the seleced records are forgotten

library(shiny)

library(DT)

library(data.table)

x    <- faithful[, 2]

shinyApp(

    ui = fluidPage(

        

        titlePanel("Old Faithful Geyser Data"),

                sidebarLayout(

            sidebarPanel(

                sliderInput("bins",

                            "Number of bins:",

                            min = 1,

                            max = 50,

                            value = 30),

                textOutput("textres")

            ),

            

            mainPanel(

                DT::dataTableOutput("testDT")

            )

        )

    ),

    server = function(input, output, session) {

        

        bins <-reactive(seq(min(x), max(x), length.out = input$bins + 1))

        

        output$testDT <- DT::renderDataTable({

            

            # draw the histogram with the specified number of bins

            h = hist(x, breaks = bins(), col = 'darkgray', border = 'white')

            

            res = cbind(h$counts, h$density, h$mids)

            colnames(res) <- c("counts", "density", "mids")

            res = data.frame(res)

            res[,"numericinput"] <- ""

            

            #creates input fields

            sapply(1:nrow(res), FUN = function(i) {

                res$numericinput[i] <<- as.character(numericInput(paste0("num", i), "", value = 5, min = 0, max = 10, step = 0.01))

            })

            

            datatable(res, escape = 4)

        })

        

        output$textres <- renderText({

            

            h = hist(x, breaks = bins(), col = 'darkgray', border = 'white')

            browser()

            res = ""

            #     sapply(1:length(h$counts), FUN = function(i) {

            #       res <<- paste(res, input[[paste0("num",i)]])

            #     })

            #   res

            

            paste(names(input))

            

            

        })

})

[Elena]

Yes sorry i made a mistake in the server.R. This is better : 

library(shiny)
library(DT)

shinyServer(function(input, output) {

  output$testDT <- DT::renderDataTable({
    # generate bins based on input$bins from ui.R
    x    <- faithful[, 2]
    bins <- seq(min(x), max(x), length.out = input$bins + 1)


    # draw the histogram with the specified number of bins
    h = hist(x, breaks = bins, col = 'darkgray', border = 'white')
    res = cbind(h$counts, h$density, h$mids)
    colnames(res) <- c("counts", "density", "mids")
    res = data.frame(res)
    res[,"numericinput"] <- ""
   
    sapply(1:nrow(res), FUN = function(i) {

      res$numericinput[i] <<- as.character(numericInput(paste0("num", i), "", value = i, min = 0, max = 10, step = 0.01))

    })
   
    datatable(res, escape = 4)
  })
 
  output$textres <- renderText({

   paste(names(input))
  })

})

[Elena]

I've found a way to solve this problem. The solution is to create some "real" shiny inputs which will receive the value of the input which is in the datatable, adding an onchange action (with the javascript function, linked to the input in the datatable) to "send" the input datatable value to the shiny input, and so it's important to initialize the shiny inputs. Then shiny inputs are hidden with a css file. 

[Max Moro]

Very good solution! I'm going to use it on my app.

Thanks

Max

[Yihui Xie]

The solution can be more straightforward using Shiny.bindAll() to bind
all new inputs in the table. Here is a minimal example:

# need the development version of shiny due to
https://github.com/rstudio/shiny/pull/857
if (packageVersion('shiny') < '0.12.0.9003')
devtools::install_github('rstudio/shiny')
library(shiny)
library(DT)
shinyApp(
ui = fluidPage(DT::dataTableOutput('x1'), verbatimTextOutput('x2')),

server = function(input, output) {
# create a character vector of shiny inputs
shinyInput = function(FUN, len, id, ...) {
inputs = character(len)
for (i in seq_len(len)) {
inputs[i] = as.character(FUN(paste0(id, i), label = NULL, ...))
}
inputs
}

# obtain the values of inputs
shinyValue = function(id, len) {
unlist(lapply(seq_len(len), function(i) {
value = input[[paste0(id, i)]]
if (is.null(value)) NA else value
}))
}

# a sample data frame
res = data.frame(
v1 = shinyInput(numericInput, 100, 'v1_', value = 0),
v2 = shinyInput(checkboxInput, 100, 'v2_', value = TRUE),
v3 = rnorm(100),
v4 = sample(LETTERS, 100, TRUE),
stringsAsFactors = FALSE
)

# render the table containing shiny inputs
output$x1 = DT::renderDataTable(
res, server = FALSE, escape = FALSE, options = list(
preDrawCallback = JS('function() {
Shiny.unbindAll(this.api().table().node()); }'),
drawCallback = JS('function() {
Shiny.bindAll(this.api().table().node()); } ')
)
)
# print the values of inputs
output$x2 = renderPrint({
data.frame(v1 = shinyValue('v1_', 100), v2 = shinyValue('v2_', 100))
})
}
)

The key is the two callback functions preDrawCallback and drawCallback
(http://www.datatables.net/reference/option/), which make sure Shiny
knows the inputs inside the table after each redraw. See this article
for the meaning of Shiny.[un]bindAll():
http://shiny.rstudio.com/articles/dynamic-ui.html

Regards,
Yihui

[jro]

Hi, 

This answer addressed a problem I am struggling with.  However, I still have an issue that if I dynamically regenerate the table based on a parameter changing (e.g., number of rows) all of the bindings are lost.  I also tried to unbind/bindall from the js console and was still unsuccessful. I've added the "slider_num_rows" to your code below to illustrate the problem.

(separately, the data is lost too, but I'm hoping to feed the 'value' parameter of numericInput with the current input[[...]] value once I get the binding portion working). 

I'm running with 

> packageVersion('shiny')
[1] ‘0.12.1.9001’
> packageVersion('DT')
[1] ‘0.1.30’

any ideas?

# need the development version of shiny due to https://github.com/rstudio/shiny/pull/857
if (packageVersion('shiny') < '0.12.0.9003')
  devtools::install_github('rstudio/shiny')
library(shiny)
library(DT)
shinyApp(
  ui = fluidPage(

      # add slider to control number of rows shown in table
      sliderInput("slider_num_rows", "Num Rows", min = 0, max = 100, value = 10),

      # use slider to control number of rows shown in table
      res[1:input$slider_num_rows,], server = FALSE, escape = FALSE, options = list(
        preDrawCallback = JS('function() {
                             Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() {
                          Shiny.bindAll(this.api().table().node()); } ')
        )
        )
    # print the values of inputs
    output$x2 = renderPrint({
      data.frame(v1 = shinyValue('v1_', 100), v2 = shinyValue('v2_', 100))
    })
        }
)