I have a shiny application with many tabs and many widgets on each tab. It is a data-driven application so the data is tied to every tab.
I can save the application using image.save() and create a .RData file for later use.
The issue I am having how can I get the state restored for the widgets?
If the user has checked boxes, selected radio buttons and specified base line values in list boxes can I set those within a load() step?
I have found libraries such as shinyURL and shinystore but is there a direct way to set the environment back to when the write.image was done?
I am not sure where to even start so I can't post code.
edit: this is a cross-post from the Shiny Google Group where other solutions have been suggested
This is a bit hacky, but it works. It uses an "internal" function (session$sendInputMessage) which is not meant to be called explicitly, so there is no guarantee this will always work.
You want to save all the values of the input object. I'm getting all the widgets using reactiveValuesToList(input) (note that this will also save the state of buttons, which doesn't entirely make sense). An alternative approach would be to enumerate exactly which widgets to save, but that solution would be less generic and you'd have to update it every time you add/remove an input. In the code below I simply save the values to a list called values, you can save that to file however you'd like (RDS/text file/whatever). Then the load button looks at that list and updates every input based on the value in the list.
There is a similar idea in this thread
library(shiny)
shinyApp(
ui = fluidPage(
textInput("text", "text", ""),
selectInput("select", "select", 1:5),
uiOutput("ui"),
actionButton("save", "Save"),
actionButton("load", "Load")
),
server = function(input, output, session) {
output$ui <- renderUI({
tagList(
numericInput("num", "num", 7),
checkboxGroupInput("chk", "chk", 1:5, c(2,4))
)
})
observeEvent(input$save, {
values <<- lapply(reactiveValuesToList(input), unclass)
})
observeEvent(input$load, {
if (exists("values")) {
lapply(names(values),
function(x) session$sendInputMessage(x, list(value = values[[x]]))
)
}
})
}
)
Now with bookmarking is possible to save the state of your shinyapp. You have to put the bookmarkButton on your app and also the enableBookmarking.
The above example may not work if shiny UI involves date. Here is a minor change for date handling.
library(shiny)
shinyApp(
ui = fluidPage(
dateInput("date", "date", "2012-01-01"),
selectInput("select", "select", 1:5),
uiOutput("ui"),
actionButton("save", "Save"),
actionButton("load", "Load")
),
server = function(input, output, session) {
output$ui <- renderUI({
tagList(
numericInput("num", "num", 7),
checkboxGroupInput("chk", "chk", 1:5, c(2,4))
)
})
observeEvent(input$save, {
values <<- lapply(reactiveValuesToList(input), unclass)
})
observeEvent(input$load, {
if (exists("values")) {
lapply(names(values),
function(x) session$sendInputMessage(x, list(value = values[[x]]))
)
temp=as.character(as.Date(values$date, origin = "1970-01-01"))
updateDateInput(session, inputId="date", label ="date", value = temp)
}
})
}
)
Related
I want to take a user's input and store it as a variable that will be used in a plotting function. My code:
ui <- fluidPage(
mainPanel(
plotlyOutput("plot", width = '100%'),
br(),
textAreaInput("list", "Input List", ""),
actionButton("submit", "Submit", icon = icon("refresh"), style="float:right")
))
server <- function(input, output, session) {
my_text <<- renderText({
req(input$submit)
return(isolate(input$list))
my_text ->> subv
})
bindEvent(my_text,
output$plot <- renderPlotly({
#my very long plot code goes here which takes subv as input. This part has been tested outside of shiny and I know works.
}
I am trying to store the text in the subv variable as it will dictate what the renderPlotly will generate. When I hit submit nothing happens and the variable is only created after the session ends. The newly created subv variable in my environment does not show the text that was inputted but lists subv as an empty function i.e. subv function(...)
Below you can find a working prototype of what you would like to achieve with some information on what the issues were
First, we need to have a textOutput where our text will be shown. I understand this may not be necessary for the actual use case but it is important for this answer's demonstration purposes.
Next, we should not need to set variables to global via <<- or ->>. This is generally not good practice. Instead, we should store our result in a reactive. See also reactiveVals (but this is harder to follow when the app gets complex).
Since we need to only get the value when we click submit, we should use an event bind to only run when we click submit. This is essentially similar to eventReactive.
Finally, we can use bindCache to cache our result on the input list.
ui <- fluidPage(
mainPanel(
plotlyOutput("plot", width = '100%'),
br(),
textAreaInput("list", "Input List", ""),
actionButton("submit", "Submit", icon = icon("refresh"),
style="float:right"),
textOutput("hello_out")
))
server <- function(input, output, session) {
my_text <- reactive({
input$list
}) %>%
shiny::bindCache(input$list
) %>%
shiny::bindEvent(input$submit)
output$hello_out <- renderText({
my_text()
})
}
shinyApp(ui, server)
I have a custom bookmark URL for my shiny app. I use setBookmarkExclude() to exclude all inputs (i.e. widgets). Then I use onBookmark() to build a bookmark URL and onRestore() to restore the state.
During development, if new widgets are added, their IDs also have to be added to the setBookmarkExclude() function. If not, then the bookmark URL will change.
Is there a proper way to exclude all inputs?
Initially I tried setBookmarkExclude(names(input)) but this doesn't work since this function is called from inside the application's server function when input is not yet initialized.
Obviously, an opposite function setBookmarkInclude(NULL) would be ideal?
You have already mentioned using setBookmarkExclude(names(input)), which is the right way to go.
The key is to dynamically use setBookmarkExclude wrapped in an observer.
This is a modified version of my answer here showing how to exclude dynamically generated inputs:
library(shiny)
ui <- function(request) {
fluidPage(
br(),
bookmarkButton(id = "bookmarkBtn"),
actionButton(inputId = "addSlider", label = "Add slider..."),
hr(),
textOutput("ExcludedIDsOut"),
hr(),
sliderInput(inputId="slider1", label="My value will be bookmarked", min=0, max=10, value=5),
uiOutput("slider2")
)
}
server <- function(input, output, session) {
bookmarkingWhitelist <- c("slider1")
observeEvent(input$bookmarkBtn, {
session$doBookmark()
})
ExcludedIDs <- reactiveVal(value = NULL)
observe({
toExclude <- setdiff(names(input), bookmarkingWhitelist)
setBookmarkExclude(toExclude)
ExcludedIDs(toExclude)
})
output$ExcludedIDsOut <- renderText({
paste("ExcludedIDs:", paste(ExcludedIDs(), collapse = ", "))
})
observeEvent(input$addSlider, {
output$slider2 <- renderUI({
sliderInput(inputId="slider2", label="My value will not be bookmarked", min=0, max=10, value=5)
})
}, once = TRUE)
}
enableBookmarking(store = "url")
shinyApp(ui, server)
I have a Shiny application where I would like to add a UI element using an action button and then have that inserted ui be dynamic.
Here is my current ui file:
library(shiny)
shinyUI(fluidPage(
div(id="placeholder"),
actionButton("addLine", "Add Line")
))
and server file:
library(shiny)
shinyServer(function(input, output) {
observeEvent(input$addLine, {
num <- input$addLine
id <- paste0("ind", num)
insertUI(
selector="#placeholder",
where="beforeBegin",
ui={
fluidRow(column(3, selectInput(paste0("selected", id), label=NULL, choices=c("choice1", "choice2"))))
})
})
})
If choice1 is selected within the specific ui element, I would like to add a textInput to the row. If choice2 is selected within the ui element, I would like to add a numericInput.
While I generally understand how to create reactive values that change in response to user input, I don't know what to do here because I do not know how to observe an element that has not been created yet and that I do not know the name of. Any help would be very appreciated!
Code
This can be easily solved with modules:
library(shiny)
row_ui <- function(id) {
ns <- NS(id)
fluidRow(
column(3,
selectInput(ns("type_chooser"),
label = "Choose Type:",
choices = c("text", "numeric"))
),
column(9,
uiOutput(ns("ui_placeholder"))
)
)
}
row_server <- function(input, output, session) {
return_value <- reactive({input$inner_element})
ns <- session$ns
output$ui_placeholder <- renderUI({
type <- req(input$type_chooser)
if(type == "text") {
textInput(ns("inner_element"), "Text:")
} else if (type == "numeric") {
numericInput(ns("inner_element"), "Value:", 0)
}
})
## if we later want to do some more sophisticated logic
## we can add reactives to this list
list(return_value = return_value)
}
ui <- fluidPage(
div(id="placeholder"),
actionButton("addLine", "Add Line"),
verbatimTextOutput("out")
)
server <- function(input, output, session) {
handler <- reactiveVal(list())
observeEvent(input$addLine, {
new_id <- paste("row", input$addLine, sep = "_")
insertUI(
selector = "#placeholder",
where = "beforeBegin",
ui = row_ui(new_id)
)
handler_list <- isolate(handler())
new_handler <- callModule(row_server, new_id)
handler_list <- c(handler_list, new_handler)
names(handler_list)[length(handler_list)] <- new_id
handler(handler_list)
})
output$out <- renderPrint({
lapply(handler(), function(handle) {
handle()
})
})
}
shinyApp(ui, server)
Explanation
A module is, well, a modular piece of code, which you can reuse as often as you want without bothering about unique names, because the module takes care of that with the help of namespaces.
A module consists of 2 parts:
A UI function
A server function
They are pretty much like the normal UI and server functions, with some things to keep in mind:
namespacing: within the server you can access elements from the UI as you would do normally, i.e. for instance input$type_chooser. However, at the UI part, you have to namespace your elements, by using NS, which returns a function which you can conveniently use in the rest of the code. For this the UI function takes an argument id which can be seen as the (unique) namespace for any instance of this module. The element ids must be unique within the module and thanks to the namespace, they will be also unique in the whole app, even if you use several instances of your module.
UI: as your UI is a function, which only has one return value, you must wrap your elements in a tagList if you want to return more than one element (not needed here).
server: you need the session argument, which is otherwise optional. If you want your module to communicate with the main application, you can pass in a (reactive) argument which you can use as usual in your module. Similarly, if you want your main application to use some values from the module you should return reactives as shown in the code. If you ened to creat UI elements from your server function you also need to namespace them and you cann acces the namespacing function via session$ns as shown.
usage: to use your module you insert the UI part in your main app by calling the function with an unique id. Then you have to call callModule to make the server logic work, where you pass in the same id. The return value of this call is the returnValue of your module server function and can be sued to work with values from within the module also in the main app.
This explains modules in a nutshell. A very good tutorial which explains modules in much more detail and completeness can be found here.
You could either use insertUI() or renderUI(). insertUI() is great if you want to add multiple uis of the same kind, but i think that doesnt apply to you.
I think you either want to add a numeric or a text input not both.
Therefore, i would suggest using renderUI():
output$insUI <- renderUI({
req(input$choice)
if(input$choice == "choice1") return(fluidRow(column(3,
textInput(inputId = "text", label=NULL, "sampleText"))))
if(input$choice == "choice2") return(fluidRow(column(3,
numericInput(inputId = "text", label=NULL, 10, 1, 20))))
})
If you prefer to use insertUI() you can use:
observeEvent(input$choice, {
if(input$choice == "choice1") insUI <- fluidRow(column(3, textInput(inputId
= "text", label=NULL)))
if(input$choice == "choice2") insUI <- fluidRow(column(3,
numericInput(inputId = "text", label=NULL, 10, 1, 20)))
insertUI(
selector="#placeholderInput",
where="beforeBegin",
ui={
insUI
})
})
and on ui side: div(id="placeholderInput").
Full code reads:
library(shiny)
ui <- shinyUI(fluidPage(
div(id="placeholderChoice"),
uiOutput("insUI"),
actionButton("addLine", "Add Line")
))
server <- shinyServer(function(input, output) {
observeEvent(input$addLine, {
insertUI(
selector="#placeholderChoice",
where="beforeBegin",
ui={
fluidRow(column(3, selectInput(inputId = "choice", label=NULL,
choices=c("choice1", "choice2"))))
})
})
output$insUI <- renderUI({
req(input$choice)
if(input$choice == "choice1") return(fluidRow(column(3,
textInput(inputId = "text", label=NULL, "sampleText"))))
if(input$choice == "choice2") return(fluidRow(column(3,
numericInput(inputId = "text", label=NULL, 10, 1, 20))))
})
})
shinyApp(ui, server)
I unfortunately cannot comment on answers yet, but I think someone finding this question like me might want to know this: #thotal's answer worked for me except one line: new_handler <- callModule(row_server, new_id) gave me an error: "Warning: Error in module: unused arguments (childScope$output, childScope)"
I looked around and found this stackoverflow question, which gave the solution of basically using new_handler <- row_server(new_id).
I would need to re-use in multiple tabs of my UI an input provided in the first tab by the user.
It seems that it is not possible to do this using renderUI in the server and calling its outputs using uiOutput in my different tabs. Here is a reproducible code
ui <- pageWithSidebar(
headerPanel("Hello !"),
sidebarPanel(
tabsetPanel(
tabPanel("a",
textInput(inputId = "xyz", label = "abc", value = "abc")),
tabPanel("b", uiOutput("v.xyz"))
,tabPanel("b", uiOutput("v.xyz"))
)
),
mainPanel())
server <- function(input,output){
output$v.xyz <- renderUI({
input$xyz
})
}
runApp(list(ui=ui,server=server))
Is there another way to achieve this ?
Many thanks in advance for any suggestion.
You can't (shouldn't) have two elements with the same ID in an HTML document (whether using Shiny or not). Certainly when using Shiny having multiple elements with the same ID will be problematic. I would also subjectively vote that you could substantially improve your code by using meaningful variable names.
It's also not really clear what you want to do with this input. Do you want the input box to be displayed on multiple tabs? Or the value of the textInput to be shown on multiple tabs?
If the former, there's not an obvious way to do that, in my mind, without violating the "multiple elements with the same ID" clause. The latter would be much easier (just use a renderText and send it to a verbatimOutput), but I don't think that's what you're asking.
So what you really want is multiple text inputs (with distinct IDs) that are synchronized. That you can do in separate observers on your server using something like this:
ui <- pageWithSidebar(
headerPanel("Hello !"),
sidebarPanel(
tabsetPanel(
tabPanel("a",
textInput(inputId = "text1", label = "text1", value = "")),
tabPanel("b",
textInput(inputId = "text2", label = "text2", value = ""))
)
),
mainPanel()
)
INITIAL_VAL <- "Initial text"
server <- function(input,output, session){
# Track the current value of the textInputs. Otherwise, we'll pick up that
# the text inputs are initially empty and will start setting the other to be
# empty too, rather than setting the initial value we wanted.
cur_val <- ""
observe({
# This observer depends on text1 and updates text2 with any changes
if (cur_val != input$text1){
# Then we assume text2 hasn't yet been updated
updateTextInput(session, "text2", NULL, input$text1)
cur_val <<- input$text1
}
})
observe({
# This observer depends on text2 and updates text1 with any changes
if (cur_val != input$text2){
# Then we assume text2 hasn't yet been updated
updateTextInput(session, "text1", NULL, input$text2)
cur_val <<- input$text2
}
})
# Define the initial state of the text boxes
updateTextInput(session, "text1", NULL, INITIAL_VAL)
updateTextInput(session, "text2", NULL, INITIAL_VAL)
}
runApp(list(ui=ui,server=server))
There's probably a cleaner way to set the initial state than the cur_val I'm tracking. But I couldn't think of something off the top of my head, so there it is.
The example from Jeff Allen works only if you keep both ui and server functions in the same file. As soon as you split them into a ui.R and server.R file you will get an error complaining about the input value not existing:
Warning: Unhandled error in observer: argument is of length zero
There is an event handler available in Shiny that solves all that. It also makes it possible to handle many input widgets, as it becomes easier to extend the code to observe multiple input widget. Thanks to Jeff's example I found the following solution:
ui.R
pageWithSidebar(
headerPanel("Minimal Event Handler example"),
sidebarPanel(
tabsetPanel(
tabPanel("a",
textInput(inputId = "text1", label = "text1", value = "")),
tabPanel("b",
textInput(inputId = "text2", label = "text2", value = ""))
)
),
mainPanel()
)
server.R
function(input,output, session){
# Observe the current value of the textInputs with the Shiny Event Handler.
observeEvent(input$text1, function(){
# Observe changes in input$text1, and change text2 on event
updateTextInput(session, "text2", NULL, input$text1)
})
observeEvent(input$text2, function(){
# Observe changes in input$text2, and change text1 on event
updateTextInput(session, "text1", NULL, input$text2)
})
}
Note that ignoreNULL=TRUE by default, so this will not fail on startup.
Following up on FvD's answer, if you happen to be using uiOutput and renderUI to create UI elements, it seems that shiny does not create those elements until the appropriate tabPanel is selected, which can cause his solution to fail at the outset. (Once a user has cycled through all tabPanels with UI elements you wish to sync, everything works fine, because all UI elements have been created).
To get around this, I created a reactive variable to store the input value selected or created by the user. Then, when another tabPanel with a synched UI element is selected for the first time, the UI element is rendered with the value of this reactive variable.
As an example, I have selectInput elements on multiple panels I wish to be synched, and the choices of these elements is created when the app loads (based on whatever is present in file structure):
ui <- navbarPage("Title",
navbarMenu("Set of tabs",
tabPanel("tab1",
wellPanel(
uiOutput("selectorBin1")
)
),
tabPanel("tab2",
wellPanel(
uiOutput("selectorBin2")
)
)
)
)
server <- function(input, output, session) {
rv <- reactiveValues()
rv$selection <- " "
getChoices <- function() {
choices <- list.dirs(getwd())
return(choices)
}
output$selectorBin1 <- renderUI({
selectInput("selector1",
"Please select",
choices=getChoices(),
selected=rv$selection)
})
output$selectorBin2 <- renderUI({
selectInput("selector2",
"Please select",
choices=getChoices(),
selected=rv$selection)
})
observeEvent(input$selector1, {
rv$selection <- input$selector1 # In case this is the first tab loaded
updateSelectInput(session,
"selector2",
choices=getChoices(),
selected=rv$selection)
})
observeEvent(input$selector2, {
rv$selection <- input$selector2 # In case this is the first tab loaded
updateSelectInput(session,
"selector1",
choices=getChoices(),
selected=rv$selection)
})
}
shinyApp(ui = ui, server = server)
I would need to re-use in multiple tabs of my UI an input provided in the first tab by the user.
It seems that it is not possible to do this using renderUI in the server and calling its outputs using uiOutput in my different tabs. Here is a reproducible code
ui <- pageWithSidebar(
headerPanel("Hello !"),
sidebarPanel(
tabsetPanel(
tabPanel("a",
textInput(inputId = "xyz", label = "abc", value = "abc")),
tabPanel("b", uiOutput("v.xyz"))
,tabPanel("b", uiOutput("v.xyz"))
)
),
mainPanel())
server <- function(input,output){
output$v.xyz <- renderUI({
input$xyz
})
}
runApp(list(ui=ui,server=server))
Is there another way to achieve this ?
Many thanks in advance for any suggestion.
You can't (shouldn't) have two elements with the same ID in an HTML document (whether using Shiny or not). Certainly when using Shiny having multiple elements with the same ID will be problematic. I would also subjectively vote that you could substantially improve your code by using meaningful variable names.
It's also not really clear what you want to do with this input. Do you want the input box to be displayed on multiple tabs? Or the value of the textInput to be shown on multiple tabs?
If the former, there's not an obvious way to do that, in my mind, without violating the "multiple elements with the same ID" clause. The latter would be much easier (just use a renderText and send it to a verbatimOutput), but I don't think that's what you're asking.
So what you really want is multiple text inputs (with distinct IDs) that are synchronized. That you can do in separate observers on your server using something like this:
ui <- pageWithSidebar(
headerPanel("Hello !"),
sidebarPanel(
tabsetPanel(
tabPanel("a",
textInput(inputId = "text1", label = "text1", value = "")),
tabPanel("b",
textInput(inputId = "text2", label = "text2", value = ""))
)
),
mainPanel()
)
INITIAL_VAL <- "Initial text"
server <- function(input,output, session){
# Track the current value of the textInputs. Otherwise, we'll pick up that
# the text inputs are initially empty and will start setting the other to be
# empty too, rather than setting the initial value we wanted.
cur_val <- ""
observe({
# This observer depends on text1 and updates text2 with any changes
if (cur_val != input$text1){
# Then we assume text2 hasn't yet been updated
updateTextInput(session, "text2", NULL, input$text1)
cur_val <<- input$text1
}
})
observe({
# This observer depends on text2 and updates text1 with any changes
if (cur_val != input$text2){
# Then we assume text2 hasn't yet been updated
updateTextInput(session, "text1", NULL, input$text2)
cur_val <<- input$text2
}
})
# Define the initial state of the text boxes
updateTextInput(session, "text1", NULL, INITIAL_VAL)
updateTextInput(session, "text2", NULL, INITIAL_VAL)
}
runApp(list(ui=ui,server=server))
There's probably a cleaner way to set the initial state than the cur_val I'm tracking. But I couldn't think of something off the top of my head, so there it is.
The example from Jeff Allen works only if you keep both ui and server functions in the same file. As soon as you split them into a ui.R and server.R file you will get an error complaining about the input value not existing:
Warning: Unhandled error in observer: argument is of length zero
There is an event handler available in Shiny that solves all that. It also makes it possible to handle many input widgets, as it becomes easier to extend the code to observe multiple input widget. Thanks to Jeff's example I found the following solution:
ui.R
pageWithSidebar(
headerPanel("Minimal Event Handler example"),
sidebarPanel(
tabsetPanel(
tabPanel("a",
textInput(inputId = "text1", label = "text1", value = "")),
tabPanel("b",
textInput(inputId = "text2", label = "text2", value = ""))
)
),
mainPanel()
)
server.R
function(input,output, session){
# Observe the current value of the textInputs with the Shiny Event Handler.
observeEvent(input$text1, function(){
# Observe changes in input$text1, and change text2 on event
updateTextInput(session, "text2", NULL, input$text1)
})
observeEvent(input$text2, function(){
# Observe changes in input$text2, and change text1 on event
updateTextInput(session, "text1", NULL, input$text2)
})
}
Note that ignoreNULL=TRUE by default, so this will not fail on startup.
Following up on FvD's answer, if you happen to be using uiOutput and renderUI to create UI elements, it seems that shiny does not create those elements until the appropriate tabPanel is selected, which can cause his solution to fail at the outset. (Once a user has cycled through all tabPanels with UI elements you wish to sync, everything works fine, because all UI elements have been created).
To get around this, I created a reactive variable to store the input value selected or created by the user. Then, when another tabPanel with a synched UI element is selected for the first time, the UI element is rendered with the value of this reactive variable.
As an example, I have selectInput elements on multiple panels I wish to be synched, and the choices of these elements is created when the app loads (based on whatever is present in file structure):
ui <- navbarPage("Title",
navbarMenu("Set of tabs",
tabPanel("tab1",
wellPanel(
uiOutput("selectorBin1")
)
),
tabPanel("tab2",
wellPanel(
uiOutput("selectorBin2")
)
)
)
)
server <- function(input, output, session) {
rv <- reactiveValues()
rv$selection <- " "
getChoices <- function() {
choices <- list.dirs(getwd())
return(choices)
}
output$selectorBin1 <- renderUI({
selectInput("selector1",
"Please select",
choices=getChoices(),
selected=rv$selection)
})
output$selectorBin2 <- renderUI({
selectInput("selector2",
"Please select",
choices=getChoices(),
selected=rv$selection)
})
observeEvent(input$selector1, {
rv$selection <- input$selector1 # In case this is the first tab loaded
updateSelectInput(session,
"selector2",
choices=getChoices(),
selected=rv$selection)
})
observeEvent(input$selector2, {
rv$selection <- input$selector2 # In case this is the first tab loaded
updateSelectInput(session,
"selector1",
choices=getChoices(),
selected=rv$selection)
})
}
shinyApp(ui = ui, server = server)