在数据表行中呈现 numericInputs

Question

我希望有一个基于另一个表的数据表显示信息，该表下面有一行 numericInputs。我试图让 numericInput 框出现在表格中，以便用户可以输入值，然后在准备好后按提交。

这在我添加来自R Shiny selectedInput inside renderDataTable cells 的 numericInput 代码之前有效。但是我收到一条错误消息：

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 可重现代码：

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

您尝试采用的解决方案可能存在一些误解。

起初，您得到的错误有点微不足道，但不知何故被包装函数掩盖了。标签numericInput 需要一个参数value，这不是可选的。您没有在致电shinyInput 时提供它。 （它是您引用的... 的一部分。）

纠正一下，你会得到错误

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

这是因为，在 shinyInput 内部，您想要转换为数字。在这里，您误解了您链接的帖子。 shinyInput 所做的是：它创建了许多特定于闪亮的 Web 元素，而您又希望将它们打包到您的表格中。但是，由于这些 Web 元素不仅仅是 HTML（包括依赖项），因此您希望将它们转换为纯 HTML。这就是为什么在链接的帖子中，作者使用as.character。这与您期望小部件提供的输入类型无关。所以，as.numeric 在这里是错误的。

由于我们将 HTML 添加到 data.frame，我们即将包含在 renderDataTable 中，我们必须指定 escape = FALSE，以便我们的 HTML 实际上被解释为 HTML 而不会转换为无聊的文本。 （也更正了此调用中的一些语法。）

现在您至少可以正确显示输入字段了。

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)