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
Related
I am experimenting with Shiny and async programming in the hopes of using it in a larger, more complex, public application.
In this example, I thought that unlist() would wait until the value of v1 is returned because of the use of future_promise and the promise pipe, %...>%.
However, I get the error:
Error in unlist: object 'v1' not found
How can I get this demo code to work?
app.R
library("zeallot")
library("shiny")
library("primes")
library("future")
library("promises")
library("tidyverse")
plan(multisession)
source("/home/law/whatbank_multicore_test/src/expensive_calc.R")
ui <- fluidPage(
actionButton("do", "Do Expensive Calc"),
textOutput("text")
)
server <- function(input, output, session) {
observeEvent(input$do, {
output$text <- renderText({
future_promise(zeallot::`%<-%`(c(v1, v2), expensive_calc()), seed = TRUE) %...>%
{
tmp <- unlist(v1)
}
})
})
}
shinyApp(ui, server)
expensive_calc.R
expensive_calc <- function(){
min <- 10000
max_num <- sample(80000:210000, 1)
rap <- ruth_aaron_pairs(min, max_num, distinct = FALSE)
list(rap, 11)
}
As pointed out to me in the RStudio Community the zeallot call needs to be within the future_promise braces. Here is the solution:
server <- function(input, output, session) {
observeEvent(input$do, {
output$text <- renderText({
future_promise(seed = TRUE) %...>%
{
zeallot::`%<-%`(c(v1, v2), expensive_calc())
tmp <- unlist(v1)
}
})
})
}
I have this question: In a Shiny App, I construct a varible with a reactive(). The thing is that, in the midle of this process (that is a long one) I construct other varibles that I need too.
For example:
#---------------UI------------------
ui <- navbarPage(
title = "example",
tabPanel('panel',
tableOutput("my_table"),
tableOutput("colum_names"))
)
#---------------SERVER------------------
server <- function(input, output) {
a <- reactive({
df_1 <- data.frame("fc"=c(1,2,3), "sc"=c(1,2,3), "tc"=c(1,2,3) )
df_2 <- subset(df_1,select=-c(fc))
column_names <- colnames(df_2)
df_3 <- df_2*2
df_3
})
output$my_table = renderTable({
a()
})
output$colum_names = renderTable({
df_column_names = data.frame(column_names())
df_column_names
})
}
#---------------APP------------------
shinyApp(ui = ui, server = server)
In this (very short) example, I would need the variable "a" (of course) and the variable "column_names". I can do something like create a new reactive that reproduce all the process until the line that contain "column_names" and finish it there. But the process is too long and I prefer to do it more "eficiently".
Any idea??
Thank you so much!
The process you're describing is correct : instead of assigning variables, just assign reactives and Shiny will handle the depedencies between them.
Note that in the example you provided, reactives aren't needed because the content is up to now static.
library(shiny)
#---------------UI------------------
ui <- navbarPage(
title = "example",
tabPanel('panel',
tableOutput("my_table"),
tableOutput("column_names"))
)
#---------------SERVER------------------
server <- function(input, output) {
df_1 <- data.frame("fc"=c(1,2,3), "sc"=c(1,2,3), "tc"=c(1,2,3) )
a <- reactive({subset(df_1,select=-c(fc))})
column_names <- reactive({colnames(a())})
output$my_table = renderTable({a()})
output$column_names = renderTable({column_names()})
}
#---------------APP------------------
shinyApp(ui = ui, server = server)
I found a interesting answer to my own question: if you want to do something like that, you can use "<<-" instead of "<-" and it save the variable when you are working insede a function (like reactive()). Let´s see:
#---------------UI------------------
ui <- navbarPage(
title = "example",
tabPanel('panel',
tableOutput("my_table"),
tableOutput("colum_names"))
)
#---------------SERVER------------------
server <- function(input, output) {
a <- reactive({
df_1 <- data.frame("fc"=c(1,2,3), "sc"=c(1,2,3), "tc"=c(1,2,3) )
df_2 <- subset(df_1,select=-c(fc))
column_names <- colnames(df_2)
# HERE THE SOLUTION!!
column_names_saved <<- column_names
df_3 <- df_2*2
df_3
})
output$my_table = renderTable({
a()
})
output$colum_names = renderTable({
df_column_names = data.frame(column_names_saved)
df_column_names
})
}
#---------------APP------------------
shinyApp(ui = ui, server = server)
Then, into the funtion you must continues with the variable "column_names", but when you need to use it later, you can use "column_name_saved". (just be carefull with one thing: onece you save the variable into the funtion, you canot change it)
Thanks!!!
I have a question about the Output Function in a Shiny application. Is it possible to write an output function with a variable as name to use it multiple times?
For example a short extract:
output$MainBody <- renderUI({
fluidPage(
gradientBox(
title = "Test",
)
)
})
Is it possible to use a function like this:
dt_representation <- function(x){
output$x <- renderUI({
fluidPage(
gradientBox(
title = "Test",
)
)
})
}
And call this funcion with:
dt_representation(MainBody)
Is that a possibility, or doesn't that work in Shiny?
I would strongly recommand to use modules as Pork Chop said.
But it can happen sometime I use such a little "hack" :
library(shiny)
ui <- fluidPage(
uiOutput("all_id")
)
server <- function(input, output) {
# Define function
createUI <- function(x, text) {
output[[x]] <<- renderUI({
div(text)
})
}
# Use function
createUI("id1", "Here is my first UI")
createUI("id2", "Here is my second UI")
# Combine all in one
output$all_id <- renderUI({
do.call(fluidRow, lapply(c("id1","id2"), uiOutput))
})
}
shinyApp(ui = ui, server = 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!