Dynamic handsontable using radio buttons - r

Question

Hi would like to have a dynamic(changing number of rows) rhandsontable using the input from radio buttons.
So I've been working on a shiny that needs data input into a table. However when adding more complexity an annual option was needed. So with the current table I could ask the user to fill in only the first row but that is just not pretty.
This is a reproducible example of the table as it currently stands
library(shiny)
library(rhandsontable)
ui <- fluidPage(
br(),
rHandsontableOutput('table'),
textOutput('result'),
br(),
actionButton("recalc", "re-enter data")
)
rowNames <- c("Spring", "Summer", "Autum", "Winter", "Sum")
defaultDF <- data.frame(
row.names = rowNames,
Lake = rep(NA_integer_, 5),
Beach = rep(NA_integer_, 5),
Garden = rep(NA_integer_, 5),
stringsAsFactors = FALSE
)
server <- function(input, output, session)
({
values <- reactiveValues(data = defaultDF) ## assign it with NULL
## button press resets now the data frame
observeEvent(input$recalc, {
values$data[] <- NA_integer_
})
observe({
req(input$table)
DF <- hot_to_r(input$table)
DF[setdiff(rowNames, "Sum"),]
DF["Sum",] <- colSums(DF[setdiff(rowNames, "Sum"),], na.rm = TRUE)
values$data <- DF
})
output$table <- renderRHandsontable({
req(values$data)
rhandsontable(values$data, rowHeaderWidth = 100) %>%
hot_row(nrow(values$data), readOnly = TRUE)
})
})
shinyApp(ui = ui, server = server)
What I'm attempting to do (in the code below) is to use the value in the radio buttons to change the number of rows in the table. Unfortunatly it has not worked. Any pointer would be very much appreciated.
library(shiny)
library(rhandsontable)
ui <- fluidPage(
br(),
rHandsontableOutput('table'),
textOutput('result'),
br(),
actionButton("recalc", "re-enter data")
radioButtons("Step", label = h4("Choose Step"),
choices = list("Annual" = 2, "Season" = 5),
inline= TRUE, selected = 1),
)
server <- function(input, output) ({
tabval<- reactive({
SeasonAnunal<- rowNames <- if (input$Step==2){ rowNames <- c("Spring", "Summer", "Autum", "Winter", "Sum")
} else{
rowNames <-c("Annual","Sum")}
defaultDF <- data.frame(
row.names = rowNames,
Lake = rep(NA_integer_, tabval()),
Beach = rep(NA_integer_, tabval()),
Garden = rep(NA_integer_, tabval()),
stringsAsFactors = FALSE)
})
values <- reactiveValues(data = defaultDF) ## assign it with NULL
## button press resets now the data frame
observeEvent(input$recalc, {
values$data[] <- NA_integer_
})
observe({
req(input$table)
DF <- hot_to_r(input$table)
DF[setdiff(rowNames, "Sum"),]
DF["Sum",] <- colSums(DF[setdiff(rowNames, "Sum"),], na.rm = TRUE)
values$data <- DF
})
output$table <- renderRHandsontable({
req(values$data)
rhandsontable(values$data, rowHeaderWidth = 100) %>%
hot_row(nrow(values$data), readOnly = TRUE)
})
})
shinyApp(ui = ui, server = server)

Answer 1

I'm not sure how your annual table should look like, but please check the following:
library(shiny)
library(rhandsontable)
ui <- fluidPage(
br(),
rHandsontableOutput('table'),
textOutput('result'),
br(),
actionButton("recalc", "re-enter data"),
radioButtons("Step", label = h4("Choose Step"),
choices = list("Annual" = 2, "Season" = 5),
inline= TRUE, selected = 2)
)
rowNames <- list("5" = c("Spring", "Summer", "Autum", "Winter", "Sum"), "2" = c("Year", "Sum"))
server <- function(input, output, session)
({
values <- reactiveValues(data = NULL) ## assign it with NULL
observeEvent(input$Step, {
req(input$Step)
values$data <- data.frame(
row.names = rowNames[[input$Step]],
Lake = rep(NA_integer_, as.integer(input$Step)),
Beach = rep(NA_integer_, as.integer(input$Step)),
Garden = rep(NA_integer_, as.integer(input$Step)),
stringsAsFactors = FALSE
)
})
## button press resets now the data frame
observeEvent(input$recalc, {
values$data[] <- NA_integer_
})
observe({
req(input$table)
DF <- hot_to_r(input$table)
DF[setdiff(rownames(DF), "Sum"),]
DF["Sum",] <- colSums(DF[setdiff(rownames(DF), "Sum"),], na.rm = TRUE)
values$data <- DF
})
output$table <- renderRHandsontable({
req(values$data)
rhandsontable(values$data, rowHeaderWidth = 100) %>%
hot_row(nrow(values$data), readOnly = TRUE)
})
})
shinyApp(ui = ui, server = server)