How to bookmark and restore dynamically added modules?
One would expect all module instances to be restored, but as you pointed out, only the last one is restored due to addbutton restoration.
As a workaround, you could store the module instances list stored in state$exclude with onBookmark and re-create the instances of the module with onRestore.histogramUI was modified in order to accept var,bins as new parameters for creation of the modules.
Another important point is to use setBookmarkExclude so that the add button doesn't create the last module at restoration. As the button isn't anymore bookmarked, it's value should be also be saved with onBookmark.
Try:
library(shiny)
histogramUI <- function(id,var,bins) {
tagList(
fluidRow(column( 4, selectInput(NS(id, "var"), "Variable", choices = names(mtcars),selected=var),
numericInput(NS(id, "bins"), "bins", value = bins, min = 1)),
column(8, plotOutput(NS(id, "hist"))))
)
}
histogramServer <- function(id) {
moduleServer(id, function(input, output, session) {
data <- reactive(mtcars[[input$var]])
output$hist <- renderPlot({
hist(data(), breaks = input$bins, main = input$var)
}, res = 96)
})
}
ui <- function(request){
fluidPage(
bookmarkButton(),
actionButton("add", "Add Histogram"),
div(id = "add_here")
)
}
server <- function(input, output, session) {
add_id <- reactiveVal(0) # To save 'add' button state
setBookmarkExclude('add') # Don't add new module at restoration
observeEvent(input$add, {
histogramServer(paste0("hist_", input$add+add_id()))
insertUI(selector = "#add_here", ui = histogramUI(paste0("hist_", input$add+add_id()),'mpg',10))
})
onBookmark(function(state) {
modules <- state$exclude
state$values$modules <- modules[grepl("hist",modules)] # only 'hist' (without 'add')
state$values$add <- state$input$add + add_id() # add button state
})
onRestore(function(state){
# Restore 'add' last state
add_id(state$values$add)
# Restore 'hist' modules
modules <- state$values$modules
if (length(modules)>0) {
for (i in 1:(length(modules))) {
histogramServer(modules[i])
insertUI(selector = "#add_here", ui = histogramUI(modules[i],paste0(modules[i],"-var"),paste0(modules[i],"-bin")))
}
}
})
}
shinyApp(ui, server, enableBookmarking = "server")
Restore input values with Shiny URL bookmark and rerun calculations
My first instinct was that you probably need to use onRestore() as @AndrewTaylor suggested. But after trying to run your code, it was evident that the issue here is fixed by simply fixing the reactivity in the code.
Here is your code, with two small edits: first, the output$x1 was defined twice, so I removed the second one that was not using any reactive values. Secondly, I moved the first output$x1 to be outside of an observeEvent, and made it trigger only when the button is pressed. You should generally not define an output inside an observer, unless it's a special case where it's mandatory, but the way it was done here causes incorrect reactivity. Fixing this is all you needed.
Also, the DT and dplyr packages needed to be loaded to make the code fully reproducible.
library(shiny)
library(RSQLite)
library(data.table)
library(DT)
library(dplyr)
ui <- function(request) {
fluidPage(
DT::dataTableOutput("x1"),
column(
12,
column(3,tags$div(title="forecast", numericInput("budget_input", label = ("Total Forecast"), value = 2))),
column(2, textInput(inputId = "description", label = "Bookmark description", placeholder = "Data Summary")),
column(2, bookmarkButton(id="bookmarkBtn"))),
column(2, actionButton("opt_run", "Run")),
DT::dataTableOutput("urlTable", width = "100%"),
tags$style(type='text/css', "#bookmarkBtn { width:100%; margin-top: 25px;}")
)
}
server <- function(input, output, session) {
con <- dbConnect(RSQLite::SQLite(), "bookmarks.db", overwrite = FALSE)
myBookmarks <- reactiveValues(urlDF = NULL)
observeEvent(input$bookmarkBtn, {
session$doBookmark()
})
observeEvent(input$opt_run, {
cat('HJE')
})
output$x1 <- DT::renderDataTable({
input$opt_run
isolate({
datatable(
df %>% mutate(Current = as.numeric(Current)*(input$budget_input)), selection = 'none', editable = TRUE
)
})
})
if(dbExistsTable(con, "Bookmarks")){
tmpUrlDF <- data.table(dbReadTable(con, "Bookmarks"))
myBookmarks$urlDF <- tmpUrlDF[, Timestamp := as.POSIXct(Timestamp, origin="1970-01-01 00:00")]
} else {
myBookmarks$urlDF <- NULL
}
session$onSessionEnded(function() {
tmpUrlDF <- isolate({myBookmarks$urlDF})
if(!is.null(tmpUrlDF)){
dbWriteTable(con, "Bookmarks", tmpUrlDF, overwrite = TRUE)
}
dbDisconnect(con)
})
setBookmarkExclude(c("bookmarkBtn", "description", "urlTable_cell_clicked", "urlTable_rows_all", "urlTable_rows_current", "urlTable_rows_selected", "urlTable_search", "urlTable_state", "urlTable_row_last_clicked"))
df <- data.table(Channel = c("A", "B","C"),
Current = c("2000", "3000","4000"),
Modified = c("2500", "3500","3000"),
New_Membership = c("450", "650","700"))
onBookmarked(fun=function(url){
if(!url %in% myBookmarks$urlDF$URL){
if(is.null(myBookmarks$urlDF)){
myBookmarks$urlDF <- unique(data.table(Description = input$description, URL = paste0("<a href='", url, "'>", url,"</a>"), Timestamp = Sys.time(), Session = session$token, User = Sys.getenv("USERNAME")), by="URL")
} else {
myBookmarks$urlDF <- unique(rbindlist(list(myBookmarks$urlDF, data.table(Description = input$description, URL = paste0("<a href='", url, "'>", url,"</a>"), Timestamp = Sys.time(), Session = session$token, User = Sys.getenv("USERNAME")))), by="URL")
}
}
})
output$urlTable = DT::renderDataTable({
req(myBookmarks$urlDF)
myBookmarks$urlDF[User %in% Sys.getenv("USERNAME")]
}, escape=FALSE)
}
enableBookmarking(store = "url")
shinyApp(ui, server)
How to loop through bookmark state inputs and restore in the right order?
You could use onBookmark to save state$exclude which gives the order of the modules.
The buttons should also be excluded from bookmarking with setBookmarkExclude :
library(shiny)
library(janitor)
histogramUI <- function(id,var,bins) {
tagList(
fluidRow(column( 4, selectInput(NS(id, "var"), "Variable", choices = names(mtcars),selected=var),
numericInput(NS(id, "bins"), "bins", value = bins, min = 1)),
column(8, plotOutput(NS(id, "hist"))))
)
}
histogramServer <- function(id) {
moduleServer(id, function(input, output, session) {
data <- reactive(mtcars[[input$var]])
output$hist <- renderPlot({
hist(data(), breaks = input$bins, main = input$var)
}, res = 96)
})
}
tableUI <- function(id,var,bins) {
tagList(
fluidRow(column( 4, selectInput(NS(id, "var"), "Variable", choices = names(mtcars),selected=var),
column(8, tableOutput(NS(id, "tab")))))
)
}
tableServer <- function(id) {
moduleServer(id, function(input, output, session) {
data <- reactive(mtcars[[input$var]])
output$tab <- renderTable({
tabyl(data(), main = input$var)
})
})
}
boxUI <- function(id,var) {
tagList(
fluidRow(column( 4, selectInput(NS(id, "var2"), "Variable", choices = names(mtcars),selected=var),
column(8, plotOutput(NS(id, "box"))))
))
}
boxServer <- function(id) {
moduleServer(id, function(input, output, session) {
data <- reactive(mtcars[[input$var2]])
output$box <- renderPlot({
boxplot(data(), main = input$var2)
})
})
}
ui <- function(request){
fluidPage(
bookmarkButton(),
actionButton("add", "Add Histogram"),
actionButton("add2", "Add Boxplot"),
actionButton("add3", "Add Table"),
div(id = "add_here")
)
}
server <- function(input, output, session) {
setBookmarkExclude(c('add','add2','add3'))
add_id <- reactiveVal(0)
add2_id <- reactiveVal(0)
add3_id <- reactiveVal(0)
observeEvent(input$add, {
bins <- 10
histogramServer(paste0("hist_", input$add+add_id()))
insertUI(selector = "#add_here", ui = histogramUI(paste0("hist_", input$add+add_id()),input$var,bins))#}
})
observeEvent(input$add2, {
boxServer(paste0("box_", input$add2+add2_id())) #changed add_id() to add2_id()
insertUI(selector = "#add_here", ui = boxUI(paste0("box_", input$add2+add2_id()), input$var2))
})
observeEvent(input$add3, {
tableServer(paste0("tab_", input$add3+add3_id()))
insertUI(selector = "#add_here", ui = tableUI(paste0("tab_", input$add3+add3_id()), input$var))
})
onBookmark(function(state) {
state$values$modules <- state$exclude
state$values$add <- state$input$add + add_id()
state$values$add2 <- state$input$add2 + add2_id()
state$values$add3 <- state$input$add3 + add3_id()
})
onRestore(function(state){
add_id(state$values$add)
add2_id(state$values$add2)
add3_id(state$values$add3)
modules <- state$values$modules
if (length(modules)>1) {
for (i in 1:(length(modules))) {
if (substr(modules[i],1,4)=='hist') {
histogramServer(modules[i])
insertUI(selector = "#add_here", ui = histogramUI(modules[i],paste0(modules[i],"-var"),paste0(modules[i],"-bin")))
}
if (substr(modules[i],1,3)=='box') {
boxServer(modules[i])
insertUI(selector = "#add_here", ui = boxUI(modules[i],paste0(modules[i],"-var")))
}
if (substr(modules[i],1,3)=='tab') {
tableServer(modules[i])
insertUI(selector = "#add_here", ui = tableUI(modules[i],paste0(modules[i],"-var")))
}
}
}
})
}
shinyApp(ui, server, enableBookmarking = "server")
How to save and load state with insertUI modules?
edit: Found another solution emulating what insertUI does but with renderUI:
library(shiny)
library(purrr)
ui <- function(request){fluidPage(
actionButton("add", "Add UI"),
uiOutput('dynamic_ui'),
bookmarkButton()
)}
# Server logic
server <- function(input, output, session) {
input_contents <- reactive({reactiveValuesToList(input)})
observeEvent(input$add, {
# a new ui will be rendered with one extra input each time add button is pressed
output$dynamic_ui <- renderUI({
map(1:input$add, ~textInput(inputId = paste0("txt", .x), label = paste0("txt", .x) ))
})
#add the old values, otherwise all the inputs will be empty agin.
input_contents() %>%
names() %>%
map(~ updateTextInput(session = session, inputId = .x, label = .x, value = input_contents()[[.x]]))
})
}
# Complete app with UI and server components
shinyApp(ui, server, enableBookmarking = "server")
insertUI might be broken. The only way i could "fix" it was to drop function(request) of the ui, that caused that all the values in the inputs have to be saved between stances (in state$values$input_restore). Also a warning is showed in the console, but it doesn't affect the functionality.
library(shiny)
library(tidyverse)
library(stringr)
ui <- fluidPage(
actionButton("add", "Add UI"),
uiOutput('restored_ui'), #this is very important
bookmarkButton())
# Server logic
server <- function(input, output, session) {
counter <- reactiveValues()
counter$n <- c(0) #This value is only used to initialize the object.
total_ui_count <- reactiveValues()
total_ui_count$info <- 0 #because input$add will reset to zero this will count the number of uis to remember.
#When bookmark button is pressed
onBookmark(function(state) {
state$values$currentCounter <- counter$n
state$values$input_restore <- reactiveValuesToList(input)
print(names(input) %>% str_subset('^txt'))
state$values$total_uis_to_restore <- counter$n[[length(counter$n)]]
})
#rerender the previous outputs and their values
onRestore(function(state) {
#restore values from previous state
counter$n <- state$values$currentCounter
vals <- state$values$input_restore
print(str_subset(names(vals), '^txt.*$')) #for debugging
total_ui_count$info <- state$values$total_uis_to_restore
print(total_ui_count$info)
#render back a ui with the previous values.
output$restored_ui <- renderUI({
str_subset(names(vals), '^txt.*$') %>%
sort(decreasing = TRUE) %>% #to avoid order reversal of the inputs
map(~ textInput(.x, label = .x, value = vals[[.x]])) #render the last inputs
})
})
observeEvent(input$add, {
#input$add starts as 1 in the next state (because ui is not wrapped in function(request)) that's why total_ui_count is present
counter$n <- c(counter$n, input$add + total_ui_count$info)
print(counter$n) #for debugging
insertUI(
selector = "#add",
where = "afterEnd",
ui = textInput(inputId = paste0("txt", counter$n[[length(counter$n)]]),
label = "Insert some text")
)})
}
# Complete app with UI and server components
shinyApp(ui, server, enableBookmarking = "server")
How to generate multiple plots using modules?
Here is a solution where every time you click add you generate a new pair of histogramServer/histogramUI which have the same id (but a different one than the one before, because add gets incremented):
library(shiny)
histogramUI <- function(id) {
tagList(
selectInput(NS(id, "var"), "Variable", choices = names(mtcars)),
numericInput(NS(id, "bins"), "bins", value = 10, min = 1),
plotOutput(NS(id, "hist"))
)
}
histogramServer <- function(id) {
moduleServer(id, function(input, output, session) {
data <- reactive(mtcars[[input$var]])
output$hist <- renderPlot({
hist(data(), breaks = input$bins, main = input$var)
}, res = 96)
})
}
ui <- fluidPage(
actionButton("add", "Add"),
div(id = "add_here")
)
server <- function(input, output, session) {
observeEvent(input$add, {
histogramServer(paste0("hist_", input$add))
insertUI(selector = "#add_here", ui = histogramUI(paste0("hist_", input$add)))
})
}
shinyApp(ui,server)
dynamically adding functions to a Python module
use either
current_module.new_name = func
or
setattr(current_module, new_name, func)
Related Topics
Fitting a Lognormal Distribution to Truncated Data in R
Na Matches Na, But Is Not Equal to Na. Why
Longtable in a Knitr (Pdf) Document: Using Xtable (Or Kable)
Automatically Detect Date Columns When Reading a File into a Data.Frame
Plot Table Objects with Ggplot
Why Should Someone Use {} for Initializing an Empty Object in R
How Does Settimelimit Work in R
How to Calculate the Median on Grouped Dataset
How to Change Factor Labels into String in a Data Frame
Unpacking and Merging Lists in a Column in Data.Frame
Wrapping Base R Reshape for Ease-Of-Use
Creating Shiny Reactive Variable That Indicates Which Widget Was Last Modified
Select Multiple Columns with Dplyr::Select() with Numbers as Names