I am new to Shiny and I am developing an app in which the user enters the number of fish they wish to stock at each age (specified by the user) for a user-specified number of years. Currently, the app opens with a default table of common values, but I want the user to be able to easily edit this table, including the number of rows and columns. The user selects the number of years to stock using a slider and I would like the selected value to update the number of columns in the table based on the selected number. There should also be one column for age and one for month. The columns for each year should be named "yr1", "yr2", etc. Similarly, the user selects the number of ages using a slider and I would like this selected value to update the number of rows. The code I have developed is as follows:
library(rhandsontable)
library(shiny)
library(shinydashboard)
#stocking.dat <- data.frame(matrix(nrow=1,ncol=7))
#yrnum <- sprintf("yr%d",seq(1:5))
#colnames(stocking.dat) <- c("age","month",yrnum)
stocking.dat <- data.frame(age=c(1), month=c(5), yr1=c(250000), yr2=c(250000), yr3=c(250000), yr4=c(250000), yr5=c(250000))
ui <- dashboardPage(skin = "blue",
dashboardHeader(title = "PVA",titleWidth = 450),
dashboardSidebar(id="",width=450,
sidebarMenu(
menuItem("Welcome",tabName = "menuWelcome", icon = shiny::icon("face-smile")),
menuItem("Stocking",tabName = "menuStocking", icon = shiny::icon("fish")),
menuItem("Review",tabName = "menuReview", icon = shiny::icon("magnifying-glass-chart")))),
dashboardBody(
tabItems(
tabItem(tabName="menuWelcome",
valueBox("Population Viability Analysis","Welcome",icon = shiny::icon("face-smile"),width=8)),
tabItem(tabName="menuStocking",
fluidRow(valueBox("Proposed Stocking","Enter Data",icon = shiny::icon("fish"),width=8)),
fluidRow(box(sliderInput("n.stockyrs","Number years to stock",value=5,min=0,max=25,step=1),width=8)),
fluidRow(box(sliderInput("n.stockage","Number ages to stock",value=1,min=0,max=5,step=1),width=8)),
fluidRow(box(title="Enter data",status="primary",solidHeader=TRUE,width=8,rHandsontableOutput("hot")))),
tabItem(tabName="menuReview",
fluidRow(valueBox("Review","Review Input",icon = shiny::icon("fish"),width=8)),
fluidRow(box(title="Stocking Data",status="primary",solidHeader=TRUE,width=8,rHandsontableOutput("rvw.hot")))
)
)
))
##########################################################################################################
server <- function(input, output, session) {
values <- reactiveValues(data = stocking.dat)
observe({
if(!is.null(input$hot)){
values$data <- as.data.frame(hot_to_r(input$hot))
print(values$data)
output$hot <- renderRHandsontable({
rhandsontable(values$data)
})
}
})
output$hot <- renderRHandsontable({
rhandsontable(values$data)
})
output$rvw.hot <- renderRHandsontable({
rhandsontable(values$data,readOnly=TRUE)
})
session$onSessionEnded(stopApp)
}
shinyApp(ui, server)
The table should be editable in the Stocking tab and read-only in the Review tab and I think I have that working as expected. I am not sure how to update the number of rows (ages) and columns (number stocking years) based on the input sliders. Nor am I sure how to dynamically name the columns starting with "yr1" and so on depending on the number of years selected.
This was not trivial since you need to keep values edited by the user (at least when keeping rows/columns where there are edited values).
I changed your stock and age inputs to a minimum value of 1 to avoid getting errors with an empty table.
Once the table is initialized with the stocking.dat dataframe, you observe the sliders changes with observeEvent and retrieve the (eventually edited table) with df = hot_to_r(input$hot), as you already did (checking if it's already loaded, with if(!is.null(input$hot))).
After that, you must consider cases when the user will add columns or rows, and cases when the user will delete columns or rows, and build the dataframe accordingly from the existing table. Finally update the reactiveValues object, and re-render the output$hot table.
library(rhandsontable)
library(shiny)
library(shinydashboard)
#stocking.dat <- data.frame(matrix(nrow=1,ncol=7))
#yrnum <- sprintf("yr%d",seq(1:5))
#colnames(stocking.dat) <- c("age","month",yrnum)
stocking.dat <- data.frame(age=c(1), month=c(5), yr1=c(250000), yr2=c(250000), yr3=c(250000), yr4=c(250000), yr5=c(250000))
ui <- dashboardPage(skin = "blue",
dashboardHeader(title = "PVA",titleWidth = 450),
dashboardSidebar(id="",width=450,
sidebarMenu(
menuItem("Welcome",tabName = "menuWelcome", icon = shiny::icon("face-smile")),
menuItem("Stocking",tabName = "menuStocking", icon = shiny::icon("fish")),
menuItem("Review",tabName = "menuReview", icon = shiny::icon("magnifying-glass-chart")))),
dashboardBody(
tabItems(
tabItem(tabName="menuWelcome",
valueBox("Population Viability Analysis","Welcome",icon = shiny::icon("face-smile"),width=8)),
tabItem(tabName="menuStocking",
fluidRow(valueBox("Proposed Stocking","Enter Data",icon = shiny::icon("fish"),width=8)),
fluidRow(box(sliderInput("n.stockyrs","Number years to stock",value=5,min=1,max=25,step=1),width=8)),
fluidRow(box(sliderInput("n.stockage","Number ages to stock",value=1,min=1,max=5,step=1),width=8)),
fluidRow(box(title="Enter data",status="primary",solidHeader=TRUE,width=8,rHandsontableOutput("hot")))),
tabItem(tabName="menuReview",
fluidRow(valueBox("Review","Review Input",icon = shiny::icon("fish"),width=8)),
fluidRow(box(title="Stocking Data",status="primary",solidHeader=TRUE,width=8,rHandsontableOutput("rvw.hot")))
)
)
))
##########################################################################################################
server <- function(input, output, session) {
values <- reactiveValues(data = stocking.dat)
observeEvent(input$n.stockyrs, {
if(!is.null(input$hot)){
df = hot_to_r(input$hot)
dfyrs = df[,-(1:2)]
# add new columns if input > number of existing columns
if(input$n.stockyrs > ncol(dfyrs)) {
newcols = as.data.frame(matrix(250000, ncol = input$n.stockyrs - ncol(dfyrs)))
dfyrs = cbind(dfyrs, newcols)
} else { # else remove columns
dfyrs = dfyrs[,1:input$n.stockyrs]
}
names(dfyrs) = paste0("yr", 1:input$n.stockyrs)
df = cbind(df[,1:2], dfyrs)
values <- reactiveValues(data = df)
output$hot <- renderRHandsontable({
rhandsontable(values$data)
})
}
})
observeEvent(input$n.stockage, {
if(!is.null(input$hot)){
df = hot_to_r(input$hot)
dfam = df[,1:2]
# add new rows if input > number of existing rows
if(input$n.stockage > nrow(df)) {
# new rows
newrows = as.data.frame(matrix(250000, nrow = input$n.stockage - nrow(dfyrs), ncol = input$n.stockyrs))
names(newrows) = paste0("yr", 1:input$n.stockyrs)
highestexistingage = dfam[length(dfam$age),1]
dfamnewrows = data.frame(age = seq(highestexistingage + 1, input$n.stockage), month = rep(5))
newrows = cbind(dfamnewrows, newrows)
df = rbind(df, newrows)
} else { #remove rows
df = df[1:input$n.stockage,]
}
values <- reactiveValues(data = df)
print(values$data)
output$hot <- renderRHandsontable({
rhandsontable(values$data)
})
}
})
observe({
if(!is.null(input$hot)){
values$data <- as.data.frame(hot_to_r(input$hot))
output$hot <- renderRHandsontable({
rhandsontable(values$data)
})
}
})
output$hot <- renderRHandsontable({
rhandsontable(values$data)
})
output$rvw.hot <- renderRHandsontable({
rhandsontable(values$data,readOnly=TRUE)
})
session$onSessionEnded(stopApp)
}
shinyApp(ui, server)