R Shiny 从 numericInput Datatable 列中提取值

Question

这是我之前的问题的延续，我需要将闪亮的输入集成到数据表中 (Render numericInputs in a datatable row)。我有一列 numericInputs 但我无法检索用户输入的值。我已经尝试了 input$bin_values 和 shinyValue(input$bin_values, ncol(it_matrix) 但它没有任何区别。我还尝试合并代码来处理一些 JS 回调选项 (R Shiny selectedInput inside renderDataTable cells) 但这仍然当闪亮的输入变量为空时，我遇到了同样的问题。我错过了什么？

我的最终目标是在 interface_table 上选取选定的行，并且只对这些列执行计算（行和列索引相同），然后将其作为新表输出。这是该代码的简化版本，仅用于了解如何恢复用户在按下 Apply 之前输入的 numericInput 值列。

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)

更新：（MLavoie）建议进行更改，现在我得到一个表输出，但它只包含第一列（序数）。当我 cat bv 或 input$bin_values 时，它是一个 NA 值列表，这意味着它没有获取 numericInput 值。

Answer 1

找出问题所在 - 嗯，有几个。第一个必须为列中的闪亮输入使用 data.frame，并且它必须是响应式的。其次，输入变量是通过Id访问的，这里是'bin_values'而不是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)