I have built a shiny app having multiple tabs and tried to save the state of the app and restore it but I am not getting result as I expected. Following is the example code I have used to save and restore.
file will stored in .rds format.
library(shinydashboard)
library(shinyWidgets)
library(plotly)
library(DT)
library(corrr)
library(dplyr)
library(Robyn)
library(qgraph)
library(shinyjs)
library(utils)
library(tools)
library(stringi)
ui <- function(request){fluidPage(
useShinyjs(),
titlePanel("APP"),
useShinydashboard(),
fileInput(
"file",
"Choose CSV File",
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
checkboxInput("header",
"Header",
value = TRUE),
radioButtons(
"disp",
"Display",
choices = c(Head = "head",
All = "all"),
selected = "head"
),
fileInput("restore_bookmark",
"Restore Session",
multiple = FALSE
#accept = ".rds"),
),
# SIDEBAR --------------------------------------------------------
navlistPanel(
widths = c(2,10),
# Input data ---------------------------------------------------
tabPanel('Input data',
fluidRow(
box(width = 12,
dataTableOutput('table'),
title = 'Raw data'),
box(width = 6,
dataTableOutput('miss'),
title = 'Missing percentage table'),
box(width = 6,
dataTableOutput('dtype'),
title = 'Datatype')
)
),
# Basic EDA ----------------------------------------------------
tabPanel('Basic EDA',
fluidRow(
column(width = 7,
box(
width = NULL,
plotlyOutput('correlation',
height = 450),
title = 'Correlation plot',
style = 'overflow-y:scroll; max-height: 600px'
),
box(
width = NULL,
selectInput(
inputId = 'x_axis',
label = 'X-axis',
'Names',
multiple = FALSE
),
selectInput(
inputId = 'y_axis',
label = 'Y-axis',
'Names',
multiple = FALSE
)
)
),
column(width = 5,
box(
width = NULL,
plotOutput('network',
height = 250),
title = 'Correlation network',
sliderInput('netslider',
'Min corr',
min = 0,
max = 1,
value = 0.3)
),
box(
width = NULL,
plotlyOutput('scatter',
height = 300),
title = 'Scatter plot'
)
)
),
actionButton("save_inputs",
'Save Session',
icon = icon("download"))
)
)
)}
server <- function(input, output, session) {
# Session saving --------------------------------------------------
latestBookmarkURL <- reactiveVal()
onBookmarked(
fun = function(url) { #url
latestBookmarkURL(parseQueryString(url))
}
)
onRestored(function(state) {
showNotification(paste("Restored session:",
basename(state$dir)),
duration = 10,
type = "message")
})
observeEvent(input$save_inputs, {
showModal(modalDialog(
title = "Session Name",
textInput("session_name",
"Please enter a session name (optional):"),
footer = tagList(
modalButton("Cancel"),
downloadButton("download_inputs", "OK")
)
))
}, ignoreInit = TRUE)
# SAVE SESSION ---------------------------------------------------------------
output$download_inputs <- downloadHandler(
filename = function() {
removeModal()
session$doBookmark()
if (input$session_name != "") {
tmp_session_name <- sub("\\.rds$", "", input$session_name)
tmp_session_name <- stri_replace_all(tmp_session_name, "", regex = "[^[:alnum:]]")
tmp_session_name <- paste0(tmp_session_name, ".rds")
print(tmp_session_name)
} else {
paste(req(latestBookmarkURL()), "rds", sep = ".")
}
},
print(latestBookmarkURL()),
content = function(file) {
file.copy(from = file.path(
".",
"shiny_bookmarks",
req(latestBookmarkURL()),
"input.rds"
#paste0(ses_name(),'.rds')
),
to = file)
}
)
# LOAD SESSION ---------------------------------------------------------------
observeEvent(input$restore_bookmark, {
sessionName <- file_path_sans_ext(input$restore_bookmark$name)
print(sessionName)
targetPath <- file.path(".", "shiny_bookmarks", sessionName, "input.rds")
print(targetPath)
restoreURL <- paste0(session$clientData$url_protocol, "//",
session$clientData$url_hostname, ":",
session$clientData$url_port,
session$clientData$url_pathname,
"?_state_id_=",
sessionName)
print(restoreURL)
# redirect user to restoreURL
runjs(sprintf("window.location = '%s';", restoreURL))
print(sprintf("window.location = '%s';", restoreURL))
})
dataset <- reactive({
read.csv("./Dataset/data.csv")
})
observe(
output$table <- DT::renderDataTable({
if (input$disp == 'head') {
head(dataset())
}
else{
dataset()
}
})
)
# Missing percentage table ---------------------------------------
output$miss <- renderDataTable({
miss_dataframe = data.frame(names(dataset()),
(colMeans(is.na(dataset())))*100)
setNames(miss_dataframe,c("Variable","Missing percentage"))
})
# Datatype table -------------------------------------------------
output$dtype <- renderDataTable({
dtype_dataframe = data.frame(names(dataset()),
sapply(dataset(),class))
setNames(dtype_dataframe,c('Variables','Data type'))
})
# Correlation plot -----------------------------------------------------------
sub_dataset <- reactive({
subset(dataset(),
select = sapply(dataset(),
class) != 'character',
drop = TRUE)
})
output$correlation <- renderPlotly({
cor_sub <- cor(sub_dataset())
plot_ly(x = names(sub_dataset()),
y = names(sub_dataset()),
z = cor_sub,
type = 'heatmap',
colors = colorRamp(c("red", "green")),
zmin = -1,
zmax = 1,
width = 600,
height = 500) %>%
layout(title = paste('Correlation plot'))
})
# Correlation network --------------------------------------------
output$network <- renderPlot({
qgraph(cor(sub_dataset()),
shape = 'ellipse',
overlay = TRUE,
layout = 'spring',
minimum = input$netslider,
vsize = 8,
labels = TRUE,
nodeNames = colnames(sub_dataset()),
details = T,
legend = T,
legend.cex = 0.4,
GLratio = 1.3,
label.prop = 1.5
)
})
# scatter plot ---------------------------------------------------------------
observe({
updateSelectInput(inputId = "x_axis",choices = names(dataset()))
updateSelectInput(inputId = "y_axis",choices = names(dataset()))
})
x_axis <- reactive({
dataset()[,input$x_axis]
})
y_axis <- reactive({
dataset()[,input$y_axis]
})
output$scatter <- renderPlotly({
plot_ly(dataset(), x = x_axis(),
y = y_axis(),
type = 'scatter',
mode = 'markers') %>%
layout(title = paste("Scatter plot"))
})
}
enableBookmarking(store = 'server')
shinyApp(ui = ui, server = server)
I have taken this save and restore technique from this link. please give any suggestions.
Here is the output of dput(head(read.csv("./Dataset/data.csv")))
structure(list(Date = c("2020-01-01", "2020-01-02", "2020-01-03",
"2020-01-04", "2020-01-05", "2020-01-06", "2020-01-07", "2020-01-08",
"2020-01-09", "2020-01-10"), CRM_web_visits = c(72531L, 74512L,
102819L, 79954L, 36726L, 35314L, 32973L, 67710L, 56590L, 236847L
), DIRECT.NOSOURCE._web_visits = c(170419L, 201539L, 182053L,
174788L, 169971L, 191405L, 205873L, 198961L, 199704L, 235057L
), DISPLAY_ad_spend = c(5974.94, 6791.05, 6475.65, 6977.87, 7184.88,
7282.68, 6990.11, 7184.7, 7310.45, 7381.47), DISPLAY_impression = c(5195802L,
6419806L, 6851564L, 7465473L, 8542588L, 8856138L, 9563437L, 9741881L,
10102445L, 10764759L), EARNEDSOCIAL_web_visits = c(8468L, 13646L,
17214L, 15885L, 16675L, 12983L, 12985L, 18746L, 19377L, 42041L
), ORGANICSEARCH_web_visits = c(161203L, 228753L, 228830L, 223210L,
219383L, 228044L, 228522L, 262009L, 239033L, 250576L), OTHERS_web_visits = c(709L,
1561L, 1698L, 1541L, 1448L, 1685L, 1838L, 2060L, 2213L, 2400L
), PAIDSEARCH_ad_spend = c(83432.41, 103529.01, 102688.27, 109478.01,
109835.46, 102679.45, 106726.33, 145900.64, 149793.69, 135749.34
), PAIDSEARCH_impression = c(9614558L, 10974797L, 11177990L,
12129001L, 11936305L, 11635109L, 11320728L, 12709154L, 13554402L,
13776665L), PAIDSOCIAL_ad_spend = c(11538.3, 8512.8, 8805.4,
11433.27, 11323.38, 11344.67, 11273.9, 11785.63, 11559.53, 18486.82
), PAIDSOCIAL_impression = c(12212695L, 8692666L, 8456129L, 9878943L,
10315930L, 11530289L, 10552150L, 10546136L, 8784657L, 12968591L
), PARTNERSHIPMARKETING_ad_spend = c(63636.11, 6130.62, 8362.65,
6208.49, 6114.99, 5079.42, 9484.97, 22930.46, 10150.6, 22321.9
), PARTNERSHIPMARKETING_click = c(72785L, 119086L, 113134L, 92235L,
92232L, 81516L, 96305L, 126095L, 130431L, 249288L), REFERRINGSITES_web_visits = c(7955L,
12286L, 13948L, 12509L, 10906L, 11595L, 11818L, 13143L, 13179L,
17014L), Overall_Revenue = c(941026.4, 1293915.56, 1485440.42,
1395251.29, 1358603.2, 1342233.84, 1385053.29, 1883013.32, 1438745.75,
3017775.46)), row.names = c(NA, 10L), class = "data.frame")
thanks in advance
Well, you deleted (or didn't copy) the dir.create and file.copy calls in the observeEvent(input$restore_bookmark, [...] from my original answer. They are mandatory for this to work.
Furthermore I added an id to your navlistPanel so its state can be bookmarked and your updateSelectInput(inputId = "x_axis" ... is overwriting the restored bookmark state for your selectInputs - you might want to change the logic, so that is is used only if the session wasn't restored - check ?onRestore.
library(shiny)
library(shinydashboard)
library(shinyWidgets)
library(plotly)
library(DT)
library(corrr)
library(dplyr)
library(Robyn)
library(qgraph)
library(shinyjs)
library(utils)
library(tools)
library(stringi)
ui <- function(request){fluidPage(
useShinyjs(),
titlePanel("APP"),
useShinydashboard(),
fileInput(
"file",
"Choose CSV File",
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")
),
checkboxInput("header",
"Header",
value = TRUE),
radioButtons(
"disp",
"Display",
choices = c(Head = "head",
All = "all"),
selected = "head"
),
fileInput("restore_bookmark",
"Restore Session",
multiple = FALSE
#accept = ".rds"),
),
# SIDEBAR --------------------------------------------------------
navlistPanel(
id = "navlistPanelID",
widths = c(2,10),
# Input data ---------------------------------------------------
tabPanel('Input data',
fluidRow(
box(width = 12,
dataTableOutput('table'),
title = 'Raw data'),
box(width = 6,
dataTableOutput('miss'),
title = 'Missing percentage table'),
box(width = 6,
dataTableOutput('dtype'),
title = 'Datatype')
)
),
# Basic EDA ----------------------------------------------------
tabPanel('Basic EDA',
fluidRow(
column(width = 7,
box(
width = NULL,
plotlyOutput('correlation',
height = 450),
title = 'Correlation plot',
style = 'overflow-y:scroll; max-height: 600px'
),
box(
width = NULL,
selectInput(
inputId = 'x_axis',
label = 'X-axis',
choices = NULL,
multiple = FALSE
),
selectInput(
inputId = 'y_axis',
label = 'Y-axis',
choices = NULL,
multiple = FALSE
)
)
),
column(width = 5,
box(
width = NULL,
plotOutput('network',
height = 250),
title = 'Correlation network',
sliderInput('netslider',
'Min corr',
min = 0,
max = 1,
value = 0.3)
),
box(
width = NULL,
plotlyOutput('scatter',
height = 300),
title = 'Scatter plot'
)
)
),
actionButton("save_inputs",
'Save Session',
icon = icon("download"))
)
)
)}
server <- function(input, output, session) {
# Session saving --------------------------------------------------
latestBookmarkURL <- reactiveVal()
onBookmarked(
fun = function(url) { #url
latestBookmarkURL(parseQueryString(url))
}
)
onRestored(function(state) {
showNotification(paste("Restored session:",
basename(state$dir)),
duration = 10,
type = "message")
})
observeEvent(input$save_inputs, {
showModal(modalDialog(
title = "Session Name",
textInput("session_name",
"Please enter a session name (optional):"),
footer = tagList(
modalButton("Cancel"),
downloadButton("download_inputs", "OK")
)
))
}, ignoreInit = TRUE)
# SAVE SESSION ---------------------------------------------------------------
output$download_inputs <- downloadHandler(
filename = function() {
removeModal()
session$doBookmark()
if (input$session_name != "") {
tmp_session_name <- sub("\\.rds$", "", input$session_name)
tmp_session_name <- stri_replace_all(tmp_session_name, "", regex = "[^[:alnum:]]")
tmp_session_name <- paste0(tmp_session_name, ".rds")
print(tmp_session_name)
} else {
paste(req(latestBookmarkURL()), "rds", sep = ".")
}
},
print(latestBookmarkURL()),
content = function(file) {
file.copy(from = file.path(
".",
"shiny_bookmarks",
req(latestBookmarkURL()),
"input.rds"
#paste0(ses_name(),'.rds')
),
to = file)
}
)
# LOAD SESSION ---------------------------------------------------------------
observeEvent(input$restore_bookmark, {
sessionName <- file_path_sans_ext(input$restore_bookmark$name)
print(sessionName)
targetPath <- file.path(".", "shiny_bookmarks", sessionName, "input.rds")
print(targetPath)
restoreURL <- paste0(session$clientData$url_protocol, "//",
session$clientData$url_hostname, ":",
session$clientData$url_port,
session$clientData$url_pathname,
"?_state_id_=",
sessionName)
print(restoreURL)
if (!dir.exists(dirname(targetPath))) {
dir.create(dirname(targetPath), recursive = TRUE)
}
file.copy(
from = input$restore_bookmark$datapath,
to = targetPath,
overwrite = TRUE
)
restoreURL <- paste0(session$clientData$url_protocol, "//", session$clientData$url_hostname, ":", session$clientData$url_port, session$clientData$url_pathname, "?_state_id_=", sessionName)
# redirect user to restoreURL
runjs(sprintf("window.location = '%s';", restoreURL))
print(sprintf("window.location = '%s';", restoreURL))
})
dataset <- reactive({
# read.csv("./Dataset/data.csv")
structure(list(Date = c("2020-01-01", "2020-01-02", "2020-01-03",
"2020-01-04", "2020-01-05", "2020-01-06", "2020-01-07", "2020-01-08",
"2020-01-09", "2020-01-10"), CRM_web_visits = c(72531L, 74512L, 102819L,
79954L, 36726L, 35314L, 32973L, 67710L, 56590L, 236847L ),
DIRECT.NOSOURCE._web_visits = c(170419L, 201539L, 182053L, 174788L,
169971L, 191405L, 205873L, 198961L, 199704L, 235057L ), DISPLAY_ad_spend =
c(5974.94, 6791.05, 6475.65, 6977.87, 7184.88, 7282.68, 6990.11, 7184.7,
7310.45, 7381.47), DISPLAY_impression = c(5195802L, 6419806L, 6851564L,
7465473L, 8542588L, 8856138L, 9563437L, 9741881L, 10102445L, 10764759L),
EARNEDSOCIAL_web_visits = c(8468L, 13646L, 17214L, 15885L, 16675L,
12983L, 12985L, 18746L, 19377L, 42041L ), ORGANICSEARCH_web_visits =
c(161203L, 228753L, 228830L, 223210L, 219383L, 228044L, 228522L, 262009L,
239033L, 250576L), OTHERS_web_visits = c(709L, 1561L, 1698L, 1541L,
1448L, 1685L, 1838L, 2060L, 2213L, 2400L ), PAIDSEARCH_ad_spend =
c(83432.41, 103529.01, 102688.27, 109478.01, 109835.46, 102679.45,
106726.33, 145900.64, 149793.69, 135749.34 ), PAIDSEARCH_impression =
c(9614558L, 10974797L, 11177990L, 12129001L, 11936305L, 11635109L,
11320728L, 12709154L, 13554402L, 13776665L), PAIDSOCIAL_ad_spend =
c(11538.3, 8512.8, 8805.4, 11433.27, 11323.38, 11344.67, 11273.9,
11785.63, 11559.53, 18486.82 ), PAIDSOCIAL_impression = c(12212695L,
8692666L, 8456129L, 9878943L, 10315930L, 11530289L, 10552150L, 10546136L,
8784657L, 12968591L ), PARTNERSHIPMARKETING_ad_spend = c(63636.11,
6130.62, 8362.65, 6208.49, 6114.99, 5079.42, 9484.97, 22930.46, 10150.6,
22321.9 ), PARTNERSHIPMARKETING_click = c(72785L, 119086L, 113134L,
92235L, 92232L, 81516L, 96305L, 126095L, 130431L, 249288L),
REFERRINGSITES_web_visits = c(7955L, 12286L, 13948L, 12509L, 10906L,
11595L, 11818L, 13143L, 13179L, 17014L), Overall_Revenue = c(941026.4,
1293915.56, 1485440.42, 1395251.29, 1358603.2, 1342233.84, 1385053.29,
1883013.32, 1438745.75, 3017775.46)), row.names = c(NA, 10L), class =
"data.frame")
})
observe(
output$table <- DT::renderDataTable({
if (input$disp == 'head') {
head(dataset())
}
else{
dataset()
}
})
)
# Missing percentage table ---------------------------------------
output$miss <- renderDataTable({
miss_dataframe = data.frame(names(dataset()),
(colMeans(is.na(dataset())))*100)
setNames(miss_dataframe,c("Variable","Missing percentage"))
})
# Datatype table -------------------------------------------------
output$dtype <- renderDataTable({
dtype_dataframe = data.frame(names(dataset()),
sapply(dataset(),class))
setNames(dtype_dataframe,c('Variables','Data type'))
})
# Correlation plot -----------------------------------------------------------
sub_dataset <- reactive({
subset(dataset(),
select = sapply(dataset(),
class) != 'character',
drop = TRUE)
})
output$correlation <- renderPlotly({
cor_sub <- cor(sub_dataset())
plot_ly(x = names(sub_dataset()),
y = names(sub_dataset()),
z = cor_sub,
type = 'heatmap',
colors = colorRamp(c("red", "green")),
zmin = -1,
zmax = 1,
width = 600,
height = 500) %>%
layout(title = paste('Correlation plot'))
})
# Correlation network --------------------------------------------
output$network <- renderPlot({
qgraph(cor(sub_dataset()),
shape = 'ellipse',
# overlay = TRUE,
layout = 'spring',
minimum = input$netslider,
vsize = 8,
labels = TRUE,
nodeNames = colnames(sub_dataset()),
details = T,
legend = T,
legend.cex = 0.4,
GLratio = 1.3,
label.prop = 1.5
)
})
# scatter plot ---------------------------------------------------------------
isBookmarkedSession <- reactiveVal(FALSE)
onRestore(function(state) {
isBookmarkedSession(TRUE)
updateSelectInput(inputId = "x_axis", choices = names(dataset()), selected = state$input$x_axis)
updateSelectInput(inputId = "y_axis", choices = names(dataset()), selected = state$input$y_axis)
})
observe({
if(!isBookmarkedSession()){
updateSelectInput(inputId = "x_axis", choices = names(dataset()))
updateSelectInput(inputId = "y_axis", choices = names(dataset()))
}
})
output$scatter <- renderPlotly({
req(dataset(), input$x_axis, input$y_axis)
plot_ly(dataset(), x = ~ get(input$x_axis),
y = ~ get(input$y_axis),
type = 'scatter',
mode = 'markers') %>%
layout(title = paste("Scatter plot"))
})
}
enableBookmarking(store = 'server')
shinyApp(ui = ui, server = server)