Using eventReactive with a rendering function - r

Question

I've been stuck on this problem for two days now, and I would love some help from people much smarter than me. I am using a package called "shinyTable"(https://github.com/trestletech/shinyTable), and I am having a hard time manipulating it. Basically, how can I make this table change its size based on input$rows IF I click on the "submit" button?Here is a working code w/o the "submit" button:
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)
Now, I want the table's size to change dynamically when my input$rows or input$cols changes. I cannot for the life of me figure out how to make this work. I tried the following:
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)
}
})
})
But this doesn't work. My thought process was that if the submit button is clicked, it would recreate the table. I want input$rows to change the size of the table, but neither my changing the size nor my clicking on a submit button does anything. In fact, adding eventReactive changes the table to where it has no values, and no values can be inputted. I'm honestly lost. I tried other variations of this such as this:
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))
})
In doing this, I thought I can make the table reactive and then pass it to renderHTable. All these attempts share the fact that I'm trying to make things reactive.
How can I make this table change its size based on input$rows IF I click on the "submit" button? Please help!

Answer 1

This should get you started. As per my comment, you should use rhandsontable. This package uses the same underlying JS library, handsontable.JS, but it is well supported and it is on Cran (disclaimer: I'm a minor contributor to this package).
The working example below is based on rhandsontable. For simplicity I've only implemented the change of the number of rows.
Please take into account that I haven't implemented any type of caching mechanism, either to a global variable, or to a reactive variable, as it wasn't necessary, but it can easily be added.
This is the only example that I know of a library working in shiny where there is an output$something linked to an input$something.
In this case the input$tbl in the code refer to the table, but to be converted to a data frame it needs to be transformed by the convenience function hot_to_r (handsontable to R).
I am sure you are already familiar with this: you use hot_to_r(input$tbl) to check if the user has changed anything in the displayed table (assuming it is not read-only). shinyTable has a much more complicated mechanism, but it is prone to races.
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)
Please let me know if this works for you, else I'll do my best to change it as per your needs.