Skip to content

Instantly share code, notes, and snippets.

@wch wch/server.r
Last active Aug 27, 2019

Embed
What would you like to do?
Shiny example app with dynamic number of plots
max_plots <- 5
shinyServer(function(input, output) {
# Insert the right number of plot output objects into the web page
output$plots <- renderUI({
plot_output_list <- lapply(1:input$n, function(i) {
plotname <- paste("plot", i, sep="")
plotOutput(plotname, height = 280, width = 250)
})
# Convert the list to a tagList - this is necessary for the list of items
# to display properly.
do.call(tagList, plot_output_list)
})
# Call renderPlot for each one. Plots are only actually generated when they
# are visible on the web page.
for (i in 1:max_plots) {
# Need local so that each item gets its own number. Without it, the value
# of i in the renderPlot() will be the same across all instances, because
# of when the expression is evaluated.
local({
my_i <- i
plotname <- paste("plot", my_i, sep="")
output[[plotname]] <- renderPlot({
plot(1:my_i, 1:my_i,
xlim = c(1, max_plots),
ylim = c(1, max_plots),
main = paste("1:", my_i, ". n is ", input$n, sep = "")
)
})
})
}
})
shinyUI(pageWithSidebar(
headerPanel("Dynamic number of plots"),
sidebarPanel(
sliderInput("n", "Number of plots", value=1, min=1, max=5)
),
mainPanel(
# This is the dynamic UI for the plots
uiOutput("plots")
)
))
@pjpastrana

This comment has been minimized.

Copy link

commented Oct 23, 2013

I am trying to implement something very similar and this code helped a lot.
However I need the call to the plot function inside renderPlot (server.r:line 28) to be reactive, to be called only when input$n changes. I have tried renderPlot({ reactive({plot(...)}) }) among other things, but that did not help. Any thougts on how to achieve this?
Otherwise it is called everytime I resize the browser window even if the input$n has not change (why is that?).

Thanks.

@hongtao510

This comment has been minimized.

Copy link

commented Nov 14, 2014

Thanks for this example. Can you make max_plots a reactive value instead of hard coded? http://stackoverflow.com/questions/26931173/reactive-shiny-r-loop

@zhilongjia

This comment has been minimized.

Copy link

commented Jan 4, 2015

When there are reactive content, like a reactive function function_x() in the chunk, it alerts "Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)"
how to cope with it? thank you.

max_plots <- 5
shinyServer(function(input, output) {

    #####################################
    test1 <- reactive({
        "plotX"
    })
  #####################################
    # Insert the right number of plot output objects into the web page
    output$plots <- renderUI({
        plot_output_list <- lapply(1:input$n, function(i) {
            #####################################
            plotname <- paste(test1(), i, sep="")
           #####################################
            plotOutput(plotname, height = 280, width = 250)
        })

        # Convert the list to a tagList - this is necessary for the list of items
        # to display properly.
        do.call(tagList, plot_output_list)
    })

    # Call renderPlot for each one. Plots are only actually generated when they
    # are visible on the web page.
    for (i in 1:max_plots) {
        # Need local so that each item gets its own number. Without it, the value
        # of i in the renderPlot() will be the same across all instances, because
        # of when the expression is evaluated.
        local({
            my_i <- i
            #####################################
            plotname <- paste(test1(), my_i, sep="")
            #####################################
            output[[plotname]] <- renderPlot({
                plot(1:my_i, 1:my_i, xlim = c(1, max_plots), ylim = c(1, max_plots), main = paste("1:", my_i, ".  n is ", input$n, sep = ""))
            })
        })
    }
})
@dgrapov

This comment has been minimized.

Copy link

commented Oct 30, 2015

Why is it strange that the assignment on line 24:

  my_i <- i

is necessary to get this to work compared to using i directly which doesn't work?

@saun4app

This comment has been minimized.

Copy link

commented Oct 30, 2015

dgrapov,

The "assignment on line 24" is explained in the comment: Need local so that each item gets its own number. Without it, the value of i in the renderPlot() will be the same across all instances, because of when the expression is evaluated.

@saun4app

This comment has been minimized.

Copy link

commented Oct 30, 2015

zhilongjia, this approach seems to work.

