R闪亮：如何创建一个以numericInput为元素的矩阵

Question

我想创建一个可以插入数值的矩阵。另外，我希望可见的行数取决于 actionButton。只要我的矩阵中有 NA，下面的代码就可以正常工作，但如果我用一些 numericInput 替换 NA，则不能。

这里是 ui.R:

shinyUI(
pageWithSidebar(
headerPanel("test"),
sidebarPanel(
actionButtonGreen("test","add a row")),
mainPanel(
uiOutput("value"))
)
) 

这里是服务器。R：

shinyServer(function(input,output){

observe({
if (input$test == 0) 
return()
isolate({ 
output$value <-renderTable( 
mdat <- matrix(NA, nrow = input$test, ncol = 2, byrow = TRUE) 
)
##If I change the NAs to a vector of numericInput, I obtain the following error
##Error: number of items to replace is not a multiple of replacement length 
##That's when I replace the NA in the above matrix with
##c(numericInput(inputId="1",label="",value="2"),
##  numericInput(inputId="2",label="",value="2"),
##  numericInput(inputId="3",label="",value="2"), 
##  numericInput(inputId="4",label="",value="2"))                    
})})

} )

任何建议将不胜感激。

干杯

Answer 1

这是您尝试插入矩阵的内容（numericInput(inputId="1",label="",value="2") 的值）：

[1] "<label for=\"1\"></label>\n<input id=\"1\" type=\"number\" value=\"2\"/>"
attr(,"html")
[1] TRUE

这是他的结构，它是一个包含 3 个元素的 2 个列表的列表：

List of 2
 $ :List of 3
  ..$ name    : chr "label"
  ..$ attribs :List of 1
  .. ..$ for: chr "1"
  ..$ children:List of 1
  .. ..$ : chr ""
  ..- attr(*, "class")= chr "shiny.tag"
 $ :List of 3
  ..$ name    : chr "input"
  ..$ attribs :List of 3
  .. ..$ id   : chr "1"
  .. ..$ type : chr "number"
  .. ..$ value: chr "2"
  ..$ children: list()
  ..- attr(*, "class")= chr "shiny.tag"
 - attr(*, "class")= chr [1:2] "shiny.tag.list" "list"

您的问题是函数numericInput 返回的东西不能适合您的矩阵。

那么我建议你直接在数据框中使用 html 标签，并使用 sanitize.text.function 函数来评估 HTML 标签（而不是字符串）。

shiny::runApp(list(
  ui = pageWithSidebar(
      headerPanel("test"),
      sidebarPanel(
        actionButton("test","add a row")),
      mainPanel(
        tableOutput("value"))
  ),   
  server = function(input,output){
    observe({
      if (input$test == 0) 
        return()
      isolate({
        output$value <-renderTable({
          num.inputs.col1 <- paste0("<input id='c1n", 1:input$test, "' class='shiny-bound-input' type='number' value='2'>")
          num.inputs.col2 <- paste0("<input id='c2n", 1:input$test, "' class='shiny-bound-input' type='number' value='2'>")
          data.frame(num.inputs.col1, num.inputs.col2)
        }, sanitize.text.function = function(x) x)
      })
    })
  }
))

Answer 2

我编写这些函数来做同样的事情。希望这会有所帮助。

 columm    <- function(x,checkval) { if (is.na(checkval)) {
                                                      return(paste('<td>',x,'</td>', sep=""))
                                                      } else {
                                                      return(paste('<td style="background-color:lightblue;">',x,'</td>', sep=""))
                                                      }
                            }
num_input <- function(id,checkval,default){  if (!is.na(checkval)) {
                                                      return(default) 
                                                      } else { 
                                                      return(paste("<input id='",id,"' type='number' value=",default, 
                                                             " class='myInputstyle'>",sep="")) 
                                                      }
  }