R语言 在数据表行中呈现数字输入

Question

我想让一个数据表显示基于另一个表的信息，下面有一行数字输入。我正在尝试让数字输入框出现在表中，以便用户可以键入值，然后在准备就绪时按提交。

在我添加来自 R Shiny selectedInput 的数字输入代码之前，这在渲染数据表单元格内有效。但是我收到一条错误消息：

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在这里是错误的。

由于我们要在data.frame中添加 HTML，我们将包含在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)