How do I produce partial graphics in R-Shiny output? - r

Question

I hope I can explain this succinctly. I have an R function that runs an ecological simulation and returns a list of output (time steps, population size, mortality history, number of offspring, stuff like that). I want to slow down the graphics output under certain circumstances so that students can see population dynamics as they happen. The plot axes and title should be displayed, then in 0.5 s the first line representing cumulative offspring should appear, then 0.5 s later the second line of cumulative offspring appears, then the third 0.5 s later, until the entire cohort of new offspring has been plotted at the end of the "simulation."
The problem is that the app waits until the whole image has been rendered before displaying it, so I can't show students "slowed down" population dynamics. The output plot is blank until all of those 0.5 s delays have finished, then it renders all at once. Even the graphics calls that precede the for() loop are suppressed until after the loop finishes. The code examples below are incomplete, work in progress versions.
Here is my server code-- if you uncomment the dev.new() call in the renderPlot command the app works exactly as desired, except that output is in a new graphics device, rather than in the Shiny app plot window:
shinyServer(function(input, output) {
observe({
if(input$runSim == 0) return()
isolate({
sim <- reactive({
switch(input$sim,
dorriefish = {
df.sim(input$S.df, input$p.df, show=FALSE)
} # end case dorriefish
) # end switch(input$sim)
}) # end reactive()
output$modl.plot <- renderPlot({
switch(input$sim,
dorriefish = {
if (input$reps.df == 1)
{
# dev.new()
opar <- par(no.readonly=TRUE)
len <- length(sim()$offspring.t)
par(fig=c(0,1,0.1,0.9), xpd=NA)
plot(sim()$offspring.t, type="n", xlab="Time steps", ylab="Cumulative Doriefish offspring",
xlim=c(1, max(len, length(sim()$mass))))
mtext("Dorriefish living per time step (green = alive, red = dead):", side=3, at=(max(len)/2)+0.5,
line=4.2)
for(i in 1:nrow(sim()$mhistory))
{
z <- rep("green", length(sim()$mass))
z[sim()$mhistory[i,]] <- "red"
points(seq(1,len, length=length(sim()$mass)), rep(max(1.18*sim()$offspring.t), length(sim()$mass)),
pch=21, col="black", bg=z, cex=2.5)
lines(sim()$offspring.t[1:i], type="h")
Sys.sleep(0.5)
}
txt <- paste("Total offspring:", sim()$offspring,
" Time to cohort extinction:", length(sim()$offspring.t), "time steps.")
mtext(txt, side=1, at=0, line=5, adj=0)
par(opar)
} # end if(input$reps.df == 1)
} # end case dorriefish
) # end switch(input$sim)
}) # end renderPlot()
}) # end isolate()
}) # end observe()
}) # end shinyServer()
Here is the UI code:
library(shiny)
shinyUI(
fluidPage(
titlePanel("BIOL 330 ecological simulations"),
sidebarLayout(
sidebarPanel("",
helpText(HTML("<h3 style='text-align:center;'>Control Panel</h3>"), align='center'),
tags$hr(style='height:2px; border-width:0; color:gray; background-color:gray'),
# choose a simulation from a drop down menu
selectInput("sim", HTML("<b>Select a simulation to explore:</b>"),
# list the simulations available
c("No simulation selected (Introduction)" = "none",
"Dorriefish growth/reproduction trade-offs" = "dorriefish",
"Optimal foraging" = "optfor")
),
tags$hr(style='height:2px; border-width:0; color:gray; background-color:gray'),
conditionalPanel(condition="input.sim=='dorriefish'",
helpText(HTML("<b>Simulation model parameters:</b>")),
sliderInput("S.df", label=div(HTML("Specify <em>S</em>, the switch point mass (g) for
transition from somatic growth to reproduction:")),
min = 1, max = 50, value = 10, step=5),
sliderInput("p.df", label=div(HTML("Specify <em>p</em>, the probability of mortality
by predation in any given time step:")),
min = 0, max = 1, value = 0.12, step=0.01),
sliderInput("reps.df", label=div(HTML("Specify the number of full simulations to
run:")), min = 1, max = 100, value = 1, step=1)
),
# bottom controls common to all panels
conditionalPanel(condition="input.sim!='none'",
tags$hr(style='height:2px; border-width:0; color:gray; background-color:gray'),
fluidRow(column(4, actionButton("runSim", "Run simulation")),
column(4, actionButton("saveSim", "Save output file")),
column(4, actionButton("printSim", "Save/print plot"))),
tags$hr(style='height:2px; border-width:0; color:gray; background-color:gray')
)
),
mainPanel("",
# no model selected-- show information page
conditionalPanel(condition="input.sim=='none'",
includeHTML("www/simNoneText.html")
),
tabsetPanel(id="outTabs", type="tabs",
tabPanel("Plot", plotOutput("modl.plot")
),
tabPanel("Summary"
),
tabPanel("R Code"
)
)
)
)
)
)
So to repeat my question, how can I get the server to display the cumulative number of offspring in each time step, pause 0.5 s, than show the next until all the simulation time steps have been displayed?
Thanks, and best regards,
--Mike C.

Answer 1

I've tried to read your code and this is what I saw:
I suggest you to use the uiOutput() function to display output, so that the ui.R gets clearer, while putting computation in server.R
To simulate the steps while the population is growing (or anything else) you could calculate all at once in server.R, and then displaying inside a for() loop only some data, like this inside the server.R
output$plot <- renderUI({
### here calculate the results all at once and save it to a variable
result <- calculations
for(i in 1:dim(result)[1]){
Sys.sleep(0.5) # time to wait to perform each plot
### here you put the code to only get some results of
### the calculation you've perfomed earlier
ggplot(results[i,...], ...)
}
})