I've got an issue with my current shiny code.
I have to generate a dynamic number of tabs depending on the results of a given function (that part works fine). Then, I want to generate the input of these tabs in other loops of for example renderText. However, the final output of the textOutput for my generated renderText is always the one of the last renderText of the loops.
Here is a small example of the idea:
library(shiny)
library(shinydashboard)
ui <- pageWithSidebar(
headerPanel("xxx"),
sidebarPanel(),
mainPanel(
uiOutput("multipleUI")
)
)
server <- function(input, output) {
output$multipleUI <- renderUI({
tabs <- list(NULL)
for(i in 1:5){
tabs[[i]] <- tabPanel(title = paste0("tab ",i),
textOutput(paste0("out",i)), # prints j as 5 in all tabs
paste0("local out ",i)) # prints i as current loop value for each tab)
}
do.call(tabBox,tabs)
})
observe({
for(j in 1:5){
txt = paste0("generated out ", j)
print(txt) # print with current j
output[[paste0("out",j)]] <- renderText({txt})
}
})
}
shinyApp(ui, server)
While it might not be that important for renderText where I can just work around the issue, I intend to render a lot of plots and tables and couldn't think of a workaround there.
I'd appreciate any help!
EDIT: I've updated the code to show a small working example
Here's a solution that seems to work. I'm using lapply to create the tabs. Let me know if it works for what you need.
library(shiny)
ui <- pageWithSidebar(
headerPanel("xxx"),
sidebarPanel(),
mainPanel(
do.call(tabsetPanel, c(id='tab',lapply(1:5, function(i) {
tabPanel(
title=paste0('tab ', i),
textOutput(paste0('out',i))
)
})))
)
)
server <- function(input, output) {
lapply(1:5, function(j) {
output[[paste0('out',j)]] <- renderPrint({
paste0('generated out ', j)
})
})
}
shinyApp(ui, server)
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 want to insert a non predefined number of graph inside my Shiny App. I use a for loop and a series of insertUI.
Thing is when I run it, the text elements behave as expected, but the graphs are all rendering the same image. How can I prevent that?
Here's a reprex:
library(shiny)
ui <- fluidPage(
tags$div(
class = "this",
actionButton("go", "go")
)
)
server <- function(input, output, session) {
observeEvent( input$go , {
x <- reactiveValues(x = list(iris, mtcars, airquality))
for (i in 1:3){
insertUI(
".this",
ui = tagList(
p(paste("Number", i)),
renderPlot({
plot(x$x[[i]])
})
))
}
})
}
shinyApp(ui, server)
Beware closures in for loops ;). There's no block scope in R, so each for loop iteration shares the same iterator variable i. And the renderXX functions essentially store expressions that aren't evaluated immediately, but only later when it's time to render.
So by the time the plots are ready to render, the for loop is done, i is now 3, and each plot(x$x[[i]]) expression is called as plot(x$x[[3]]).
You can get around this by creating a new scope for each loop iteration using local() or a function. My favorite solution is using lapply as you've found, to run each loop iteration in a function with i as a function-scoped variable.
Many languages without block scope have this same gotcha, like Python and JS:
JavaScript closure inside loops – simple practical example
How do lexical closures work?
So, found the answer to my own question — using lapply() makes this work:
library(shiny)
ui <- fluidPage(
tags$div(
class = "this",
actionButton("go", "go")
)
)
server <- function(input, output, session) {
observeEvent( input$go , {
x <- reactiveValues(x = list(iris, mtcars, airquality))
lapply(1:3, function(i){
insertUI(
".this",
ui = tagList(
p(paste("Number", i)),
renderPlot({
plot(x$x[[i]])
})
))
})
})
}
shinyApp(ui, server)
I have a shiny app that calls a script which iterates producing a figure in each iteration. I need to show each plot and tried using recordPlot to save each plot to a list and call every element individually but the objects are not recognized later by the app. Then I also tried to include the different outputs in IF statements but my algorithm only produces the last plot for all outputs, it is like the IF statements are being ignored and I don't know howto deal whit it. Here is a simplification of my code:
library(shiny)
ui <- fluidPage(
# Main panel for displaying outputs ----
mainPanel(
actionButton("exec", "Start!!"),
tagList(tags$h4("First iteration:")),
plotOutput('PlotIter1'),
tags$hr(),
tagList(tags$h4("Second iteration:")),
plotOutput('PlotIter2'),
tags$hr(),
tagList(tags$h4("Third iteration:")),
plotOutput('PlotIter3'),
tags$hr())
)
server <- function(input, output) {
ii <- 1
observeEvent(input$exec,{
continue <- TRUE
while(continue==TRUE){
if(ii == 1){
output$PlotIter1<-renderPlot({
plot(rep(ii,50),main=ii)
})
}
if(ii == 2){
output$PlotIter2<-renderPlot({
plot(rep(ii,50),main=ii)
})
}
if(ii == 3){
output$PlotIter3<-renderPlot({
plot(rep(ii,50),main=ii)
})
}
ii <- ii+1
if(ii == 4){continue <- FALSE}
}
})
}
shinyApp(ui, server)
Edit:
By using the local() approach provided by r2evans and Gregor de Cillia the issue is partially solved, but changing the server() to one closer to mine, (replacing the IF statements for other strategy FAPP equivalent) including some calculations between each plot, the problem persist and the last data are plotted in all three plots.
server <- function(input, output) {
y=rnorm(10,20,2)
for (i in 1:3) {
local({
thisi <- i
plotname <- sprintf("PlotIter%d", thisi)
output[[plotname]] <<- renderPlot({
plot(y, main=paste0("iteration: ",thisi,", mean: ",mean(y)
))
abline(h=mean(y),col=thisi)
})
})
y=y+100
}
}
I suggest that doing it with a while (or similar) loop is missing some reactivity potential. In fact, it looks like you are trying to force order of plotting within shiny's depedency/reactivity layer.
I think there should be three separate blocks, iterating as simultaneously as R/shiny will allow:
library(shiny)
ui <- fluidPage(
# Main panel for displaying outputs ----
mainPanel(
actionButton("exec", "Start!!"),
tagList(tags$h4("First iteration:")),
plotOutput('PlotIter1'),
tags$hr(),
tagList(tags$h4("Second iteration:")),
plotOutput('PlotIter2'),
tags$hr(),
tagList(tags$h4("Third iteration:")),
plotOutput('PlotIter3'),
tags$hr()
)
)
server <- function(input, output) {
output$PlotIter1 <- renderPlot({
plot(rep(1,50),main=1)
})
output$PlotIter2 <- renderPlot({
plot(rep(2,50),main=2)
})
output$PlotIter3 <- renderPlot({
plot(rep(3,50),main=3)
})
}
shinyApp(ui, server)
I'll go one step further in my inference, though, that you really aren't interested in just 1-3 with this plot; perhaps you want to do it programmatically? (I had to look this up, because I asked a very similar question several years ago, and received a good workaround from jcheng5 (one of the main authors of shiny).
server <- function(input, output) {
for (i in 1:3) {
local({
thisi <- i
plotname <- sprintf("PlotIter%d", thisi)
output[[plotname]] <<- renderPlot({
plot(rep(thisi, 50), main=thisi)
})
})
}
}
This method only works, of course, if the plots are relatively identical with small changes. Otherwise, the first version up above might be more appropriate.
There are actually several problems you might run into when using renderXXX, reactive or observe inside loops because of lazy evaluation. From my experience, the cleanest workaround is to use lapply and loop over shiny modules like so
## context server.R
lapply(1:n, function(i) { callModule(myModule, id = NS("myModule", i), moduleParam = i) })
## context: ui.R
lapply(1:n, function(i) { myModuleUI(id = NS("myModule, i), param = i)
For your case however, a quicker fix would be to just use local as suggested in the first answer here. Notice that the ii <- ii part is necesary for this to work since it "localizes" the variable ii.
library(shiny)
ui <- fluidPage(
# Main panel for displaying outputs ----
mainPanel(
actionButton("exec", "Start!!"),
tagList(tags$h4("First iteration:")),
plotOutput('PlotIter1'),
tags$hr(),
tagList(tags$h4("Second iteration:")),
plotOutput('PlotIter2'),
tags$hr(),
tagList(tags$h4("Third iteration:")),
plotOutput('PlotIter3'),
tags$hr())
)
server <- function(input, output) {
ii <- 1
observeEvent(input$exec,{
continue <- TRUE
while(continue==TRUE){
local({
ii <- ii
if(ii == 1){
output$PlotIter1<-renderPlot({
plot(rep(ii,50),main=ii)
})
}
if(ii == 2){
output$PlotIter2<-renderPlot({
plot(rep(ii,50),main=ii)
})
}
if(ii == 3){
output$PlotIter3<-renderPlot({
plot(rep(ii,50),main=ii)
})
}
})
ii <- ii+1
if(ii == 4){continue <- FALSE}
}
})
}
shinyApp(ui, server)
Here is a demonstration of the modularized approach
myModule <- function(input, output, session, moduleParam) {
output$PlotIter <- renderPlot({
plot(rep(moduleParam, 50), main = moduleParam)
})
}
myModuleUI <- function(id, moduleParam) {
ns <- NS(id)
tagList(
tags$h4(paste0("iteration ", moduleParam, ":")),
plotOutput(ns('PlotIter')),
tags$hr()
)
}
shinyApp(
fluidPage(
actionButton("exec", "Start!!"),
lapply(1:4, function(i) {myModuleUI(NS("myModule", i), i)})
),
function(input, output, session) {
observeEvent(
input$exec,
lapply(1:4, function(i) {callModule(myModule, NS("myModule", i), i)})
)
}
)
Sidenote: If you want to capture several plots from the same script, you can use evaluate::evaluate for that
library(evaluate)
plotList <- list()
i <- 0
evaluate(
function() {
source("path/to/script.R")
},
output_handler = output_handler(
graphics = function(plot) {
i <- i + 1
plotList[[i]] <- plot
}
)
)
For somebody in the future, the solution that I finally came with, was changing the data structure to a list in which the result of every iteration is stored, after that, every element in the list are plotted to the corresponding render plot inside a for cycle. Naturally, it couldn´t be possible whithout the very important things that r2evans and Gregor de Cecilia pointed out. So, this approach gives the following server.R function:
server <- function(input, output){
y <- list()
#First data set
y[[1]] <- rnorm(10,20,2)
#Simple example of iteration results storage in the list simulating an iteration like procces
for(i in 2:3){
y[[i]]=y[[i-1]]+100
}
#Plots of every result
for(j in 1:3){
local({
thisi <- j
plotname <- sprintf("PlotIter%d", thisi)
output[[plotname]] <<- renderPlot({
plot(y[[thisi]], main=paste0("Iteration: ",thisi,", mean: ",round(mean(y[[thisi]]),2)
))
abline(h=mean(y[[thisi]]),col=thisi)
})
})
}
}
Here is a simple demo of the problem:
library(shiny)
ui <- fluidPage(
textOutput("Text1"),
textOutput("Text2")
)
server <- function(input, output) {
for(i in 1:2) {
id <- paste0("Text", i)
output[[id]] <- renderText(paste0("This is text #", i)) # Problem!
}
}
shinyApp(ui, server)
This program produces output
This is text #2
This is text #2
rather then #1 and #2.
Evidently, Shiny stores the expressions passed to renderText() in the line marked # Problem!, and evaluates them after the for-loop is finished. The expressions depend on variable i, and its final value i = 2 is used in evaluating both expressions.
How can I produce correct output (how can I force Shiny to use different values of i in different expressions), while still using the loop? In my code the loop limits are dynamic, and I cannot replace the loop with several static calls.
Why the for-loop does not work, check the output of this example:
library(shiny)
ui <- fluidPage(
textOutput("Text1"),
textOutput("Text2")
)
server <- function(input, output) {
for(i in 1:3) {
id <- paste0("Text", i)
output[[id]] <- renderText(paste0("This is text #", i)) # Problem!
}
i=10 # we set i to 10.
}
shinyApp(ui, server)
As you can see, all renderText elements use the last (global) value for i. This is not the case in the lapply, where an argument is passed to the function, but that argument is not defined in the global environment.
So you could use lapply instead of a for-loop, like this:
library(shiny)
ui <- fluidPage(
textOutput("Text1"),
textOutput("Text2")
)
server <- function(input, output) {
lapply(1:2,function(i){
id <- paste0("Text", i)
output[[id]] <- renderText(paste0("This is text #", i)) # Problem!
})
}
shinyApp(ui, server)
Output:
If you also want the ui to be reactive, you could use renderUI and uiOutput, for example as follows:
library(shiny)
ui <- fluidPage(
numericInput("number_of_text","Number of text",min=1,max=10,value=3),
uiOutput('my_text')
)
server <- function(input, output) {
reactive_text <- reactive({
all_text <- lapply(1:input$number_of_text,function(i){
id <- paste0("Text", i)
renderText(paste0("This is text #", i)) # Problem!
})
# do.call(all_text,tagList)
})
output$my_text <- renderUI({
do.call(fluidRow, reactive_text())
})
}
shinyApp(ui, server)
Output:
Hope this helps!
I'm trying to create an dynamic amount of datatables inside a tabsetPanel argument. Thanks to various different posts here I came to this 'not working solution'.
The tables are rendered and accesed correctly but the tabsetPanel fails to create and I'm wondering how I can make this work, any help appreciated:
library(DT)
# for simplification this is not dynamic but created without hardcoded variable calls.
portalData <- lapply(1:10,function(x)data.frame(rnorm(5,1))
names(portalData) <- 1:10
shinyApp(
ui = pageWithSidebar(
headerPanel("Dynamic number of tables inside tabpanels"),
sidebarPanel(
),
mainPanel(
uiOutput("tables")
)
),
server = function(input, output) {
observe({
output$tables <- renderUI({
names_list <- lapply(seq_along(portalData), function(i){
tablename <- paste(names(portalData)[i])
tabPanel(dataTableOutput(tablename))
})
do.call(tabsetPanel,do.call(tagList, names_list))
})
for(i in 1:length(portalData)){
local({
i2 <- i
output[[names(portalData)[i2]]] <- renderDataTable({portalData[[i2]]})
})
}
})
})