Plot doesn't appear in server version of app

Hi,

I'm having a problem getting my app to run properly on the Shiny server, because I can't get the plots to show up. For various reasons I'm setting up my plots in a uiOutput object. The uiOutput object shows the plots correctly on the local copy of my app (i.e. the local copy running from Rstudio on my personal computer) but the server version doesn't show the plots.

The server log has no error messages in it, the app log has no error messages in it. When I use F12 to inspect the plot in the browser developer window, I can see that the HTML tag for the plot inside the uiOutput object has been created correctly, and theoretically there is a PNG image inside it, but that image is either being plotted as a white image or is not being created correctly.

This is a minimal example that works on my local machine but not on the server:

library(shiny)

ui <- fluidPage(

    uiOutput(outputId = "testPlot")
)

server <- function(input, output) {

    output$testPlot <- renderUI({
        plot(1:10)
        p <- recordPlot()

        output$plot_A <- renderPlot({
            p
        })
        tagList(
            plotOutput("plot_A")
        )
    })
}

shinyApp(ui = ui, server = server)

Do you have any idea what I can do to work out why it's failing on the server?

Thanks

Louise

Does this work on the server ?

library(shiny)

ui <- fluidPage(
  uiOutput(outputId = "testPlot")
)

server <- function(input, output) {
  
  plot_content <- reactive({
    plot(1:10)
    myplot <- recordPlot()
    myplot
  })
  
  output$testPlot <- renderUI({
    tagList(
      plotOutput("plot_A")
    )
  })
  
  output$plot_A <- renderPlot({
    p <- req(plot_content())
   replayPlot(p)
  })
}

shinyApp(ui = ui, server = server)

yes, that works on the server, thanks.

however, I was trying to get it to work with the server side of each plot being generated at run time within the renderUI function, because the full version of it will have the server side generating a varying number of plot objects and their corresponding UI tags.

as in, I've got versions that make it work for a one-off plot using code like the one you have with a reactive object, but I don't want to use a reactive object because I'm going to have a varying number of plots and I don't want to create reactive objects on the fly for all of them

sorry, I probably should have explained that before

An exanple of your prefered architecture to work from here would be best. But in general a renderUI is not an appropropriate place to generate side effects.
Side effects are best made in observes or observeevents.
Also reactives and reactiveValues are the preferred ways to hold data objects that need to react to the dynamics of your app. Generally speaking when you want to create dynamic ui theres a matter of deciding on a naming convention for the dynamic objects so that you can work with them.

ok, thanks, what do I do if I need a dynamically changing number of reactive objects?

also, in the full version my renderUI is being called within an observeEvent, because clicking a button triggers the next set of plots to be created for the UI

source("stats_game_text_elements.R")
source("stats_game_worlddata.R")
source("basic_statistics_generator.R")
source("basic_plot_generator.R")

library(cli)
library(greekLetters)
library(RColorBrewer)
library(truncnorm)
library(TruncatedDistributions)
# library(truncdist) ## IMPORTANT: CANNOT use the truncdist package because it uses the "stats4" package which clashes with shiny and shinyjs, and you can't just load shiny and shinyjs libraries after loading truncdist, that doesn't help
# library(cascsim) # For the truncated gamma distribution functions
library(shinyvalidate)
library(rjson)
library(shinyjs)

setup_question_stats <- function() {
    stats <- c("num_correct","num_attempted","num_questions","percent_correct","percent_attempted")
    topics <- c("overall","basic_stats")
    ntopics <- length(topics)
    question_stats <- as.data.frame(matrix(rep(0,ntopics*5), nrow=ntopics, dimnames=list(topics,stats)))
}

update_question_stats <- function(question_stats, level_answers, level_topic) {
    current <- unlist(question_stats['overall',])
    current[1:3] <- current[1:3] +
        c(sum(level_answers, na.rm=TRUE),
          sum(!is.na(level_answers)),
          length(level_answers))
    current[4:5] <- current[1:2]/current[3]*100
    question_stats['overall',] <- current

    topic <- unlist(question_stats[level_topic,])
    topic[1:3] <- topic[1:3] +
        c(sum(level_answers, na.rm=TRUE),
          sum(!is.na(level_answers)),
          length(level_answers))
    topic[4:5] <- topic[1:2]/topic[3]*100
    question_stats[level_topic,] <- topic

    question_stats
}

