R shiny:如何使用numericInput作为元素创建矩阵

时间:2014-03-01 20:28:09

标签: r shiny

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

这是ui.R:

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

这是server.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"))                    
})})

}   )

非常感谢任何建议。

干杯

2 个答案:

答案 0 :(得分:3)

这是您要在矩阵中插入的内容(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)
      })
    })
  }
))

答案 1 :(得分: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="")) 
                                                      }
  }