In my Shiny app, users select one of two databases, then choose the plot type which changes a conditional panel in the main panel. Finally users choose a variable that they want to visualize. I would like it if the variable they choose to visualize stays the same when they switch plot types, however right now whenever plot type is switched, the dynamic variable list updates and removes the user's selection. Does anyone know how to make their selection persist after updating the plot type?
Reprex: (sorry as it is probably not the most minimal example but I wanted to maintain the infrastructure of the app to get the most from the forum!)
It is not completely functional but select a plot type, and switch between variables var1/var2, and the booleans to see how changing plot type resets the selection.
library(ggplot2)
library(shiny)
library(dplyr)
library(tidyr)
library(stringr)
# load fake data
ID<-c("ID1", "ID2", "ID3")
var1<-c("A", "B", "B")
boolean1_1<-c(1,0,1)
boolean2_1<-c(0,1,0)
date<-as.Date(c('2021-01-1','2021-01-4','2021-01-4'))
database1<-data.frame(var1, booleanVar1_1, booleanVar2_1, date, ID)
ID<-c("ID4", "ID5", "ID6")
var2<-c("D", "E", "D")
boolean1_2<-c(1,1,1)
boolean2_2<-c(0,0,0)
date<-as.Date(c('2021-01-6','2021-01-7','2021-01-7'))
database2<-data.frame(var2, booleanVar1_2, booleanVar2_2, date, ID)
## UI
ui<-fluidPage(
sidebarLayout(
### INPUT
sidebarPanel = sidebarPanel(
h3("Select Options"),
selectInput("database","Database:",
list("Data 1" = "database1",
"Data 2" = "database2")
),
selectInput("plottype","Plot Type:",
list("Histogram" = "histogram",
"Frequency Polygon" = "frequencyPolygon")
),
selectInput("variableName", "Variable:",
NULL
)
),
### OUTPUT
mainPanel = mainPanel(
## tabsets
tabsetPanel(type = "tabs",
tabPanel("Plot",
conditionalPanel(
condition = 'input.plottype == "histogram"',
plotOutput('histogram')
),
conditionalPanel(
condition = 'input.plottype == "frequencyPolygon"',
plotOutput('freqPoly')
)
),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("table"))
)
),
position = c("left", "right"),
fluid = TRUE
)
)
## SERVER
server<-function(input, output, session){
check<-function(x){is.null(x) || x==""}
### Update available options in the variable list
options<-c()
observe({
if(check(input$database)) return() # if no database
if(!check(input$database)){
if(input$database =="database1"){
varList<-c(names(database1))
} else if(input$database =="database2"){
varList<-c(names(database2))
}
if("histogram" %in% input$plottype|| "frequencyPolygon" %in% input$plottype){
options<-c(options,varList)
}
updateSelectInput(session, "variableName", choices = options,selected = NULL)
}
})
### Get variable name
variable<-reactive({
check<-function(x){is.null(x) || x==""}
if(check(input$variableName)) return() # if no variable name
if(!check(input$variableName)){ # if it exists
var<-input$variableName
}
var
})
### Get data object
plotData<-reactive({
variable<-variable()
if(!exists(input$database)) return() # if no database
check<-function(x){is.null(x) || x==""}
if(check(input$database)||check(variable)) return()
data=get(input$database)
check<-function(obj){
!all(variable %in% colnames(obj))
}
if(check(data)) return()
# PRE-PROCESS
if (grepl("boolean", input$variableName, fixed = TRUE)){
# make count data
data_count<-data %>%
group_by(date)%>%
summarize(Present = sum(get(variable)==1),
Absent = sum(get(variable)==0))
# convert to long form
df_long<-gather(data_count, variable, count, Present:Absent, factor_key = TRUE)
# PROCESS VARS IN CHARACTERISTIC LIST
} else if (grepl("var", input$variableName, fixed = TRUE)){
# split on space
resp.split<-str_split(as.character(data[[variable]]), " |,")
# ID levels
lev<-unique(unlist(resp.split))
lev<-lev[lev !=""] # remove "" level
lev<-lev[!is.na(lev)] # remove NA level
first<-lev[1]
last<-lev[length(lev)]
# convert to tabulated version
resp.dummy<-lapply(resp.split, function(x) table(factor(x, levels = lev)))
variable_tabs<-with(data, data.frame(ID, do.call(rbind, resp.dummy), get(variable)))
# change name of the column
names(variable_tabs)[length(variable_tabs)]<-variable
# merge with data
variable2<-merge(variable_tabs, data, by = c("ID", variable))
# convert into a frequency table
data_count<-variable2%>%
gather(variable, count, first:last, factor_key = TRUE)
# convert to long form
df_long<-data_count %>%
group_by(date,variable)%>%
summarize(count = sum(count ==1))
}
obj<-list(data = df_long,
variable = variable)
obj
})
## HISTOGRAM
output$histogram<- renderPlot({
plot.obj<-plotData()
#conditions for plotting
if(is.null(plot.obj)) return()
#make sure variable and group have loaded
if(plot.obj$variable == "") return()
df_long<-plot.obj$data
df<-df_long%>%
select(variable, count)%>%
group_by(variable)%>%
summarise(count =sum(count, na.rm = TRUE)) # note without the na.rm = TRUE any instances of NA result in NAs for the sum
ggplot(df,
aes_string(
x = "variable",
fill = "variable",
y = "count"))+
geom_col()+
ggtitle(paste("Histogram of", input$variableName))+
theme_minimal()+
theme(axis.text.x = element_text(angle = 45))
})
## FREQUENCY POLYGON
output$freqPoly<- renderPlot({
plot.obj<-plotData()
#conditions for plotting
if(is.null(plot.obj)) return()
#make sure variable has loaded
if(plot.obj$variable == "") return()
df_long<-plot.obj$data%>%
filter(count>0)
ggplot(df_long, aes_string(x = "date", colour = "variable"))+
geom_freqpoly(binwidth=2)+
ggtitle(paste("Frequency of", input$variableName))+
theme_minimal()
})
## CREATE SUMMARY
output$summary<-renderPrint({
if(input$plottype == "histogram"||input$plottype == "frequencyPolygon"){
plot.obj<-plotData()
summary(plot.obj)
}
})
## CREATE TABLE
output$table <- renderTable({
if (input$plottype == "histogram"||input$plottype == "plotly"||input$plottype == "frequencyPolygon"){
table<-plotData()
t<-table$data%>%
filter(count>0)
t$date<-as.character(t$date)
t
}
})
}
# Create Shiny app ----
shinyApp(ui, server, options = list(height = 1000))