server <- function(input, output, session){

    # Retrieving files needed
    source("user.R", local=TRUE)

    iv <- InputValidator$new()
    iv$add_rule("username", sv_required())
    iv$add_rule("username", function(value) {
        if (grepl("[^A-Za-z]", value)) {
            "Username can only contain letters"
        }
    })

    max_level <- 7
    first_level <- 6

    # Option for whether to instantly display the question answers or not
    level_answers_immediate_display <- TRUE

    # Set up the world object and a few question objects at session level
    world <- generate_user_world("")
    level_topic <- NULL
    generated_questions <- NULL
    displayed <- vector
    level_answers <- vector()

    progress <- reactiveValues(level=first_level, done_intro=FALSE,
                               question_stats=setup_question_stats())

    plots <- list()
    nplots <- reactiveVal(0)
    current_plot <- reactiveVal(1)
    nquestions <- reactiveVal(0)
    current_question <- reactiveVal(1)

    output$introText <- renderText({intro_text})
    output$endText <- renderText({"Sorry, that's the end of the game, you can't go any further yet. If you want to practise more, you can start again as a new user, and you'll get different answers for the questions."})

    output$progressText <- renderText({
        paste0("You have got ",round(progress$question_stats['overall','percent_correct']),
               "% of the questions correct overall and ",
               round(progress$question_stats['basic_stats','percent_correct']),
               "% correct for the basic stats levels.")
    })

    observeGameStartButton <- observe({
        # show("userPage")
        show("levelPage")
        hide("startPage")
    })
    bindEvent(observeGameStartButton, input$gameStartButton)

    # Setup level ----
    observeNewLevel <- observe({

        if (progress$level <= max_level) {
            levelText <- renderText({level_text[[progress$level]]})
            # plots <- list()

switch(as.character(progress$level),
       "1" = {
           level_topic <<- "basic_stats"
           samples <- generate_samples(world$seed, 2, world$streams)
           generated_questions <<- generate_sample_question_set(samples, "lowest")
           plots <<- prepare_summary_stat_barplots(samples)
       },
       "2" = {
           level_topic <<- "basic_stats"
           generated_questions <<- generate_variable_type_question_set(level=2)
       },
       "3" = {
           level_topic <<- "basic_stats"
           generated_questions <<- generate_weather_questions(world$monthly_weather)
           plots <<- prepare_weather_plots(world$monthly_weather)
       },
       "4" = {
           level_topic <<- "basic_stats"
           generated_questions <<- generate_histogram_question_set(world$daily_weather$windspeed)
           plots <<- prepare_histogram(world$daily_weather$windspeed)
       },
       "5" = {
           level_topic <<- "basic_stats"
           samples <- generate_samples(1, 2, world$shelter_materials)
           generated_questions <<- generate_boxplot_question_set(samples)
           plots <<- prepare_boxplot(samples, "Total rain leaked (mm)")
       },
       "6" = {
           level_topic <<- "basic_stats"
           generated_questions <<- generate_scatterplot_question_set(world$trauma_assessments, linear=TRUE)
           plots <<- prepare_scatterplot(world$trauma_assessments)
       })

            current_question(0)
            nquestions(length(generated_questions$qna))
            level_answers <<- rep(NA, nquestions())

            current_plot(1)
            nplots(length(plots))
            
            if (nplots() < 2) {
                hide("plotLeftButton")
                hide("plotRightButton")
            } else {
                show("plotLeftButton")
                show("plotRightButton")
            }

            # use renderUI to create a dynamic number of output ui elements
            output$plots_ui <- renderUI({
                nump <- nplots()

                if (nump == 1) {

                    output$plot_1 <- renderPlot({
                        # plot(1:10)
                        plots[[1]]
                    })
                    tagList(
                        plotOutput("plot_1")
                    )

                } else if (nump > 1) {

                    lapply(1:nump, function(i) {
                        output_name <- paste0("plot_", i)
                        output[[output_name]] <- renderPlot({
                            # plot.new()
                            # replayPlot(plots[[i]])
                            plots[[i]]
                        })
                        if (i == 1) {
                            tagList(
                                plotOutput(
                                    outputId = paste0("plot_", i),
                                ))
                        } else {
                            tagList(
                                hidden(plotOutput(
                                    outputId = paste0("plot_", i),
                                )))
                        }

                    })
                }
            })

        } else {
            show("endPage")
            hide("levelPage")
        }

        output$levelText <- renderText({paste0("This is level ",progress$level,".")})
        show("levelPage")
        hide("introPage")
        hide("progressPage")
    })
    bindEvent(observeNewLevel, input$progressNextButton, input$introNextButton,
              input$gameStartButton, ignoreInit=TRUE)

    observePlotLeftButton <- observe({
        i <- current_plot()
        if (i > 1) {
            current_plot(i-1)
            hide(paste0("plot_",i))
            show(paste0("plot_",i-1))
        }
        if (i == 2) {
            disable("plotLeftButton")
        }
        enable("plotRightButton")
    })
    bindEvent(observePlotLeftButton, input$plotLeftButton)
    observePlotRightButton <- observe({
        i <- current_plot()
        if (i < nplots()) {
            current_plot(i+1)
            hide(paste0("plot_",i))
            show(paste0("plot_",i+1))
        }
        if (i == (nplots() - 1)) {
            disable("plotRightButton")
        }
        enable("plotLeftButton")
    })
    bindEvent(observePlotRightButton, input$plotRightButton)

}

