Use functions or loops to create shiny UI elements - r

I am creating a shiny app and realized I am repeating a particular UI element so I am wondering if there is a way to wrap this in a function and supply parameters to make it work in different cases. In my server file, I have
output$loss <- renderUI({
req(input$got)
if(input$got %in% Years) return(numericInput('got_snow', label = 'John Snow', value = NA))
if(!input$got %in% Years) return(fluidRow(column(3)))
})
and in the ui file, I have:
splitLayout(
cellWidths = c("30%","70%"),
selectInput('got', label = 'Select age', choices = c('',Years) , selected = NULL),
uiOutput("loss")
)
Since I find myself using these several times and only changing a few things in both the UI and server files, I wanted to wrap these in a function and use them as and when I please. I tried this for the server file
ui_renderer <- function(in_put, label, id){
renderUI({
req(input[[in_put]])
if(input[[in_put]] %in% Years) return(numericInput(id, label = label, value = NA))
if(!input[[in_put]] %in% Years) return(fluidRow(column(3)))
})
}
output$p_li <- ui_renderer(input='li', "Enter age", id="c_li")
and in my ui file, I put
uiOutput('c_li')
but it's not working. Any help is greatly appreciated.

I was unable to test your code since there was no minimal working example. I don't know if this is a typo in your example, but your are trying to render c_li, but your output is called p_li. Not sure how wrapping a render object in a standard function works, but I have done something similar using reactive values instead.
This is a minimal example using some of your terminology. It is not a working example, but an outline of the idea to my proposed solution.
# Set up the UI ----
ui <- fluidPage(
uiOutput("loss")
)
# Set up the server side ----
server <- function(input, output, session) {
# Let us define reactive values for the function inputs
func <- reactiveValues(
value <- "got",
label <- "select age",
id <- "xyz"
)
# Set up an observer for when any of the reactive values change
observeEvent({
func$value
func$label
func$id
}, {
# Render a new UI any time a reactive value changes
output[["loss"]] <- renderUI(
if (input[[func$value]] %in% years) {
numericInput(func$id, label = func$label, value = NA)
} else {
fluidRow(
column(3)
)
}
)
})
}
# Combine into an app ----
shinyApp(ui = ui, server = server)
The general idea is to define a set of reactive values and set up an observer that will render the UI every time one or more of the reactive values change. You can assign a new value to any of the reactive values using direct assignment, e.g. current$value <- "object_two". Making that change will update the UI using Shiny's reactive pattern, which means you only need to change one value to update the UI.

Related

How to force evaluation in shiny render when generating dynamic number of elements?

I generate a dynamic number of valueBox in my shiny, and this number can change depending of the user input.
I managed to handle this with a renderUI where I put the wanted number of valueBoxOutput, and I have an observe that will feed them with the content using renderValueBox.
My problem is: the code in the renderValueBox, for some reason, is actually executed after the observe is finished, so because the renderValueBox is in a loop (to have a dynamic number of them) but the code is executed for all the output after the loop, all my output will get the last value of the loop.
Here is a min reprex:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
# Function
compute <- function(id)
{
print(paste("Compute ", id))
return(id)
}
# UI
ui = shinyUI(fluidPage(
titlePanel("Compare"),
useShinydashboard(),
sidebarLayout(
sidebarPanel(
numericInput("numitems", label = "Number of items", min = 1, max = 10, value = 2)
),
mainPanel(
uiOutput("boxes")
)
)
))
# Server
server = shinyServer(function(input, output, session) {
data <- reactiveValues(
ids = list()
)
output$boxes <- renderUI({
print("boxes")
box_list <- list()
id_list <- list()
for(id in 1:(input$numitems)) {
id_box <- paste0("box_", id)
print(paste("boxes - ", id_box))
id_list <- append(id_list, id_box)
box_list <- append(
box_list,
tagList(
shinydashboard::valueBoxOutput(id_box)
)
)
data$ids <- id_list
}
print("boxes end")
fluidRow(box_list)
})
observe({
print("observe")
for(id_box in data$ids) {
print(paste("observe - ", id_box))
output[[id_box]] <- shinydashboard::renderValueBox(valueBox(id_box, compute(id_box), icon = icon("circle-info"), color = "teal"))
}
print("end observe")
})
})
# Run
shinyApp(ui = ui , server = server)
Here is the result:
And the console output:
As you can see the compute (and the render in general) is done after the end of the observe function, and both output will use the last id_box that were set (so the last loop, box_2), instead of correctly using box_1 and box_2.
I tried using force, computing valueBox outside the render, using reactive lists, nothing worked, because whatever I do the render is evaluated after the observe so only the last loop values will be used no matter what.
Do anyone know a way to force execution during the loop ? Or see another way of achieving the same result ?
Why it's always after spending hald a day on a problem, looking for dozens of posts and forum, don't find anything, finally decide to ask a question... that a few minutes later I finally find an answer.
Anyway, one way to correct this (found here) is to encapsulate the render inside the local function, like this:
observe({
print("observe")
for(id_box in data$ids) {
print(paste("observe - ", id_box))
local({
tmp <- id_box
output[[tmp]] <- shinydashboard::renderValueBox(valueBox(tmp, compute(tmp), icon = icon("circle-info"), color = "teal"))
})
}
print("end observe")
})
Now the compute is still called after the end of the observe, but the tmp variable has the correct value:
The result is what I wanted:
For the record, I had already tried to use the local function, but if you don't copy the id_box inside another variable just for the local bloc, it won't work.

