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!
Related
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)
})
})
}
}
I think I'm missing something with respect to reactives in my Shiny app. Here's a MRE that shows my problem printing y.
library(shiny)
ui <- fluidPage(
titlePanel("Test"),
textAreaInput("text", "Text", "", width = "400px"),
verbatimTextOutput("text"),
actionButton("do", "Run"),
textOutput("result")
)
server <- function(input, output) {
observeEvent(input$do, {
y <- reactive({
x <- ""
t <- 1
while (t < 5) {
x <- paste(input$text, x, sep=",")
t <- t + 1
}
})
})
output$result <- renderPrint({y})
}
shinyApp(ui = ui, server = server)
You shouldn't put a reactive value inside of an observeEvent or observe call. In fact, it has been advised by Joe Cheng to never nest either observe or reactive functions within either themselves or the other. They are separate things used for different purposes. Since you want the reactive y to be created based on when input$do is clicked, you should use eventReactive:
server <- function(input, output) {
y <- eventReactive(input$do, {
x <- ""
t <- 1
while (t < 5) {
x <- paste(input$text, x, sep=",")
t <- t + 1
}
return(x)
})
output$result <- renderText({y()})
}
I changed renderPrint() to renderText() so that it displays your desired output. Also, since y is a reactive, you need to add y() after it in the renderText() call. I also added return(x) to the eventReactive call, otherwise t would be the value returned.
I the problem is that your call to reactive() does not return anything. Wrapping an expression inside reactive assigns the return value of the expression to a variable each time a reactive value inside the expression is changed. Reactive values are usually all input$... variables, and those that you store in reactiveValues() objects.
If I get you right you want to change and print y every time the "run" button is hit. Save this to a reactiveValue() collection (similarly accessible like a list), and then put this inside your renderPrint function.
From your code I reckon that you want y to be the value of x after the while loop.
library(shiny)
ui <- fluidPage(
titlePanel("Test"),
textAreaInput("text", "Text", "", width = "400px"),
verbatimTextOutput("text"),
actionButton("do", "Run"),
textOutput("result")
)
server <- function(input, output) {
values <- reactiveValues()
observeEvent(input$do, {
x <- ""
t <- 1
while (t < 5) {
x <- paste(input$text, x, sep=",")
t <- t + 1
}
values$y <- x
})
output$result <- renderPrint({values$y})
}
shinyApp(ui = ui, server = server)
I'd like to output several tables as a one uiOutput. If I put them together in a list using a loop then all outputs are equal to the last one.
Example:
library(shiny)
ui <- fluidPage(
mainPanel(
uiOutput("tables")
)
)
server <- function(input, output) {
output$tables <- renderUI({
data=array(rnorm(150),c(10,5,3))
tfc = function(m){
# x = m[1,1]
renderTable({m})
}
result=list()
for(i in 1:3)
result[[i]] = tfc(data[,,i])
return(result)
})
}
shinyApp(ui = ui, server = server)
If I remove the commented line (x = m[1,1]) I get the desired result.
I can live with this workaround but is there a reason why shiny behaves like that or is there a different way to do it?
I usually use lapply for such usecases. This way, you don't run into issues with lazy evaluation.
library(shiny)
ui <- fluidPage(
mainPanel(
uiOutput("tables")
)
)
server <- function(input, output) {
output$tables <- renderUI({
data=array(rnorm(150),c(10,5,3))
tfc = function(m){renderTable({m})}
lapply(1:3, function(i){tfc(data[,,i])})
})
}
shinyApp(ui = ui, server = server)
If you want to use a reacive table, you can use something like
tfc = function(m, output, id){
output[[id]] <- renderTable({m()})
tableOutput(id)
}
instead.
To get around this, you can force evaluation of function arguments:
tfc = function(m) {
force(m)
renderTable(m)
}
or
create a local scope for each loop iteration:
for (i in 1:3) {
local({
i <- i
result[[i]] <<- tfc(data[,,i])
})
}
lapply works as well, but only for R versions 3.2 and above: https://cran.r-project.org/bin/windows/base/old/3.2.0/NEWS.R-3.2.0.html
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)
I am doing the following:
using R ShinyUI, get client inputs on ranges of variables A, B, C;
in R ShinyServer, read in a csv file, and using the client inputs to slice the csv, and get the portion that I need;
Perform a loop calculation on the csv, calculate various statistics from the loop output, and plot all these statistics.
Pseudo code:
data = read.csv('file.csv')
shinyServer(function(input, output) {
data <- reactive({
data = data[data$A<INPUT1 & data$B> INPUT2 & data$C<INPUT3,]
})
for (i in 1:dim(data)[1]){
result1[i] = xxx
result2[i] = xxx
}
output$plot <- renderPlot({
plot(result1)
})
})
The above code does not work. I want to know:
How to correctly incorporate user input and get the variable "data,"
How to plot result1 and result2 from output$plot
Thanks!
The for loop should be inside a the renderPlot, so each time the input$month changes, the reactive data will change and then the for lop will update your variables. If you have the for loop outside a reactive expression, it will be executed only once when the app starts, but after changes in the input.
Below is simple example based on the pseudo code you provide in your original question to illustrate the possible solution.
library(shiny)
ui <- shinyUI( fluidPage(
fluidRow(
column(4,
numericInput("input1", "Speed >", 8),
numericInput("input2", "Dist >", 15)
),
column(8,
plotOutput("plot")
)
)
))
server <- shinyServer(function(input, output) {
dat0 <- cars
data <- reactive({
dat0[dat0$speed > input$input1 & dat0$dist > input$input2,]
})
output$plot <- renderPlot({
s <- dim(data())[1]
result1 <- numeric(s)
result2 <- numeric(s)
for (i in 1:s){
result1[i] <- data()[i, 1]
result2[i] <- data()[i, 2]
}
plot(result1, result2)
})
})
shinyApp(ui = ui, server = server)