Im afraid that at least for me what you shared is both not reproducible, relying on unshared code , and too complex to be considered minimal. Im going to decline working on it as i expect it woukd require too much time from me to help you given what you presented.

Here you can find a related gist from Winston Chang:

ok, most of that code I posted already works for me i.e. I don't need help with it, it's simply the bit that I shared in the minimal example that doesn't work, so I just wanted help with the minimal example without dramatically changing the structure of it. but thanks

My existing full code is actually already quite similar in structure to Winston's code, except that I'm trying to reuse the plot objects that were created elsewhere rather than trying to create them within the renderPlot, and that's the step that doesn't work.

I don't know if you realise that I got sent an email when you initially replied to my post, so you deleting the post doesn't stop me from being able to read it, sorry.

The fact that my code works perfectly well on my computer but doesn't work on the Shiny server suggests that there may be something about the way the server is set up, or something about permissions, that's causing issues, so that's what I wanted help with.

I deleted it because the code I shared wasn't working as intended.

ah ok, fair enough! :slight_smile:

I was wondering whether you need to display all plots at once? plotLeftButton sounds like the user is able to slide/scroll through the recorded plots. Is that correct?

If it is please check the following (based on my deleted post):

library(shiny)

ui <- fluidPage(
  sliderInput(
    inputId = "nPlots",
    label = "Number of Plots",
    min =  0,
    max = 20,
    value = 5),
  numericInput(
    inputId = "show_plot",
    label = "Show plot no.",
    value = 1,
    min = 0,
    max = 20
  ),
  plotOutput(outputId = "allPlots",
             height = "600px")
)

server <- function(input, output, session) {
  observeEvent(input$nPlots, {
    freezeReactiveValue(input, "show_plot")
    updateNumericInput(session, "show_plot", max = input$nPlots)
  })
  
  plots <- reactive({
    plotdata_list <- lapply(seq_len(input$nPlots), seq_len)
    plot_list <- list()
    for(i in seq_along(plotdata_list)){
      plot(plotdata_list[[i]])
      plot_list[[i]] <- recordPlot()
    }
    plot_list
  })
  
  output$allPlots <- renderPlot({
    plots()[[input$show_plot]]
  })
}

shinyApp(ui, server)

PS: the number of plots (nPlots) could also be a reactive or a reactiveVal generated on the server side.

Regarding the fact that your code is working on your local PC vs. not running on shiny server: Did you host shiny server also on your local PC (running Linux) or are those two different systems (with different OS)?

In response to your question about the server, my local computer is running Windows and the server is running on a Linux server, which I do not manage.