In shiny, how do you use tagList inside renderUI to create multiple widgets customized with data from an uploaded file? This idea is referenced here, but there doesn't appear to be very good documentation for tagList.
I plan to answer my own question here. I did a bit of research, found that a simple example of this process was lacking, and felt a desire to contribute it so that others might benefit.
In server.R, define an object using a reactive() statement to hold the contents of the uploaded file. Then, in a renderUI statement, wrap a comma-delimited list of widget definitions in a tagList function. In each widget, use the object holding the contents of the uploaded file for the widget parameters. The example below, hosted at shinyapps.io and available on github, creates a checkBoxGroupInput and a radioButtons widget using a singer renderUI that is defined based on an uploaded file.
server.R
library(shiny)
shinyServer(function(input, output) {
ItemList = reactive(
if(is.null(input$CheckListFile)){return()
} else {d2 = read.csv(input$CheckListFile$datapath)
return(as.character(d2[,1]))}
)
output$CustomCheckList <- renderUI({
if(is.null(ItemList())){return ()
} else tagList(
checkboxGroupInput(inputId = "SelectItems",
label = "Which items would you like to select?",
choices = ItemList()),
radioButtons("RadioItems",
label = "Pick One",
choices = ItemList(),
selected = 1)
)
})
})
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Create a checkboxGroupInput and a RadioButtons widget from a CSV"),
sidebarLayout(
sidebarPanel(fileInput(inputId = "CheckListFile", label = "Upload list of options")),
mainPanel(uiOutput("CustomCheckList")
)
)
))
Related
Question
In R Shiny, when using
renderUI
uiOutput
to dynamically generate sets of controls, such as:
checkboxes
radiobuttons
text boxes
how can I harvest those values or populate input by causing events?
As-is, those generated controls appear to be "display only". Making a selection, marking a checkbox, or entering data only updates the display, but no Event is created and the values are not populated into the "input" variable ( ReactiveValues ); thus, nothing is received by the Shiny server process.
If these control inputs are in-fact isolated, it completely undermines the point of dynamically creating controls.
Obviously, I'm hoping that this issue has been addressed, but my searches haven't turned it up.
In my specific case, the UI allows the user to:
Select and upload a CSV file.
The logic identifies numerical, date, and grouping columns, and produces 3 sets of radiobutton control sets. The idea is that you pick which columns you are interested in.
Picking a grouping column SHOULD return that columnID back to the server, where it will display a discrete list of groups from which to select. This fails, as the selections do not generate an Event, and the input variable (provided to server.R) only contains the ReactiveValues from the static controls.
That said, the display of the controls looks fine.
Step#0 screenshot:
Step#1 screenshot:
On the server.R side, I'm using code as below to create the radioButtons.
output$radioChoices <- reactive({
...
inputGroup <- renderUI({
input_list <- tagList(
radioButtons(inputId = "choiceGrp", label = "Available Grouping Columns", choices = grpColumnNames, inline = TRUE, selected = selectedGrp),
radioButtons(inputId = "choiceNumb",label = "Available Numerical Columns",choices = numColumnNames, inline = TRUE, selected = selectedNum),
radioButtons(inputId = "choiceDate",label = "Available Date Columns", choices = dateColumnNames, inline = TRUE, selected = selectedDate),
hr()
)
do.call(tagList, input_list)
})
print(inputGroup)
output$radioChoices <- inputGroup
})
I have played around with a Submit button and ActionButtons to try and force an Event, but no dice. My skull-storming is now going to places like "do I need to somehow use Javascript here?"
Many thanks to all of you who are lending me your cycles on this matter.
I'm not sure I understand your problem. Here's a MWE that accesses the value of a widget created by uiOutput/renderUI. The values of widgets created by uiOutput/renderUIcan be accessed just like those of any other widget.
If this doesn't give you what you want, please provide more details.
library(shiny)
ui <-
fluidPage(
uiOutput("dataInput"),
textOutput("result")
)
server <- function(input, output, session) {
output$dataInput <- renderUI({
selectInput("beatles", "Who's your favourite Beatle?", choices=c("- Select one -"="", "John", "Paul", "George", "Ringo"))
})
output$result <- renderText({
req(input$beatles)
paste0("You chose ", input$beatles)
})
}
shinyApp(ui, server)
Description
I have a textAreaInput box that I want to start with a default value. The user can click 2 actionButtons (Submit & Random Comment). Submit updates the comment from the textAreaInput for further processing (plot, etc.) while Random Comment sends a new random value to textAreaInput (the user may type in the textAreaInput box as well). I almost have it but can't get the app to update textAreaInput's value until the Submit button is pressed.
Question
I want it to be updated when Random Comment is pressed but still allow the user to erase the text box and type their own text. How can I make the app do this?
MWE
library(shiny)
library(shinyjs)
library(stringi)
shinyApp(
ui = fluidPage(
column(2,
uiOutput("randcomment"),
br(),
div(
actionButton("randtext", "Random Comment", icon = icon("quote-right")),
div(actionButton("submit", "Submit", icon = icon("refresh")), style="float:right")
)
),
column(4, div(verbatimTextOutput("commenttext"), style = 'margin-top: 2cm;'))
),
server = function(input, output) {
output$randcomment <- renderUI({
commentUi()
})
comment_value <- reactiveValues(default = 0)
observeEvent(input$submit,{
comment_value$default <- input$randtext
})
renderText(input$randtext)
commentUi <- reactive({
if (comment_value$default == 0) {
com <- stri_rand_lipsum(1)
} else {
com <- stri_rand_lipsum(1)
}
textAreaInput("comment", label = h3("Enter Course Comment"),
value = com, height = '300px', width = '300px')
})
output$commenttext <- renderText({ input$comment })
}
)
I'd approach this a little bit differently. I would use reactiveValues to populate both of the fields, and then use two observeEvents to control the contents of the reactiveValues.
I don't think you need a reactive at all in this situation. reactive is good when you want immediate processing. If you want to maintain control over when the value is processed, use reactiveValues.
library(shiny)
library(shinyjs)
library(stringi)
shinyApp(
ui = fluidPage(
column(2,
uiOutput("randcomment"),
br(),
div(
actionButton("randtext", "Random Comment", icon = icon("quote-right")),
div(actionButton("submit", "Submit", icon = icon("refresh")), style="float:right")
)
),
column(4, div(verbatimTextOutput("commenttext"), style = 'margin-top: 2cm;'))
),
server = function(input, output) {
# Reactive lists -------------------------------------------------------
# setting the initial value of each to the same value.
initial_string <- stri_rand_lipsum(1)
comment_value <- reactiveValues(comment = initial_string,
submit = initial_string)
# Event observers ----------------------------------------------------
observeEvent(input$randtext,
{
comment_value$comment <- stri_rand_lipsum(1)
}
)
# This prevents the comment_value$submit from changing until the
# Submit button is clicked. It changes to the value of the input
# box, which is updated to a random value when the Random Comment
# button is clicked.
observeEvent(input$submit,
{
comment_value$submit <- input$comment
}
)
# Output Components -------------------------------------------------
# Generate the textAreaInput
output$randcomment <- renderUI({
textAreaInput("comment",
label = h3("Enter Course Comment"),
value = comment_value$comment,
height = '300px',
width = '300px')
})
# Generate the submitted text display
output$commenttext <-
renderText({
comment_value$submit
})
}
)
Some comments on your code
I struggled a little with determining what your code was doing. Part of the reason was that your server function was organized a bit chaotically. Your components are
output
reactive list
observer
output (but not assigned to a slot...superfluous)
reactive object
output
I'd recommend grouping your reactives together, your observers together, and your outputs together. If you have truly separate systems, you can break the systems into different sections of code, but have them follow a similar pattern (I would claim that these two boxes are part of the same system)
Your commentUi reactive has a strange if-else construction. It always sets com to a random string. What's more, the if-else construction isn't really necessary because no where in your code do you ever update comment_value$default--it is always 0. It looks like you may have been trying to base this off of an action button at some point, and then concluded (rightly) that that wasn't a great option.
Also, I would advise against building UI components in your reactive objects. You'll find your reactives are much more flexible and useful if they return values and then build any UI components within the render family of functions.
I am trying to reactively display an image from a list in an R shiny application.
I have many .tiff images stored in the "www" directory of my app. They follow the naming convention OHC_130.tiff, OHC_131.tiff, OHC_132.tiff, IHC_133.tiff, Deiter_134.tiff, OHC_135.tiff etc...
I also have a vector containing all of these names
ImgID_Vector <- as.vector(c("OHC_130", "OHC_131", "OHC_132", "IHC_133", "Deiter_134", "OHC_135")
I would like to make a selectable input dropdown list like this where a user can select an image and then click the submit button to make the image appear below. I have set this up for the ui.r but i am not sure how to make it work on the server side.
#ui.r
library(shiny)
library(shinydashboard)
dashboardBody(
tabItems(
tabItem(tabName = "dt",
h2("Select an image"),
fluidRow(
box(title="This is a searchable database of images", solidHeader = TRUE,status = "primary"),
selectInput("input$ImageIDVariable1", label = h4("Enter your image of interest"), choices = (ImgID_Vector), multiple = TRUE),
submitButton("Submit"),
imageOutput("ImageID_Image")
)
)
)
Conceptually I know that on the server side I need to connect the user input from the UI side to the actual image in the "www" folder. I should be able to do this using reactive inputs and renderImage I think. But I am not sure how to write the render image command to achieve the desired result.
#server.r
#This is the data that contains the choices for the dropdown menu
ImgID_Vector <- readRDS("ImgID_Vector.RDS")
shinyServer(function(input, output) {
# This is where I am struggling, with the render image command
output$ImageID_Image <- renderImage({
filename <- normalizePath(file.path('./www',
paste(input$ImageIDVariable1, '.tiff', sep='')))
list(src = filename)
}, deleteFile = FALSE)
}
#This is where I have the reactive input variable
ImageIDVariable1 <- reactive({input$ImageIDVariable1})
})
Thanks for your help!
Hi argument inputId from your selectInput is wrong, it should be "ImageIDVariable1", not input$ImageIDVariable1.
In ui.R :
selectInput(inputId = "ImageIDVariable1", label = h4("Enter your image of interest")
In server.R
input$ImageIDVariable1
Moreover :
You should use this in a script called global.R or at least in ui.R :
ImgID_Vector <- readRDS("ImgID_Vector.RDS")
And you should not use multiple = TRUE because renderImage can only render one image at a time.
And you should put a selected choice by default, if not renderImage will search an image which doesn't exist.
I am trying to separate the functionality of my Shiny application in order to make it reusable.
I have my ui. R file where I define :
tabPanel("Unemployed", source("unemployed_select.R", local=TRUE)$value),
and in my unemployed_select.R I define:
fluidPage(
titlePanel("Basic DataTable"),
# Create a new Row in the UI for selectInputs
fluidRow(
column(4,
selectInput("man",
"Manufacturer:",
c("All",
unique(as.character(mpg$manufacturer))))
),
column(4,
selectInput("trans",
"Transmission:",
c("All",
unique(as.character(mpg$trans))))
),
column(4,
selectInput("cyl",
"Cylinders:",
c("All",
unique(as.character(mpg$cyl))))
)
),
# Create a new row for the table.
fluidRow(
DT::dataTableOutput("table")
)
)
My server.R file is :
library(shiny)
library(shinythemes)
library(dataset)
shinyServer(function(input, output) {
# Filter data based on selections
output$table <- DT::renderDataTable(DT::datatable({
data <- mpg
if (input$man != "All") {
data <- data[data$manufacturer == input$man,]
}
if (input$cyl != "All") {
data <- data[data$cyl == input$cyl,]
}
if (input$trans != "All") {
data <- data[data$trans == input$trans,]
}
data
}))
})
I used the code from a well-known example in R gallery https://shiny.rstudio.com/gallery/basic-datatable.html
just to be sure that have no problems of data. Still datatable is not rendering so I guess it has to be a problem with defining inside source file unemployed_select.R.
Any ideas?
Regards
You are right that you need to use source() to load your module file, but with Shiny, you need to be aware of namespaces. The module and the file it is sourced in must share a namespace, wherein names for things are shared. For example, in your module code, you have this line:
column(4,
selectInput("man",
"Manufacturer:",
c("All",
unique(as.character(mpg$manufacturer))))
But you want the module to share the namespace of the file it is included in, so you need to have a way to let the file, which is including the module, know which parts are ids, like "man" and which parts are serious arguments like "Manufacturer:"
So in a Shiny Module, that line would become
column(4,
selectInput(ns("man"),
"Manufacturer:",
c("All",
unique(as.character(mpg$manufacturer))))
Here the ns() function is used to include the id in the namespace, this will allow your declared id "man" to be usable by the rest of the app.
There is a great guide to namespaces and writing modules in Shiny here:
https://shiny.rstudio.com/articles/modules.html
The link above points out that you must namespace ids, must make your module fit into a function and call that function using callModule() from your ui.R file, and must wrap everything in a tagList instead of a fluidPage.
Best of luck!
This is my day one with R shiny and I'm trying to figure out the following question: assuming that I have a root directory like
/usr/data/
This directory might contain some folders (A,B,C,...) where each folder has contains some files (no folders within them and just files). I am planning to create a dropdown menue based on another dropdown menu. The use select a folder name from the list and the second dropdown menu is automatically loaded with the file names within that folder. For example if folder A is selected and it contains File1 and File2 then the second dropdown will contain those two. This is how I'm doing it right now:
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("This is a test app"),
sidebarLayout(
sidebarPanel(
uiOutput("Box1"),
uiOutput("Box2")
),
mainPanel("Display results",
tableOutput("view"))
)
))
server.R
library(shiny)
biz = data.frame(
Folder = c("A", "A", "B" , "B"),
Filename = c("File1","File2","File3","File4"),
stringsAsFactors = FALSE
)
shinyServer(function(input, output) {
output$Box1 = renderUI(selectInput("folder","Select directory",c("None",unique(biz$Folder)),"None"))
output$Box2 = renderUI(
if (is.null(input$folder) || input$folder == "None"){return()
}else selectInput("filename",
"Select dataset",
c("None",unique(biz$Filename[which(biz$Folder == input$folder)])),
"None")
)
subdata1 = reactive(biz[which(biz$Folder == input$folder),])
subdata2 = reactive(subdata1()[which(subdata1()$Filename == input$filename),])
output$view = renderTable({
if(is.null(input$folder) || is.null(input$filename)){return()
} else if (input$folder == "None" || input$filename == "None"){return()
} else return(subdata2())
})
})
As you can see, I'm using a dataframe to take care of that but this should better be dynamic in case that the content of those folders change. So I think the best way is to have list of folder names and then get the contents of that folder and load them in to the second dropdown. I have tried several posts on SO but they are mostly about the content of a csv file and so on. Any help would be much appreciated.
Thanks
I recommend generating UI elements reactively in the following way:
ui.R
library(shiny)
shinyUI(fluidPage(
titlePanel("My Great File Selector"),
fluidRow(
sidebarPanel(
uiOutput("select.folder"),
uiOutput('select.file')
)
)
))
server.R
library(shiny)
shinyServer(function(input, output) {
root <- '~'
output$select.folder <-
renderUI(expr = selectInput(inputId = 'folder.name',
label = 'Folder Name',
choices = list.dirs(path = root,
full.names = FALSE,
recursive = FALSE)))
output$select.file <-
renderUI(expr = selectInput(inputId = 'file.name',
label = 'File Name',
choices = list.files(path = file.path(root,
input$folder.name))))
})
All I have done in ui.R is essentially promise that I will render two UI elements named 'select.folder' and 'select.file' in server.R. That's pretty simple.
In server.R, I specify root, where I want the app to look for directories.
I use renderUI() to generate a UI element in which the user will select the folder and store it in output$select.folder, fulfilling my first promise in ui.R, give it a label of 'Folder Name', and set its choices to the result of list.dirs() (from base R) called with the appropriate arguments. The choice that the user has selected in this UI element will be accessible via input$folder.name because the InputId is 'folder.name'.
I use renderUI() again to generate a UI element that will be used to select a file in that folder and store it in output$select.file, fulfilling my second promise from ui.R. Its choices are based on a call to list.files that uses the folder selected in the first UI element, retrieving it via `input$folder.name'.
You can get the names of the files in a folder with the list.files function.
So something like this should work:
ROOT <- '/usr/data'
dropdown_options <- list.files(paste(ROOT, input$folder, sep = '/'))