R Shiny extract values from numericInput Datatable column

Question

This is a continuation of my previous question where I needed to integrate shiny inputs into a datatable (Render numericInputs in a datatable row). I have a column of numericInputs but I cannot retrieve the values input by a user. I've tried both input$bin_values and shinyValue(input$bin_values, ncol(it_matrix) but it doesn't make a difference. I've also tried to incorporate code to handle some JS callback options (R Shiny selectedInput inside renderDataTable cells) but that still gets me the same problem where the shiny input variable is empty. What am I missing?

My end-goal here is to take selected rows on the interface_table and only perform a calculation on those columns (row and column index being the same), then output that as a new table. This is a simplified version of that code to just find out how to recover the column of numericInput values the user enters before they press Apply.

library(shiny)
library(DT)

data(mtcars)

if (interactive()) {
  ui <- fluidPage(
    DT::dataTableOutput('interface_table'),
    br(),
    actionButton("do", "Apply"),
    br(),
    hr(),
    tabsetPanel(
      tabPanel("contents", DT::dataTableOutput('contents')),
      tabPanel("it_contents", DT::dataTableOutput('it_contents'))
    ),
    br()

  )

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

    output$contents <- DT::renderDataTable(
      {mtcars}, options = list(autoWidth = TRUE, 
                               scrollX = TRUE, dom = 't', ordering = FALSE),
      rownames = TRUE, selection = 'none')


    # helper function for making input number values
    shinyInput <- function(FUN, len, id, ...) {
      inputs <- numeric(len)
      for (i in seq_len(len)) {
        inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, ...))
      }
      inputs
    }

    # helper function for reading numeric inputs
    shinyValue <- function(id, len) {
      unlist(lapply(seq_len(len), function(i) {
        value <- input[[paste0(id, i)]]
        if (is.null(value)) NA else value
      }))
    }

    it_matrix <- matrix(data = NA, nrow = length(names(mtcars)), ncol = 2)
    rownames(it_matrix) <- names(mtcars)
    colnames(it_matrix) <- c("Ordinality","Number of bins")
    it_matrix[,1] <- lengths(lapply(mtcars, unique))

    it_matrix[,2] <- shinyInput(numericInput, ncol(mtcars),
                                "bin_values", value = NULL,
                                width = '100%', min = 0, max = 12)

    output$interface_table <- DT::renderDataTable(it_matrix,
                                                  rownames = TRUE,
                                                  escape = FALSE,
                                                  options = list(autoWidth = TRUE, scrollX = TRUE,
                                                                 #scrollY = '400px',
                                                                 dom = 't',
                                                                 ordering = FALSE)
    )

    it_data <- reactive({
      if (input$do > 0) {
        rs <- input$interface_table_rows_selected
        bv <- shinyValue(input$bin_values, nrow(it_matrix))
        dat <- matrix(data = NA, nrow = nrow(it_matrix), ncol = 2)
        colnames(dat) <- c("Ordinality","Number of bins")
        dat[,1] <- it_matrix[,1]
        dat[,2] <- input$bin_values
        return(dat)
      }
    })

    output$it_contents <- DT::renderDataTable(
      it_data(), options = list(autoWidth = TRUE, 
                                  scrollX = TRUE, dom = 't', ordering = FALSE),
      rownames = TRUE, selection = 'none')
  }
}

shinyApp(ui, server)

UPDATE: Made changes suggested by (MLavoie), now I get a table output but it only contains the first column (ordinality). When I cat bv or input$bin_values it is a list of NA values meaning it has not picked up the numericInput values.

a couple of mistakes I think. First in input$submit > 0 I don't see submit describe anywhere else. Second, in it_data, options = list(autoWidth = TRUE, I think it should be it_data(), options = list(autoWidth = TRUE,. — MLavoie
Ah yes those are simply mistakes that I completely missed, thank you. I made those corrections and now a datatable is displayed. Still not getting the numericInput values, alas. — terrangreen
I am not sure what you are trying to do, but it seems there is another mistake in your code. You don't define anywhere input$interface_table_rows_selected so it's hard for this rs <- input$interface_table_rows_selected to work — MLavoie
Ah, that is a built-in function of R Shiny / Datatable rstudio.github.io/DT/shiny.html. It's very useful. — terrangreen

terrangreen terrangreen · Accepted Answer · 2018-01-10T23:15:30

Figured out the problem - well, there were a few. First one must use a data.frame for shiny inputs in a column and it must be reactive. Second, the input variable is accessed by Id, here as 'bin_values' and not input$bin_values.

library(shiny)
library(DT)

data(mtcars)

if (interactive()) {
  ui <- fluidPage(
    DT::dataTableOutput('interface_table'),
    br(),
    actionButton("do", "Apply"),
    br(),
    hr(),
    tabsetPanel(
      tabPanel("contents", DT::dataTableOutput('contents')),
      tabPanel("it_contents", DT::dataTableOutput('it_contents'))
    ),
    br()    
  )

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

    output$contents <- DT::renderDataTable(
      {mtcars}, options = list(autoWidth = TRUE, 
                               scrollX = TRUE, dom = 't', ordering = FALSE),
      rownames = TRUE, selection = 'none')


    # create a character vector of shiny inputs
    shinyInput <- function(FUN, len, id, ...) {
      inputs <- numeric(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
      }))
    }

    init_ordinality <- lengths(lapply(mtcars, unique))

    it_df <- reactive({
      data.frame(
        Ordinality = init_ordinality,
        Bins = shinyInput(numericInput, ncol(mtcars),
                          'bin_values', value = NULL,
                          width = '100%', min = 0, max = 12),
        stringsAsFactors = FALSE
      )
    })

    output$interface_table <- DT::renderDataTable(
      it_df(), rownames = FALSE, escape = FALSE, options = list(
        autoWidth = TRUE, scrollX = TRUE, #scrollY = '400px',
        dom = 't', ordering = FALSE,
        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } '))
    )

    it_data <- reactive({
      if (input$do > 0) {
        dat <- data.frame(
          Ordinality = init_ordinality,
          Bins = shinyValue('bin_values', ncol(mtcars))
        )
        return(dat)
      }
      else { return() }
    })

    output$it_contents <- DT::renderDataTable(
      it_data(),
      options = list(autoWidth = TRUE, scrollX = TRUE, dom = 't', ordering = FALSE),
      rownames = TRUE, selection = 'none')
  }
}

shinyApp(ui, server)

R Shiny extract values from numericInput Datatable column

1 Answers