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).
Related
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)
Here is the context :
library(shiny)
liste_statut <- c("A","B","C")
ui <- shinyUI(fluidPage(uiOutput("testUI")))
server <- function(input, output, session) {
output$testUI <- renderUI({
navbarPage(
title = "Test",
tabPanel(icon = icon("users"), 'Test',
sidebarPanel(
# Statut
checkboxGroupInput("statut", "Statut", liste_statut, liste_statut),
checkboxInput('selectall_statut', 'Tout / Aucun', T))))
})
# observe({
# updateCheckboxGroupInput(
# session, 'statut', choices = liste_statut,
# selected = if (input$selectall_statut) liste_statut
# )
# })
}
shinyApp(ui = ui, server = server)
I would like to use my checkbox All/None (in comment lines) properly cause in this case i have a "Warning: Error in if: argument is of length zero". Where should i put it or maybe should i redefine properly something in the UI part?
I willingly use the renderUI/uiOutput option (contrary to the "standard mode" ui/server) because in future, i will add an authentification module, so be able to display several "panels" according to user.
Thanks and sorry for my terrible english :).
The following works for me:
library(shiny)
liste_statut <- c("A","B","C")
ui <- shinyUI(fluidPage(uiOutput("testUI")))
server <- function(input, output, session) {
output$testUI <- renderUI({
navbarPage(
title = "Test",
tabPanel(icon = icon("users"), 'Test',
sidebarPanel(
# Statut
checkboxGroupInput("statut", "Statut", liste_statut, liste_statut),
checkboxInput('selectall_statut', 'Tout / Aucun', T))))
})
observeEvent(input$selectall_statut,{
val <- liste_statut
if(!input$selectall_statut)
val <- character(0)
updateCheckboxGroupInput(
session, 'statut',
selected = val
)
})
}
I initially tried selected = ifelse(input$selectall_statut, liste_statut, character(0)) instead of the intermediate variable val. However, ifelse() only returned a single value, not a vector.
If you are going to do this many times over, then I would recommend a custom ifelse function. Perhaps something like the following:
ifelse2 <- function(test, yes, no){
if(test)
return(yes)
return(no)
}
Here's server.r
server <- function(input, output) {
output$species <- renderUI({
selectInput("species",
label = "blah",
choices = as.list(unique(iris$Species)))
})
}
Then over in ui.r
ui <- fluidPage(
fluidRow(
uiOutput("species")
)
This works as expected, a drop down select input appears like this:
Since I have multiple features I need to create a similar filter for in my actual data frame, I tried to do the same with a function:
In server.r
outputFilters <- function(id, df) {
output$id <- renderUI({
selectInput(id,
label = "blah",
choices = as.list(unique(df$id)))
})
}
outputFilters("species", iris)
Then in ui.r same as before uiOutput("species")
However, now no drop down appears. Presumably my function is flawed. How can I use a function to generate the drop downs?
Note that you could also do without a separate function in this case, by wrapping the desired ui component in lapply, or putting the lapply within the uiOutput to create all inputs at once, below is an example for the both two cases. Hope this helps!
ibrary(shiny)
ui <- fluidPage(
uiOutput('Species'),
uiOutput('Sepal.Length'),
h2('All inputs: '),
uiOutput('my_inputs')
)
server <- function(input, output) {
# Use lapply to create multiple uiOutputs.
lapply(colnames(iris), function(x){
output[[x]] <- renderUI({
selectInput(paste0('input_',x),
label = x,
choices = as.list(unique(iris[['x']])))
})
})
# Create all dropdown's at once.
output$my_inputs <- renderUI({
lapply(colnames(iris), function(x){
selectInput(paste0('input_',x),
label = x,
choices = as.list(unique(iris)))
})
})
}
shinyApp(ui, server)
Your problem is that each UI element needs its own id in the output
outputFilters <- function(id, df) {
output[[id]] <- renderUI({
selectInput(id,
label = "blah",
choices = as.list(unique(df[[id]])))
})
}
now as long as id is a string in the function input it should generate the output element and you can refer with said id
You could then even use lapply to iterate over numerous, kind of how florian suggests.
I am using renderUI to optionally present a Table or Plot based on user selection of the visualization option. I am also using Shiny modules to present the same thing on multiple tabs. While I have gotten Shiny modules to work wonderfully in another app, I am struggling to get it to work with renderUI.
Here is a minimal piece of code that I came up with that shows the problem where nothing gets displayed on either tabs:
myUI <- function(id) {
ns <- NS(id)
fluidRow(
uiOutput(ns('myFinalText'))
)
}
ui <- fluidPage(
tabBox(id = 'myBox', width = 12,
tabPanel('Tab1',
fluidRow(
myUI('tab1')
)),
tabPanel('Tab2',
fluidRow(
myUI('tab2')
))
)
)
myTextFunc <- function(input, output, session, text) {
output$myFinalText <- renderUI({
output$myText <- renderText({text})
textOutput('myText')
})
}
server <- function(input, output, session) {
callModule(myTextFunc, 'tab1', session = session, 'Hello Tab1')
callModule(myTextFunc, 'tab2', session = session, 'Hello Tab2')
}
shinyApp(ui = ui, server = server)
Any thoughts on what else I should be doing to make this work?
Replacing the Shiny module UI function and server functions as follows makes it work fine.
myUI <- function(id) {
ns <- NS(id)
fluidRow(
textOutput(ns('myFinalText'))
)
}
myTextFunc <- function(input, output, session, text) {
output$myFinalText <- renderText({
text
})
}
You can get the namespace from the session object. Change myTextFunc in the initial app like this:
myTextFunc <- function(input, output, session, text) {
ns <- session$ns
output$myFinalText <- renderUI({
output$myText <- renderText({text})
textOutput(ns('myText'))
})
}
You shouldn't call output$ function from another output$ function - it's against Shiny design patterns.
output$myFinalText <- renderUI({
output$myText <- renderText({text})
textOutput(ns('myText'))
})
If you want to know, why it is very bad practice, watch Joe Cheng tutorial about 'Effective reactive programming' from this site: https://www.rstudio.com/resources/webinars/shiny-developer-conference/.
You should use rather reactiveValues or reactive expressions instead. What exactly you should use is dependent from what do you want to achieve, so it's hard to say without detailed example, but according to Joe Cheng everything can be accomplished without nesting outputs or observers.
Sorry for answering my own question...but for others looking for a similar solution, this may be of help.
Here is how I solved for the need to inherit Shiny module namespace on the server side to dynamically render UI. IF there is a better way to solve, please comment or post.
tab1NS <- NS('tab1')
tab2NS <- NS('tab2')
myUI <- function(ns) {
tagList(
fluidRow(
radioButtons(ns('type'), 'Select Visual:',
choices = c('Table' = 'table',
'Plot' = 'plot'))
),
fluidRow(
uiOutput(ns('myCars'))
)
)
}
ui <- fluidPage(
tabBox(id = 'myBox', width = 12,
tabPanel('Tab1',
fluidRow(
myUI(tab1NS)
)),
tabPanel('Tab2',
fluidRow(
myUI(tab2NS)
))
)
)
myTextFunc <- function(input, output, session, cars, ns) {
getMyCars <- reactive({
if (input$type == 'table') {
output$table <- renderDataTable({datatable(cars)})
dataTableOutput(ns('table'))
} else{
output$plot <- renderPlot({
plot(cars$wt, cars$mpg)
})
plotOutput(ns('plot'))
}
})
output$myCars <- renderUI({
getMyCars()
})
}
server <- function(input, output, session) {
callModule(myTextFunc, 'tab1', session = session,
mtcars[mtcars$am == 1, ], tab1NS)
callModule(myTextFunc, 'tab2', session = session,
mtcars[mtcars$am == 0, ], tab2NS)
}
shinyApp(ui = ui, server = server)
Replacing your functions with this renderUI equivalent also works:
myUI <- function(id) {
ns <- NS(id)
fluidRow(
uiOutput(ns('myFinalText'))
)
}
myTextFunc <- function(input, output, session, text) {
output$myFinalText <- renderUI({
text
})
}
Although this obviously does not capture the complexity of what you are really doing. There's something not right about using output$... and textOutput within the renderUI like that. I don't think that is necessary - you don't actually have to use the textOutput function to include text in your output.
EDIT: It occurs to me that the problem has to do with namespaces and modules. When you do output$myText <- renderText(text), the result ends up in the namespace of tab1 or tab2. For example, try changing your textOutput to
textOutput('tab1-myText')
and watch what happens. I think this is why having output$.. variables in your renderUI is problematic. You can access inputs via callModule and that should take care of any namespace issues.
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)
}
})
}
)