使用eventReactive与渲染功能

Question

我一直被困在这个问题上两天了，我会喜欢一些比我更聪明的人的帮助。我正在使用名为“shinyTable”的软件包（https://github.com/trestletech/shinyTable），我很难操纵它。 ？基本上，我怎样才能使这个表更改基于输入$行的大小如果我点击“提交”按钮，这是一个工作代码W/O“提交”按钮：

library(shinythemes) 
library(shiny) 
library(shinyTable) 

ui <- fluidPage(theme = shinytheme("slate"),titlePanel(HTML("<h1> <font face=\"Rockwell Extra Bold\" color=\"#b42000\"><b><b>R/Econ</b></b></font> <font face=\"Lucida Calligraphy\" colsor=\"white\" >Model</font></h1>")), 
       sidebarLayout(
        sidebarPanel( 
        numericInput("rows", label = h3("Number of Rows"), value = 20), 
        numericInput("cols", label = h3("Number of Columns"), value = 2) 
       ), 
        mainPanel(
        htable("tbl") 
       ) 
       ) 
) 
server <- function(input, output) 
{ 
    output$tbl <- renderHtable({ 
    if (is.null(input$tbl)){ 
     # Seed the element with some data initially 
     tbl <- data.frame(list(num1=1:input$rows, 
          num2=(1:input$rows)*20, 
          letter=LETTERS[1:(input$rows)])) 
     cachedTbl <<- tbl 
     print(tbl) 
     return(tbl) 
    } else{ 
     cachedTbl <<- input$tbl 
     print(input$tbl) 
     return(input$tbl) 
    } 
    }) 

} 
shinyApp(ui = ui, server = server) 

现在，我当我的输入$行或输入$ cols更改时，希望表的大小可以动态更改。我不能为我的生活找出如何使这项工作。我尝试了以下内容：

myx<-eventReactive (input$submit, { 
    output$tbl <- renderHtable({ 
    if (is.null(input$tbl)){ 
     tbl <- data.frame(list(num1=1:input$rows, 
          num2=(1:input$rows)*20, 
          letter=LETTERS[1:(input$rows)])) 
     cachedTbl <<- tbl 
     print(tbl) 
     return(tbl) 
    } else{ 
     cachedTbl <<- input$tbl 
     print(input$tbl) 
     return(input$tbl) 
    } 
    }) 
    }) 

但这不起作用。我的思考过程是，如果点击提交按钮，它会重新创建表。我想要输入$行来改变表的大小，但是我的大小和提交按钮的点击都没有改变。实际上，添加eventReactive会将表格更改为没有值的位置，并且不会输入任何值。我老实说输了。我想这个其他变化，如本：

myx<-eventReactive (input$submit, { 
    if (is.null(input$tbl)){ 
     tbl <- data.frame(list(num1=1:input$rows, 
          num2=(1:input$rows)*20, 
          letter=LETTERS[1:(input$rows)])) 
     cachedTbl <<- tbl 
     print(tbl) 
     return(tbl) 
    } else{ 
     cachedTbl <<- input$tbl 
     print(input$tbl) 

    } 
    }) 
    #------- 
# myx2<-eventReactive (cachedTbl, { 
# }) 
    output$tbl <- renderHtable({ 
     tbl<<-myx() 
     print(data.frame(tbl))#Tried and failed using myx() 
     return(data.frame(tbl)) 

    }) 

在这样做，我想我可以表功，然后把它传递给renderHTable。所有这些尝试都分享了我试图让事情变得被动的事实。

如何让该表根据输入$行更改其大小如果我点击“提交”按钮？请帮忙！

Answer 1

这应该让你开始。根据我的评论，你应该使用rhandsontable。该软件包使用相同的底层JS库handsontable.JS，但它得到了很好的支持，它在Cran上（免责声明：我是这个软件包的一个小贡献者）。

下面的工作示例基于rhandsontable。为了简单起见，我只实现了行数的变化。

请注意，我没有实现任何类型的缓存机制，无论是全局变量还是无效变量，因为这不是必需的，但它可以很容易地添加。

这是我知道shiny工作库，其中有连接到一个input$something的output$something唯一的例子。

在这种情况下input$tbl在代码参照上表，​​而是被转换到它需要由便利功能hot_to_r（handsontable到R）被变换的数据帧。

我确定您已经熟悉了这一点：您使用hot_to_r(input$tbl)来检查用户是否在显示的表中更改了任何内容（假设它不是只读的）。 shinyTable有一个更复杂的机制，但它很容易比赛。

library(shinythemes) 
library(shiny) 
library(rhandsontable) 

ui <- fluidPage(theme = shinytheme("slate"),titlePanel(HTML("<h1> <font face=\"Rockwell Extra Bold\" color=\"#b42000\"><b><b>R/Econ</b></b></font> <font face=\"Lucida Calligraphy\" colsor=\"white\" >Model</font></h1>")), 
       sidebarLayout(
        sidebarPanel( 
        numericInput("rows", label = h3("Number of Rows"), value = 20), 
        numericInput("cols", label = h3("Number of Columns"), value = 2) 
       ), 
        mainPanel(
        rHandsontableOutput("tbl") 
       ) 
       ) 
) 

server <- function(input, output, session) { 

    data = reactive({ 
    if (is.null(input$tbl)) { 
     DF <- data.frame(num1 = 1:input$rows, bool = TRUE, nm = LETTERS[1:input$rows], 
         dt = seq(from = Sys.Date(), by = "days", length.out = input$rows), 
         stringsAsFactors = F) 

    } else if(nrow(hot_to_r(input$tbl)) == input$rows) { 
     DF <- hot_to_r(input$tbl) 
     } else { 
     DF <- data.frame(num1 = 1:input$rows, bool = TRUE, nm = LETTERS[1:input$rows], 
       dt = seq(from = Sys.Date(), by = "days", length.out = input$rows), 
       stringsAsFactors = F) 
    } 
    DF 
    }) 

    output$tbl <- renderRHandsontable({ 
if (is.null(input$rows) | is.null(input$cols)) return() 
    df = data() 
    if (!is.null(df)) 
     rhandsontable(df, stretchH = "all") 
    }) 

} 

shinyApp(ui = ui, server = server) 

请让我知道这是否适用于您，否则我会尽我所能根据您的需求进行更改。