Render numericInputs in a datatable row

Question

I'd like to have a datatable display information based on another table with a single row of numericInputs below it. I'm trying to get the numericInput boxes appear in the table so that a user can type in values, then press submit when they are ready.

This worked before I added the numericInput code from R Shiny selectedInput inside renderDataTable cells. However I am getting an error message:

Warning: Error in force: argument "value" is missing, with no default
Stack trace (innermost first):
    49: force
    48: restoreInput
    47: FUN
    46: shinyInput [#34]
    45: server [#53]
     4: <Anonymous>
     3: do.call
     2: print.shiny.appobj
     1: <Promise>
Error in force(default) : argument "value" is missing, with no default

ShinyApp reproducible code:

library(shiny)
library(DT)

data(mtcars)

if (interactive()) {
  ui <- fluidPage(
    sidebarLayout(
      sidebarPanel(
        fluidRow(

          column(6, checkboxGroupInput("dsnamesGrp", "Variable name")),
          column(6, uiOutput("dsordsGrp"), inline= FALSE)
        )
      ),
      mainPanel(
        tabsetPanel(
          tabPanel("contents", DT::dataTableOutput('contents')),
          tabPanel("binnedtable", DT::dataTableOutput('binnedtable'))
        ),
        DT::dataTableOutput('interface_table'),
        actionButton("do", "Apply")
      )
    )
  )

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

    # helper function for making input number values
    shinyInput <- function(FUN, len, id, ...) {
      inputs <- numeric(len)
      for (i in seq_len(len)) {
        inputs[i] <- as.numeric(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
      }))
    }

    temp_m <- matrix(data = NA, nrow = 2, ncol = length(names(mtcars)))
    colnames(temp_m) <- names(mtcars)
    rownames(temp_m) <- c("Ordinality","Bins")
    temp_m[1,] <- lengths(lapply(mtcars, unique))
    bin_value <- list() #tags$input(bin_value)
    temp_m[2,] <- shinyInput(numericInput, ncol(mtcars),
                             "bin_values")

    output$interface_table <- DT::renderDataTable({
      temp_m
      colnames = names(mtcars)
      rownames = FALSE
      options = list(
        autoWidth = TRUE, scrollX = TRUE, dom = 't', 
        ordering = FALSE)
    })
  }
}

shinyApp(ui, server)    

Answer 1

There might have been some misunderstandings with the solution you were trying to adapt.

At first, the error you got was kind of trivial, but somehow masked by the wrapper functions. The tag numericInput needs an argument value, which is not optional. You don't provide it in your call to shinyInput. (It is part of the ... you reference.)

Correcting that, you get the error

Error : (list) object cannot be coerced to type 'double'

This is because, inside shinyInput you want to convert to numeric. Here you misinterpreted the post you linked. What shinyInput does is: it creates a number of shiny-specific web elements, which you in turn want to pack into your table. But, since those web elements are more than just HTML (including i.e. dependencies), you want to convert them down to just plain HTML. This is why in the linked post, the author used as.character. This has nothing to do with the kind of input you expect the widgets to deliver. So, as.numeric is wrong here.

Since we are adding HTML to the data.frame, we are about to include in a renderDataTable, we have to specify escape = FALSE, so that our HTML is actually interpreted as HTML and not converted to boring text. (Corrected some syntax in this call as well.)

Now you got at least your input fields showing correctly.

library(shiny)
library(DT)

data(mtcars)

if (interactive()) {
  ui <- fluidPage(
    sidebarLayout(
      sidebarPanel(
        fluidRow(
          column(6, checkboxGroupInput("dsnamesGrp", "Variable name")),
          column(6, uiOutput("dsordsGrp"), inline= FALSE)
        )
      ),
      mainPanel(
        tabsetPanel(
          tabPanel("contents", DT::dataTableOutput('contents')),
          tabPanel("binnedtable", DT::dataTableOutput('binnedtable'))
        ),
        DT::dataTableOutput('interface_table'),
        actionButton("do", "Apply")
      )
    )
  )

  server <- function(input, output, session) {
    output$contents <- DT::renderDataTable(mtcars, 
      rownames = FALSE,
      options = list(
        autoWidth = TRUE,
        scrollX = TRUE,
        dom = 't',
        ordering = FALSE
      )
    )

    # helper function for making input number values
    shinyInput <- function(FUN, len, id, ...) {
      inputs <- numeric(len)
      for (i in seq_len(len)) {
        # as.character to make a string of HTML
        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
      }))
    }

    temp_m <- matrix(data = NA, nrow = 2, ncol = length(names(mtcars)))
    colnames(temp_m) <- names(mtcars)
    rownames(temp_m) <- c("Ordinality","Bins")
    temp_m[1,] <- lengths(lapply(mtcars, unique))
    bin_value <- list() #tags$input(bin_value)

    # Since numericInput needs a value parameter, add this here!
    temp_m[2,] <- shinyInput(numericInput, ncol(mtcars), "bin_values", value = NULL)

    output$interface_table <- DT::renderDataTable(temp_m,
      colnames = names(mtcars),
      rownames = FALSE,
      # Important, so this is not just text, but HTML elements.
      escape = FALSE,
      options = list(
        autoWidth = TRUE, scrollX = TRUE, dom = 't', 
        ordering = FALSE)
    )
  }
}

shinyApp(ui, server)