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.
Related
The code at the bottom is taken from an example in https://shiny.rstudio.com/articles/modules.html though I de-modularized it so I can understand something more basic. With this code, each click of the action button renders a counter which counts the number of clicks. Fine.
Instead of counting the number of clicks in the same output of verbatimTextOutput() as the code currently works, I'd like each click to be represented as a new output of verbatimTextOutput(). See illustration below which shows what I'm trying to derive, assuming the user clicks the action button 3 times. I don't know how many times the user will click the action button so there's no way to pre-set or hard-code the number of outputs and assign output names such as output$out1, output$output2, etc. Is there a way to reactively generate the outputs names, as a I naively attempted in the below code with output$"paste(out,count())" and verbatimTextOutput("paste(out,count())") (without the quote marks, I only put them in so the example code would work)? If this is possible this could be a way to achieve the results I am seeking.
Illustration:
Code:
library(shiny)
newOutput <- function(x,y){verbatimTextOutput("paste(out,count())")}
ui <- fluidPage(uiOutput("uiButton"))
server <- function(input,output,session){
count <- reactiveVal(0)
observeEvent(input$button, {count(count() + 1)})
output$"paste(out,count())" <- renderText({count()})
count
output$uiButton <-
renderUI(
tagList(
actionButton("button", label = "Click me"),
newOutput()
)
)
}
shinyApp(ui, server)
This is an alternative approach using insertUI.
Compared to #stefan's renderUI based solution it has the advantage, that the UI elements are rendered only once. Using renderUI every element is re-rendered on button click, accordingly things will slow down depending on the number of elements.
library(shiny)
ui <- fluidPage(
actionButton("add", "Add UI")
)
server <- function(input, output, session) {
observeEvent(input$add, {
output_name <- paste0("out_", input$add)
output[[output_name]] <- renderText({
isolate(input$add)
})
insertUI(
selector = ifelse(input$add == 0L, "#add", paste0("#", "out_", input$add-1)),
where = "afterEnd",
ui = verbatimTextOutput(output_name)
)
}, ignoreNULL = FALSE)
}
shinyApp(ui, server)
Also check ?removeUI.
Adapting this example to dynamically create graphs to your example you could do:
library(shiny)
library(purrr)
newOutput <- function(x) {
verbatimTextOutput(x)
}
ui <- fluidPage(
actionButton("button", label = "Click me"),
uiOutput("uiText")
)
server <- function(input, output, session) {
count <- reactiveVal(0)
observeEvent(input$button, {
count(count() + 1)
i <- count()
output_name <- paste("out", i)
output[[output_name]] <- renderText({
i
})
})
output$uiText <- renderUI({
out_list <- map(seq_len(count()), ~ {
tagList(
newOutput(paste("out", .x))
)
})
tagList(out_list)
})
}
shinyApp(ui, server)
I've created a Shiny app that works just fine but my next step is to create a module that allows other people who work with me to create apps that do the same without having to rewrite completely the code.
The main change would be on the numbers of numeric parameters that are asked as an input.
My goal was to create a module that has, as an input, a list of the parameters' name and the list of their label to create automatically numeric inputs with these names and labels.
The difficulty is that there is a numeric input that generate automatically multiple inputs for each parameter.
I've succeeded to create the UI part but I fail to get access to these inputs in the module to use them for the next part of my module.
My best try so far is :
library(shiny)
#example of list of names and labels that will be written by my colleagues
names_list <- c ("alpha","beta","gamma","delta")
labels_list <- c ("\\(\\alpha\\)","\\(\\beta\\)","\\(\\gamma\\)","\\(\\delta\\)")
parametresUI <-function(id){
ns <-NS(id)
tagList(fluidRow(numericInput(ns("nb"),label="number of steps",value=2,min=0)),
fluidRow(uiOutput(ns("parametres"))),
fluidRow(verbatimTextOutput(ns("value"))))
}
parametresServer <- function(id,names_list,labels_list){
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$parametres <-renderUI({
number_list<-as.list(1:input$nb)
div(class = "dynamicSI",
lapply(1:length(names_list),function(j){
lapply(number_list, function(i) {
fluidRow(column(3,
withMathJax(numericInput(inputId=paste0(names_list[j], i), label = paste0(labels_list[j], i),value=0,min=0)
)),
column(3,
withMathJax(numericInput(inputId=paste0("varia",names_list[j], i), label = paste0("\\(\\sigma\\)(",labels_list[j], i,")"),value=0,min=0)
)),
)
})
})
)
})
#test to see if I can access value of one numeric input : doesn't work
output$value<-renderText({
value <- input$alpha1
#or
#value <- input[[paste0(names_list[1],1)]]
value
})
})
}
ui <- fluidPage(
parametresUI("test"),
)
server <- function(input, output, session) {
parametresServer("test",names_list = names_list ,labels_list = labels_list)
}
shinyApp(ui, server)
The module is supposed to use the inputs to create simulations but I've just shown an exemple that fails to display one value
You are just missing namespace ns. Try this
parametresServer <- function(id,names_list,labels_list){
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$parametres <-renderUI({
number_list<-as.list(1:input$nb)
div(class = "dynamicSI",
lapply(1:length(names_list),function(j){
lapply(number_list, function(i) {
fluidRow(column(3,
withMathJax(numericInput(inputId=ns(paste0(names_list[j], i)), label = paste0(labels_list[j], i),value=9,min=0)
)),
column(3,
withMathJax(numericInput(inputId=ns(paste0("varia",names_list[j], i)), label = paste0("\\(\\sigma\\)(",labels_list[j], i,")"),value=0,min=0)
)),
)
})
})
)
})
#test to see if I can access value of one numeric input : doesn't work
output$value<-renderText({
value <- input$alpha1
#or
#value <- input[[paste0(names_list[1],1)]]
value
})
})
}
I am trying to create an application which dynamically creates different tabs in which there is a version of my initial table filtered according to a variable (among all those selected by the CheckboxGroupInput).
For example if I try with the table iris in which there is a variable Species taking the 3 modalities virginita, setosa and versicolor, then I would like to obtain a first tab with the observations where Species = virginita, a second where Species = setosa etc ...
I found a solution on this forum for dynamically create the tabs but in all of them, the dataset obtained is the one filtered by the last input selected (here versicolor).
I suspect a problem with lapply but I'm new on R and shiny and I can't seem to find a solution.
A little help would be appreciated !
Thanks everyone!
library(shiny)
ui <- pageWithSidebar(
headerPanel = headerPanel('iris'),
sidebarPanel = sidebarPanel(checkboxGroupInput("filter","Choices",c("virginita","setosa","versicolor"), selected=c("virginita","setosa","versicolor"))
),
mainPanel(uiOutput("my_tabs"))
)
server <- function(input, output, session) {
df = iris
output$my_tabs = renderUI({
dt <- list()
for ( i in 1:3) {
output[[paste0("tab",as.character(i))]] <- DT::renderDataTable ({
dt2 <- subset(df, Species==input$filter[i])
return(dt2)
})
dt[[i]] <- DT::DTOutput(paste0("tab",as.character(i)))
}
criteria <- input$filter
n=length(criteria)
myTabs = lapply(1:n, function(j){
tabPanel(criteria[j],
renderUI(dt[[j]])
)
})
do.call(tabsetPanel, myTabs)
})
}
runApp(list(ui = ui, server = server))
There can be problems using for loops in shiny apps:
https://chasemc.github.io/post/the-subtleties-of-shiny-reactive-programming-lapply-and-for-loops/
Instead would use lapply.
Also, I would separate your dynamic creation of output for different tabs to an observe expression (although you could put it at the top of output$my_tabs).
In addition, I noticed that virginica was misspelled in the ui. Otherwise, this includes most of your same code and seems to work.
library(shiny)
library(DT)
ui <- pageWithSidebar(
headerPanel = headerPanel('iris'),
sidebarPanel = sidebarPanel(checkboxGroupInput("filter","Choices",c("virginica","setosa","versicolor"),
selected=c("virginica","setosa","versicolor"))
),
mainPanel(uiOutput("my_tabs"))
)
server <- function(input, output, session) {
df = iris
output$my_tabs = renderUI({
myTabs = lapply(1:length(input$filter), function(i) {
tabPanel(input$filter[i],
DT::DTOutput(paste0("tab",i))
)
})
do.call(tabsetPanel, myTabs)
})
observe(
lapply(1:length(input$filter), function(i) {
output[[paste0("tab",i)]] <- DT::renderDataTable({
subset(df, Species == input$filter[i])
})
})
)
}
runApp(list(ui = ui, server = 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)
}
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).