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)
Related
In my shiny-app I use pop-up boxes to allow the user to quickly look up data in a table. That works well using showModal, however currently I'm creating some module servers and there I run into issues. What I understood, is that the id in a module ui needs to be defined using ns (as is done below for the action button).
However, my data table inside the pop-up box is defined inside the moduleServer. If I use ns("my_database") there, I get the message that ns is not a recognized function.
How can I get that table to show inside my pop-up box, embedded in a moduleServer?
library(shiny)
dataPage <- function(id, label = "Counter") {
ns <- NS(id)
tagList(
column(12,
h1("Testing my database pop up"),
actionButton(ns("show_database"), "Show my database")
)
)
}
dataServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
observeEvent(input$show_database, { # Pop-up box, currently for testing purposes
showModal(modalDialog(
title = "My database",
"My database",
dataTableOutput("my_database"),
easyClose = TRUE,
footer = NULL
))
})
output$my_database <- renderDataTable({
temp <- data.frame(a = seq(1,10), b = letters[1:10])
temp
})
}
)
}
ui <- fluidPage(
dataPage("data1", "Counter #1")
)
server <- function(input, output, session) {
dataServer("data1")
}
shinyApp(ui, server)
I am trying to capture the url that has been selected when a person presses the "GET URLS" button on the app.
What should happen is that the event reactive() should look at the input$go_button and see that it has been pressed - it should then perform the expression to take the chosen url from the select input- unfortunately it does nothing.
I have tried debugging with browser() but still had no affect.
All i am trying to do is capture the url that has been selected when a person "presses" the "GET URLS" button.
my sample code is below:
library(shiny)
# Use a fluid Bootstrap layout
ui <- fluidPage(
# Give the page a title
titlePanel("testing select"),
# Generate a row with a sidebar
sidebarLayout(
# Define the sidebar with one input
sidebarPanel(
selectInput("url_selection", "select url:",
choices = c(
'/multi-task/',
"/personal-account",
"/paperless"
)
),
actionButton(inputId = "go_button", label = "Get URLS")
),
# Create a spot for the barplot
mainPanel(
textOutput(outputId = "urls_selected_print")
)
)
)
server <- function(input, output) {
url_capture <- reactive({eventReactive(eventExpr = input$go_button,
valueExpr = {
message("capturing url chosen in selectize input")
chosen_url <- input$url_selection
browser()
return(chosen_url)
})
})
}
shinyApp(ui, server)
You can use observeEvent to capture event when go_button has been pressed. You can store the selection in a reactiveVal which can be displayed in your output.
server <- function(input, output) {
rv <- reactiveVal(NULL)
observeEvent(input$go_button, {
message("capturing url chosen in selectize input")
rv(input$url_selection)
})
output$urls_selected_print <- renderText({rv()})
}
Small alternative to Ben's answer (you just have to remove reactive, because eventReactive is already reactive):
server <- function(input, output) {
url_capture <- eventReactive(eventExpr = input$go_button,
valueExpr = {
message("capturing url chosen in selectize input")
chosen_url <- input$url_selection
return(chosen_url)
})
output$urls_selected_print <- renderPrint({
url_capture()
})
}
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 have a code that allows to dynamically add modules in a Shiny app. This module is composed of a selectInput and can be added by clicking on the "Add filter" Button.
What I try to do is to put text at the right of each selectInput widget which value update when the user click on the perform Button and is equal to the selection on the selectInput
I don't know how to do. Many tries were unsuccessfull...
The code is the following :
library(shiny)
moduleFilterUI <- function(id) {
ns <- NS(id)
uiOutput(ns("SymbolicFilter"))
}
moduleSymbolicFilter <- function(input, output, session) {
output$SymbolicFilter <- renderUI({
fluidRow(
column(width = 4, selectInput(session$ns("cname"), "Column name", choices = c(1:5)))
)
})
}
ui <- fluidPage(
fluidRow(
actionButton("addSymbolicFilterModule", "Add filter"),
actionButton("Filter", "Perform"),
uiOutput("symbolicFilters"))
)
)
server <- function(input, output, session) {
symbolicFilterModules <- list()
makeReactiveBinding("symbolicFilterModules")
observeEvent(input$addSymbolicFilterModule, {
duplicateSymbolicFilterid <- paste0("duplicateSymbolicFilter", input$addSymbolicFilterModule)
symbolicFilterModules <<- c(symbolicFilterModules, list(moduleSymbolicFilterUI(duplicateSymbolicFilterid)))
callModule(moduleSymbolicFilter, duplicateSymbolicFilterid)
shinyjs::disable("addSymbolicFilterModule")
iLast <- length(symbolicFilterModules)
for (i in 1:(iLast-1)){
duplicateSymbolicFilterid <- paste0("duplicateSymbolicFilter", i)
updateSelectInput(session, paste0(duplicateSymbolicFilterid,"-cname"),
selected=input[[paste0(duplicateSymbolicFilterid,"-cname")]])
}
})
observeEvent(input$Filter,{
shinyjs::enable("addSymbolicFilterModule")
iLast <- length(symbolicFilterModules)
duplicateSymbolicFilterid <- paste0("duplicateSymbolicFilter", iLast)
cname <- input[[paste0(duplicateSymbolicFilterid,"-cname")]]
for (i in 1:(iLast)){
duplicateSymbolicFilterid <- paste0("duplicateSymbolicFilter", i)
updateSelectInput(session, paste0(duplicateSymbolicFilterid,"-cname"),
selected=input[[paste0(duplicateSymbolicFilterid,"-cname")]])
}
})
output$symbolicFilters <- renderUI({
symbolicFilterModules
})
}
shinyApp(ui = ui, server = server)
maybe you had already solved the problem, but...
you named the module moduleFilterUI, but you call moduleSymbolicFilterUI...
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)
}
})
}
)