Reputation: 75
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!
Upvotes: 0
Views: 798
Reputation: 2611
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.
Upvotes: 0