r语言 - 将事件响应与渲染函数一起使用

Question

我已经在这个问题上停留了两天了，我希望得到比我聪明得多的人的帮助。我正在使用一个名为"shinyTable"(https://github.com/trestletech/shinyTable)的软件包，我很难操作它。基本上，如果我单击"提交"按钮，如何根据input$rows更改此表的大小？这是一个没有"提交"按钮的工作代码：

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)

现在，我希望当我的input$rows或input$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)
}
}) 
})

但这行不通。我的想法是，如果单击提交按钮，它将重新创建表格。我希望input$rows更改表格的大小，但是我更改大小和单击提交按钮都没有做任何事情。事实上，添加 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。所有这些尝试都有一个共同的事实，即我试图让事情变得被动。

如果我单击"提交"按钮，如何根据输入$rows更改此表的大小？请帮忙！

Answer 1

这应该让你开始。根据我的评论，您应该使用rhandsontable.这个包使用相同的底层JS库，handsontable.JS，但它得到了很好的支持，并且它在Cran上(免责声明：我是这个包的次要贡献者)。

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

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

这是我所知道的唯一一个在shiny工作的图书馆的例子，其中有一个链接到input$something的output$something。

在这种情况下，代码中的input$tbl引用表，但要转换为数据框，需要通过便利函数hot_to_r(handsontabletoR)进行转换。

我相信您已经熟悉这一点：您使用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)

如果这对您有用，请告诉我，否则我会尽力根据您的需要进行更改。