get_plot_output_list <- function(max_plots, input_n) {
  # Insert plot output objects the list
  plot_output_list <- lapply(1:input_n, function(i) {
    plotname <- paste("plot", i, sep="")
    plot_output_object <- plotOutput(plotname, height = 280, width = 250)
    plot_output_object <- renderPlot({
      plot(1:i, 1:i,
           xlim = c(1, max_plots), ylim = c(1, max_plots),
           main = paste("1:", i, ".  n is ", input_n, sep = "")
      )
    })
  })

  do.call(tagList, plot_output_list) # needed to display properly.

  return(plot_output_list)
}

shinyServer(function(input, output) {
  observe({
    output$plots <- renderUI({ get_plot_output_list(max_plots, input$n) })
  })
})
@shrikrishnaw

This comment has been minimized.

Copy link

commented Nov 19, 2015

Thanks a lot for this code. It helped me a lot.
Can i know how to arrange the plots side by side instead of one below the other( which is happening in the above case)?
I tried using CSS sheet by using the float. but it still prints the plot one below the other.

@saun4app

This comment has been minimized.

Copy link

commented Dec 10, 2015

shrikrishnaw, here is an (responsive) example of arranging the plots side by side using Bootstrap Grid (http://getbootstrap.com/css/#grid).

get_plot_bootstrapjs_div <- function(plot_object_list, id_prefix) {
  #### local_function
  get_col_div <- function(plot_object_list, id_prefix, index, css_class = 'col-xs-12 col-sm-6')  {
    col_div <- div(class = css_class)

   if(length(plot_object_list) >= index) {
      plot_name <- paste0(id_prefix, '_', index)
      plot_output_object <- plotOutput(plot_name)
      plot_output_object <- renderPlot(plot_object_list[[index]])
      col_div <- tagAppendChild(col_div, plot_output_object)
    }
    return(col_div)
  }
  #
  get_plot_div <- function(plot_object_list, id_prefix) {
    result_div <- div(class = 'container-fluid')

    for(i in 1:length(plot_object_list)) {
      row_div <- div(class = 'row')
      row_div <- tagAppendChild(row_div, get_col_div(plot_object_list, id_prefix, i))
      row_div <- tagAppendChild(row_div, get_col_div(plot_object_list, id_prefix, i+1))    
      result_div <- tagAppendChild(result_div, row_div)
    }
    return(result_div)
  }
  ####
  plot_output_list_div <- get_plot_div(plot_object_list, id_prefix)

  return(plot_output_list_div)
}

get_plot_object_list <- function(max_plots, input_n) {
  result_plot_list <- lapply(1:input_n, function(i) {
    plot(1:i, 1:i,
         xlim = c(1, max_plots), ylim = c(1, max_plots),
         main = paste("1:", i, ".  n is ", input_n, sep = "")
    )
  })
  return(result_plot_list)
}

get_plot_output_list_div <- function(max_plots, input_n) {
  plot_object_list <- get_plot_object_list(max_plots, input_n)
  plot_output_div <- get_plot_bootstrapjs_div(plot_object_list, 'ui_plot')
  return(plot_output_div)
}


shinyServer(function(input, output) {
  observe({
    output$plots <- renderUI({ get_plot_output_list_div(max_plots, input$n) })
  })
})
@michalsharabi

This comment has been minimized.

Copy link

commented Jan 7, 2016

Thanks a lot for this code. It helped me a lot.
I'm trying to do the same with interactive plots (with dygraph), and it doesn't work :(
The graphs doesn't show, do you happen to know how to do it with interactive plots?
Many Thanks,
Michal

@rghertner

This comment has been minimized.

Copy link

commented Feb 9, 2016

michmic76, one option is to use plotly. If you make your plotly chart (using native plotly charts, or ggplot2, with the ggplotly call around it), and then replace the renderPlot with renderPlotly and the plotOutput with plotlyOutput, it should work fine. I just tried it on my app and its a breeze.

@michalsharabi

This comment has been minimized.

Copy link

commented Feb 14, 2016

rghertner, thanks - I did your suggestion, but still didnt work :(

@lkaihua

This comment has been minimized.

Copy link

commented Feb 15, 2016

Thanks @saun4app. Your version of script is really useful. Also working on dynamic number of plots in Shiny.

@justacec

This comment has been minimized.

Copy link

commented Mar 29, 2016

@saun4app I was looking at your script and trying to add the click functionality in the plotOutput call. When doing so, I noticed that you called plotOutput and renderOutput right after each other and even clobbered the data from the plotOutput call. Is the plotOutput doing something here, or is that a typo?

@lokesh005

This comment has been minimized.

Copy link

commented Jan 12, 2017

@saun4app How can I get 2 plots in a row.

@michaelo9000

This comment has been minimized.

Copy link

commented Feb 9, 2017

Thank you! Before reading this and adding the assignment of the local i, my code was working but returning identical plots. Now I know why.

@stanstrup

This comment has been minimized.

Copy link

commented Mar 21, 2017

Anyone got this to work inside a module? I have tried everything I could think of with no luck.
With the original code by Chang I get the error for having reactives and with the first example from saun4app my plots never appear. It is as if the code is never called. So I am assuming the namespacing is wrong and hence it never sees the need to execute the code that refers to an incorrect ID.

If it helps my unsuccessful attempt in a rather complex app is here:
https://github.com/stanstrup/QC4Metabolomics/blob/master/Modules/Productivity/shiny_server_heatmap.R#L260
https://github.com/stanstrup/QC4Metabolomics/blob/master/Modules/Productivity/shiny_ui_heatmap.R

EDIT: solved.

@MarsJiao

This comment has been minimized.

Copy link

commented Jun 24, 2017

Hi, thanks very much for your codes, i need to ggplot 8 graphs in one page , so I chage to this :
max_plots <- 8
But these eight graphs are the same (the last graphics I want), my data from ggplot 1-8 is the 1st to 8th column in a dataframe.
Is there any problem in my code as follows ,
`
max_plots <- 8
mycolor <- c("darkorange","blue","green","darkyellow","lightblue","orange","darkblue","darkgreen")

shinyServer(function(input, output) {
output$plots <- renderUI({
plot_output_list <- lapply(1:max_plots, function(i) {
plotname <- paste("plot", i, sep="")
plotOutput(plotname, height = 280, width = 800)
})
do.call(tagList, plot_output_list)
})
for (i in 1:max_plots) {
# Need local so that each item gets its own number. Without it, the value
# of i in the renderPlot() will be the same across all instances, because
# of when the expression is evaluated.
local({
my_i <- i
plotname <- paste("plot", my_i, sep="")
output[[plotname]] <- renderPlot({
fc <- as.vector((fcap$FC))
ds <- read.csv("mydata.csv",header = T)
dsn <- ds[,1]
ds1 <- as.data.frame(apply(ds[,2:9],2,as.numeric));rownames(ds1) <- dsn
dataset <- ds1
ggplot(dataset,aes(x=as.Date(rownames(dataset)),y=dataset[,i]))+geom_line(color=mycolor[i])+geom_point(size=2,shape = 15,colour = mycolor[i])+geom_hline(aes(yintercept=as.integer(as.character(fcap[which(fcap$FC==colnames(dataset)[i]),2]))),linetype=5)+ggtitle(colnames(dataset)[i])+xlab("Kitting_Date")+ylab("Sum of Pieces")+scale_x_date(breaks = as.Date(rownames(dataset)))+theme(axis.text.x=element_text(angle=45,size=5))
})
})
}
})
`

@lokesh005

This comment has been minimized.

Copy link

commented Jun 26, 2017

Right now the below code give the output in the single column. What should I do so that the output plots in row-wise. If a row is occupied completely then the output should be plotted in next row. Ex: if max_plot <- 5 then I want the output in such a fashion that first 2 plots in first row, next two in another row and last plot in third row.

`get_plot_output_list` <- function(max_plots, input_n) {
# Insert plot output objects the list
      plot_output_list <- lapply(1:input_n, function(i) {
            plotname <- paste("plot", i, sep="")
            plot_output_object <- plotOutput(plotname, height = 280, width = 250)
            plot_output_object <- renderPlot({
                  plot(1:i, 1:i, xlim = c(1, max_plots), ylim = c(1, max_plots), 
                          main = paste("1:", i, ".  n is ", input_n, sep = ""))
            })
      })
      do.call(tagList, plot_output_list) # needed to display properly.
      return(plot_output_list)
}

shinyServer(function(input, output) {
      observe({
             output$plots <- renderUI({ get_plot_output_list(max_plots, input$n) })
      })
 })
@Schwall

This comment has been minimized.

Copy link

commented Jul 5, 2017

Thanks for this code - this saved me a lot of time.

@lokesh005: to display inline add in plotOutput the argument 'inline=TRUE' and provide in renderPlot arguments for width and height. The Shiny Documentation on plotOutput and renderPlot is very helpful.

@Georgewiggins

This comment has been minimized.

Copy link

commented Aug 3, 2017

Any clues on how to use a reactive() to set you max_plots? For my attempt the user can select a gene and then for each gene I want to plot each probe, not all genes have the same probe. Basically large df is reduced to a df with rough 1-4 rows and I want to be able to plot either 1 plot if only 1 row is returned or 4 if there are four plots.

My attempt which doesn't work is below. Thanks for your code which almost got me there...

library(shiny)
library(hgu133plus2.db)
data = read.delim("nagel_wIDs", row.names =1)
pam50 = read.csv("pam50classification.csv")
sym = as.list(hgu133plus2SYMBOL)
sym = sym[match(rownames(data), names(sym))]

ui <- fluidPage("Expression Variable of breast tumours",
                # *Input() functions,
                textInput(inputId = "GoI", label = "Select gene of interest", value ="FSIP1"),
                selectInput(inputId = "subOrgen", label = "Comparison", choices = c("BRCA1 vs BRCAx", "BRCA1/2 vs BRCAx", 
                                                                                    "BRCA2 vs BRCAx")),
                sidebarPanel(sliderInput("n", "Number of plots", value=1, min=1, max=5)
                ),
                # *Output() functions,
                plotOutput("boxplot"),
                uiOutput("plots")
)

server <- function(input, output){
  g = ifelse(pam50$pam50.classification.subtype == "Basal", "Basal", "Non-basal")
  #output$boxplot = renderPlot({boxplot(as.numeric(data[sym == input$GoI,])~g)})
  GoI <- reactive({length(sym[sym == input$GoI])})

  output$plots <- renderUI({
    plot_output_list <- lapply(1:isolate(GoI()), function(i) {
      plotname <- paste("plot", i, sep="")
      plotOutput(plotname, height = 280, width = 250)
    })
    
    # Convert the list to a tagList - this is necessary for the list of items
    # to display properly.
    do.call(tagList, plot_output_list)
  })
  max_plots <- GoI()
  # Call renderPlot for each one. Plots are only actually generated when they
  # are visible on the web page.
  for (i in 1:max_plots) {
    # Need local so that each item gets its own number. Without it, the value
    # of i in the renderPlot() will be the same across all instances, because
    # of when the expression is evaluated.
    local({
      my_i <- i
      plotname <- paste("plot", my_i, sep="")
      dataGoI <- reactive({a=data[sym == input$GoI,]
        b = a[my_i,]
        return(b)})
      
      output[[plotname]] <- renderPlot({
        boxplot(as.numeric(dataGoI())~g, 
             main = paste("1:", my_i, ".  n is ", input$n, sep = "")
        )
      })
    })
  }
}

shinyApp(ui = ui, server = server)
@msuprun

This comment has been minimized.

Copy link

commented Sep 4, 2017

Hi, thanks for the codes! One problem I can't seem to figure out. I create a list of plots that needs to be dynamically displayed. They are colored by patient (each patient has a distinct color), and each plot (referred to as "plate") can have different number of patients.

I had to sort the plots by the number of patients (#) first, since if I get the one with the smallest # first, the code will break (i assume something to do with the colors). However, it still doesn't print all plots correctly, a lot of time colors are switched. Have you ever seen something like this?

Here are some parts of the code. Sorry I can't make it reproducible, since it's quite long.

Thank you!

# 7. Dynamic display of plots ------ 
# Insert the right number of plot output objects into the web page
output$plots <- renderUI({
  if (is.null(Y())) { return(NULL) 
  } else {
    plot_output_list <- lapply(1:n.plates(), function(k) {
      plotname <- paste("plot", k, sep="")
      plotOutput(plotname, height = 600, width = 800)
    })
    # Convert the list to a tagList - this is necessary for the list of items
    # to display properly.
    do.call(tagList, plot_output_list)
  }
})

# can not print ggplots from a list if the plot with less colors is followed by more colors
# will sort plots by number of subjects 
order.p <- reactive ({
  n.all <- c()
  for (i in 1:length(plates())) {
    z <- as.vector(plates()[[i]])
    z <- z[-grep("None|IPC|QC|SC|Buffer",z)]
    z.u <- length(unique(sapply(strsplit(as.character(z), ".", fixed=T), "[", 1)))
    n.all <- append(n.all,z.u)
  }
  order.p1 <- as.data.frame(n.all)
  order.p1 <- plyr::mutate(order.p1, plate=as.numeric(rownames(order.p1))) %>%
    plyr::arrange(n.all)
  order.p1
})

# 9. List of plots ------ 
plot.list <- reactive({
  plot.listR <- list()

  for (i in order.p()$plate) {
    
    image.db <- image.db.list()[[i]]
    extra.colorsA<-image.db$extra.colorsA
    names(extra.colorsA)<-as.character(image.db$Patient)
    
    p <- ggplot(image.db, aes(x = Number,y = LETTER)) +
      geom_tile(aes(fill = Patient),colour = "black") +
      scale_fill_manual(values = extra.colorsA, guide = guide_legend(nrow=5)) +
      labs(title = paste0("Plate # ",i,". N subjects = ", length(pat.ord)))
    
    plot.listR[[i]] <- p  
  }
  plot.listR
})

# 6. Plot output ------ 
# Call renderPlot for each one. Plots are only actually generated when they
# are visible on the web page.
for (i in 1:max_plots) {
  local({
    my_i <- i
    plotname <- paste("plot", my_i, sep="")
    output[[plotname]] <- renderPlot({
      plot.list()[[my_i]]
    })
  })
}


I suspect the problem is with this part, since plots will have different attributes, and I get "Warning: attributes are not identical across measure variables; they will be dropped":

do.call(tagList, plot_output_list)

I wonder if there is a way for tagList() to handle that.

@muktillc

This comment has been minimized.

Copy link

commented Jan 8, 2018

I was wondering if there is a way to add selectedInput for each plot dynamically added. I know the first code works for multiple plots. I found a code to add buttons dynamically but when I try to combine both these codes, i don't see the plot. I want inputs for each plot so that i can make changes to the plot.

@malcook

This comment has been minimized.

Copy link

commented Mar 18, 2018

I am hoping to find an approach that only computes the plots as needed, and does not recompute those already computed. Has anyone come across such? You can demonstrate that the displayed plots are recomputed on each change to n but adding the date() to the plot header.

@DonnaHaga

This comment has been minimized.

Copy link

commented Mar 29, 2018

Any updates on why this won't work with dygraphs. The space where the plots are supposed to be is blank.

@matt-s-gibbs

This comment has been minimized.

Copy link

commented May 28, 2018

Thanks so much for this, excellent. If you are still trying to get it to work with dygraphs, you need dygraphOutput() instead of PlotOutput() on line 9, line 27 renderDygraph() instead of renderPlot(), and the actual dygraph() plot from line 28.

@Cococatty

This comment has been minimized.

Copy link

commented Feb 9, 2019

Thank you so much!! I have been looking for efficient solution and this is it! 👍

@MarijaStanojcic

This comment has been minimized.

Copy link

commented Jun 17, 2019

@wch, Thank you for the code, it helped me a lot. I used this code for a dynamic number of images.
Does anyone know how can to add tooltip or popup for each image?

@yolomike

This comment has been minimized.

Copy link

commented Jul 18, 2019

Thanks a lot! This is just amazing.

@ajnewcomb

This comment has been minimized.

Copy link

commented Aug 27, 2019

I notice many people seem to be executing code successfully within the chunk of the server function. Whenever I have any code here that isn't wrapped by reactive({}) or another type of reactive function I get the error saying "Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)".

In particular the for-loop used to call renderPlot({}) is apparently super useful, but how do you call the loop without wrapping it in a reactive function?

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.