R Shiny: Switching datasets based on user input

I am working on a shiny app where users can upload their own data and get some plots and statistics back. However, I also want to include an example dataset that gets used instead if the user presses a specific button. Importantly, the plots should be reactive so that users get updated plots whenever they click on the "use example data instead" button or upload a new file. I tried to recreate my current approach of overwriting the data object as best as I could here, but simply defining the data object twice doesn't overwrite the data in the way I hoped it would. Any suggestions are appreciated.
library(shiny)
# UI
ui <- fluidPage(
# Application title
titlePanel("Reproducible Example"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
fileInput("Upload", "Upload your own Data"),
actionButton("Example", "Use Example Data instead")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("hist")
)
)
)
# Server Logic
server <- function(input, output) {
data <- eventReactive(input$Upload,{input$Upload})
data <- eventReactive(input$Example, {faithful$eruptions})
output$hist <- renderPlot({hist(data())})
}
# Run the application
shinyApp(ui = ui, server = server)
You can use a reactiveVal like this:
server <- function(input, output) {
my_data <- reactiveVal()
observeEvent(input$Upload, {
tmp <- read.csv(input$Upload$datapath)
## do whatever is needed to parse the data
my_data(tmp)
})
observeEvent(input$Example, {
my_data(faithful)
})
output$hist <- renderPlot({
dat <- as.data.frame(req(my_data()))
dat <- dat[, sapply(dat, is.numeric), drop = FALSE]
validate(need(NCOL(dat) > 1, "No numeric columns found in provided data"))
hist(dat[,1])
})
}
Depending on upload or button click, you store your data in my_data which is a reactive value. Whenever this value changes, the renderPlot function fires and uses the correct data.
You can use a reactive value to access whether the user has chosen to use an example dataset or use their own dataset. The user can choose to switch between the active dataset using an input from your UI.
Here's the official explanation on reactive values from RStudio: link
This would go in your ui.R:
radioButtons("sample_or_real",
label = h4("User data or sample data?"),
choices = list(
"Sample Data" = "sample",
"Upload from user data" = "user",
),
selected = "user"
)
This would go in your server.R:
data_active <- reactive({
# if user switches to internal data, switch in-app data
observeEvent(input$sample_or_real_button, {
if(input$sample_or_real == "sample"){
data_internal <- sample_data_object
} else {
data_internal <- uploaded_data_object
}
})
Note, that when using a reactive value in your server.R file, it must have parentheses () at the end of the object name. So, you call the data_internal object as data_internal().

Refer to the Updated UI Input ID and Calculate the Sum in Shiny

I would like to design a Shiny app with two buttons. Users can click the "Add UI" button as many times as they want, which will return text boxes. Users can then type numbers to the input boxes, click the "Sum" button, and calculate the total.
Below is my current code, modified from the sample code from ?insertUI. My question is I am not sure how to refer to the input id from the updated UI (in this case, the new text boxes). My current attempt cannot calculate the sum. The end result is always 0.
# Define UI
ui <- fluidPage(
actionButton("add", "Add UI"),
actionButton("sum", "Sum"),
# Report the output
h4("The total from input"),
textOutput("text")
)
# Server logic
server <- function(input, output, session) {
observeEvent(input$add, {
insertUI(
selector = "#add",
where = "afterEnd",
ui = textInput(paste0("txt", input$add),
"Insert some text")
)
})
# Calculate the total from the text inputs
output$text <- eventReactive(input$sum, {
as.character(sum(as.numeric(unlist(mget(ls(pattern = "^txt"))))))
})
}
# Complete app with UI and server components
shinyApp(ui, server)
You can use the special Shiny variable input to check and access the current inputs (and values) in your app. Thus you can get at newly inserted UI elements (assuming they all follow a pattern) and compute against them.
output$text <- eventReactive(input$sum, {
txt_inpt_names <- names(input)[grepl("^txt", names(input))]
sum(sapply(txt_inpt_names, function(x) as.numeric(input[[x]])), na.rm = T)
})
Worth noting that Shiny requires single (one-at-a-time) access to input values so thats why sapply() is required and not just input[[txt_inpt_names]].

Basic R shiny local scoping object

I want a local variable in each session that can be updated by an input, which can be used by all other functions in the server. See the simple example below, I want the object to be updated when the user changes value but it doesn't?
library(shiny)
# Define UI for application
ui = shinyUI(pageWithSidebar(
# Application title
headerPanel("Hello Shiny!"),
# Sidebar with a slider input for data type
sidebarPanel(
selectInput("data",
"Pick letter to us in complex app?", choices = c("A","B"),
selected = "A")
),
# Print letter
mainPanel(
textOutput("Print")
)
))
server =shinyServer(function(input, output) {
MYLetter = "A";
updateData = reactive({
if (input$data == "A") {
MYLetter <<- "A"
} else {
MYLetter <<- "B"
}
})
output$Print <- renderText({
print(MYLetter)
})
})
shinyApp(ui, server)
I feel a solution will be global variables, but if two people are on the app at the same time. Will one person assigning a new value to a global variable change the variable for the other user?
There's a couple problems with your code. Here is the code that you want, I tried making very minimal changes to your code in order to make it work:
ui = shinyUI(pageWithSidebar(
# Application title
headerPanel("Hello Shiny!"),
# Sidebar with a slider input for data type
sidebarPanel(
selectInput("data",
"Pick letter to us in complex app?", choices = c("A","B"),
selected = "A")
),
# Print letter
mainPanel(
textOutput("Print")
)
))
server =shinyServer(function(input, output) {
MYLetter = reactiveVal("A");
observe({
if (input$data == "A") {
MYLetter("A")
} else {
MYLetter("B")
}
})
output$Print <- renderText({
print(MYLetter())
})
})
shinyApp(ui, server)
Essentially the two problems were:
What you are looking for is creating a reactive value with reactiveVal() or reactiveValues(). You're absolutely correct that creating a global variable is not the correct solution, because then it would be shared among all the users. It also is not reactive that way.
I changed the reactive({...}) to an observe({...}). It's very important to understand the difference between a reactive and an observer. I suggest reading online about it. I changed it to an observe because you weren't returning a value that was being used - rather, you were making an assignment within it.

Shiny observer - how to use observer to update global variables?

How can I update the global variable using observer?
I have an empty species on start:
speciesChoices <- c()
But I want to add values into it when something has changed on the ui, so it becomes:
speciesChoices <- c(
'PM2.5' = 'particles'
)
Is it possible?
My code so far...
ui.r:
speciesOptions <- selectInput(
inputId = "species",
label = "Species:",
choices = c(
# 'PM2.5' = 'particles',
# 'Humidity %' = 'humidity'
)
)
server.r:
speciesChoices <- c() # global variable
# Define server logic required to draw a histogram
shinyServer(function(input, output, session) {
observe({
key <- input$streams1
stream <- fromJSON(paste(server, "/output/stream?public_key=", key, sep=""),flatten=TRUE)
species <- as.data.frame(stream$species)
# Set choices of title and code for select input.
speciesChoices <- setNames(species$code_name, species$public_name)
updateSelectInput(session, "species", choices = speciesChoices)
})
})
It only update the input on the ui but not the speciesChoices on the server.
any ideas?
Use something like speciesChoices <<- setNames(input$species$code_name, input$species$public_name). You need both the super-assign operator <<- to change a global variable, and you need to use input$_id_ to refer to inputs set in the ui.
Side note: I'm not sure what your endgame is here, but make sure that you actually want to be using an observer and not a reactive. For an idea of the difference between these, see Joe Cheng's slides from useR2016.

Resources