Related
I generate a dynamic number of valueBox in my shiny, and this number can change depending of the user input.
I managed to handle this with a renderUI where I put the wanted number of valueBoxOutput, and I have an observe that will feed them with the content using renderValueBox.
My problem is: the code in the renderValueBox, for some reason, is actually executed after the observe is finished, so because the renderValueBox is in a loop (to have a dynamic number of them) but the code is executed for all the output after the loop, all my output will get the last value of the loop.
Here is a min reprex:
library(shiny)
library(shinydashboard)
library(shinyWidgets)
# Function
compute <- function(id)
{
print(paste("Compute ", id))
return(id)
}
# UI
ui = shinyUI(fluidPage(
titlePanel("Compare"),
useShinydashboard(),
sidebarLayout(
sidebarPanel(
numericInput("numitems", label = "Number of items", min = 1, max = 10, value = 2)
),
mainPanel(
uiOutput("boxes")
)
)
))
# Server
server = shinyServer(function(input, output, session) {
data <- reactiveValues(
ids = list()
)
output$boxes <- renderUI({
print("boxes")
box_list <- list()
id_list <- list()
for(id in 1:(input$numitems)) {
id_box <- paste0("box_", id)
print(paste("boxes - ", id_box))
id_list <- append(id_list, id_box)
box_list <- append(
box_list,
tagList(
shinydashboard::valueBoxOutput(id_box)
)
)
data$ids <- id_list
}
print("boxes end")
fluidRow(box_list)
})
observe({
print("observe")
for(id_box in data$ids) {
print(paste("observe - ", id_box))
output[[id_box]] <- shinydashboard::renderValueBox(valueBox(id_box, compute(id_box), icon = icon("circle-info"), color = "teal"))
}
print("end observe")
})
})
# Run
shinyApp(ui = ui , server = server)
Here is the result:
And the console output:
As you can see the compute (and the render in general) is done after the end of the observe function, and both output will use the last id_box that were set (so the last loop, box_2), instead of correctly using box_1 and box_2.
I tried using force, computing valueBox outside the render, using reactive lists, nothing worked, because whatever I do the render is evaluated after the observe so only the last loop values will be used no matter what.
Do anyone know a way to force execution during the loop ? Or see another way of achieving the same result ?
Why it's always after spending hald a day on a problem, looking for dozens of posts and forum, don't find anything, finally decide to ask a question... that a few minutes later I finally find an answer.
Anyway, one way to correct this (found here) is to encapsulate the render inside the local function, like this:
observe({
print("observe")
for(id_box in data$ids) {
print(paste("observe - ", id_box))
local({
tmp <- id_box
output[[tmp]] <- shinydashboard::renderValueBox(valueBox(tmp, compute(tmp), icon = icon("circle-info"), color = "teal"))
})
}
print("end observe")
})
Now the compute is still called after the end of the observe, but the tmp variable has the correct value:
The result is what I wanted:
For the record, I had already tried to use the local function, but if you don't copy the id_box inside another variable just for the local bloc, it won't work.
In my tiny Shiny app I am asking the user: how many time periods do you want to cut your time series into? For example, the user selects 3.
I want to use this input to take a fixed vector of dates and make it possible for the user the select from it the desired last date of Time Period 1 (in select box 1), and Time Period 2 (in select box 2). (The last date for time period 3 will be the very last date, so I don't need to ask).
I am not sure how to do it. I understand that because I don't know the desired number of time periods in advance, I have to create a list. But how do I then collect the input from those select boxes?
Thanks a lot!
library(shiny)
### UI #######################################################################
ui = shinyUI(fluidPage(
titlePanel("Defining time periods"),
# Sidebar:
sidebarLayout(
sidebarPanel(
# Slider input for the number of time periods:
numericInput("num_periodsnr", label = "Desired number of time periods?",
min = 1, max = 10, value = 2),
uiOutput("period_cutpoints")
),
# Show just the number of periods so far.
mainPanel(
textOutput("nr_of_periods")
)
)
))
### SERVER ##################################################################
server = shinyServer(function(input, output, session) {
library(lubridate)
output$nr_of_periods <- renderPrint(input$num_periodsnr)
# Define our dates vector:
dates <- seq(ymd('2016-01-02'), ymd('2017-12-31'), by = '1 week')
# STUCK HERE:
# output$period_cutpoints<-renderUI({
# list.out <- list()
# for (i in 1:input$num_periodsnr) {
# list.out[[i]] <- renderPrint(paste0("Sometext", i), ,
# )
# }
# return(list.out)
# })
})
# Run the application
shinyApp(ui = ui, server = server)
This is similar to a question I asked and subsequently worked out an answer to here. The big changes are (predictably) in the server.
Nothing needs to change in the UI, but as you'll see below I've included another textOutput so that you can see the dates you end up selecting, and I've also added an actionButton, which I'll explain later.
The server function has a couple additions, which I'll describe first and then put together at the end. You're right that you need to create a list of input objects inside the renderUI, which you can do through lapply. At this step, you're creating as many selectInputs as you'll have cutpoints, minus one because you say you don't need the last:
output$period_cutpoints<-renderUI({
req(input$num_periodsnr)
lapply(1:(input$num_periodsnr-1), function(i) {
selectInput(inputId=paste0("cutpoint",i),
label=paste0("Select cutpoint for Time Period ", i, ":"),
choices=dates)
})
})
Next, you'll need to access the values selected in each, which you can do in the same way, using a reactiveValues object you create first, and assign the new values to it. In my version of this problem, I couldn't figure out how to get the list to update without using an actionButton to trigger it. Simple reactive() or observe() doesn't do the trick, but I don't really know why.
seldates <- reactiveValues(x=NULL)
observeEvent(input$submit, {
seldates$x <- list()
lapply(1:(input$num_periodsnr-1), function(i) {
seldates$x[[i]] <- input[[paste0("cutpoint", i)]]
})
})
Full working app code then looks like this:
library(shiny)
ui = shinyUI(fluidPage(
titlePanel("Defining time periods"),
sidebarLayout(
sidebarPanel(
numericInput("num_periodsnr", label = "Desired number of time periods?",
min = 1, max = 10, value = 2),
uiOutput("period_cutpoints"),
actionButton("submit", "Submit")
),
mainPanel(
textOutput("nr_of_periods"),
textOutput("cutpoints")
)
)
))
server = shinyServer(function(input, output, session) {
library(lubridate)
output$nr_of_periods <- renderPrint(input$num_periodsnr)
dates <- seq(ymd('2016-01-02'), ymd('2017-12-31'), by = '1 week')
output$period_cutpoints<-renderUI({
req(input$num_periodsnr)
lapply(1:(input$num_periodsnr-1), function(i) {
selectInput(inputId=paste0("cutpoint",i),
label=paste0("Select cutpoint for Time Period ", i, ":"),
choices=dates)
})
})
seldates <- reactiveValues(x=NULL)
observeEvent(input$submit, {
seldates$x <- list()
lapply(1:(input$num_periodsnr-1), function(i) {
seldates$x[[i]] <- input[[paste0("cutpoint", i)]]
})
})
output$cutpoints <- renderText({as.character(seldates$x)})
})
shinyApp(ui = ui, server = server)
you can make the boxes dynamically inside an lapply and send them as 1 output object to the ui
require("shiny")
require('shinyWidgets')
ui = shinyUI(fluidPage(
titlePanel("Defining time periods"),
# Sidebar:
sidebarLayout(
sidebarPanel(
# Slider input for the number of time periods:
numericInput("num_periodsnr", label = "Desired number of time periods?",
min = 1, max = 10, value = 2),
uiOutput("period_cutpoints")
),
# Show just the number of periods so far.
mainPanel(
textOutput("nr_of_periods")
)
)
))
# Define server logic ----
server <- function(session, input, output) {
output$period_cutpoints<- renderUI({
req(input$num_periodsnr > 0)
lapply(1:input$num_periodsnr, function(el) {
airDatepickerInput(inputId = paste('PeriodEnd', el, sep = ''), label = paste('Period End', el, sep = ' '), clearButton = TRUE, range = F, update_on = 'close')
})
})
}
# Run the app ----
shinyApp(ui = ui, server = server)
Since you did not provide a dataset to apply the inputs on, and I don't know what date ranges your data has, I did not add code to set min/max on the date pickers, and not sure what kind of code to provide for you to use the data. You would need to write something to put them in a list indeed
values <- reactiveValues(datesplits = list(),
previous_max = 0)
observeEvent(input$num_periodsnr, {
if(input$num_periodsnr > values$previous_max) {
lapply(values$previous_max:input$num_periodsnr, function(el) {
observeEvent(input[[paste(paste('PeriodEnd', el, sep = '')]], {
values$datesplits[el] <- input[[paste(paste('PeriodEnd', el, sep = '')]]
})
values$previous_max <- max(values$previous_max, input$num_periodsnr)
})
}
})
and then use the list of dates for whatever you need to do with them I think.
I use the trick with run lapenter code hereply from previous_max to input$num_periodsnr if(input$num_periodsnr > values$previous_max){} to avoid the problem you create when you repeatedly create observers for the same input element. Whereas ui elements are overwritten when created in a loop, observeEvents are made as copies, so every time your loop fires, you make another copy of observers 1:n. This results in all copies firing every time, until you have a million observers all firing, creating possible strange bugs, unwanted effects and loss of speed.
I am relatively new to shiny. I created an NBA win-probability model a few weeks ago and have been trying to create a shiny app that will generate the output from my model for which I have created a user-defined function.
In my user interface I want a place to enter numeric input value for "Home Points", "Away Points", and "Time Remaining". Once, values have been entered for these values I want the user to click an action button. After the action button is clicked I simply want the app to display the output from my function in the main panel. However, I am unable to figure out how to get this to work.
Here is my code:
library(shiny)
# Define UI for application that calculates win probability
ui <- fluidPage(
# Application title
titlePanel("Win Probability"),
# Sidebar layout with inputs and output definitions
sidebarLayout(
#sidebar panel for inputs
sidebarPanel(
#Add numeric input for home team points
numericInput(inputId = "home.pts", label = h3("Home Points"), value = 0),
#Add numeric input for away team points
numericInput(inputId = "away.pts", label = h3("Away Points"), value = 0),
#Add numeric input for time remaining in fourth quarter
numericInput(inputId = "time", label = h3("Time Remaining"), value = 0),
#Add action buttion
actionButton("goButton","Apply")),
# Show output
mainPanel(
verbatimTextOutput("win_prob")
)))
win_prob <- function(time, home.pts, away.pts) {
#calculate point difference
diff <- home.pts - away.pts
#Store intercept and betas
intercept <- 0.09564935
b_time <- 0.01087832
b_diff <- 0.5243092
b_interact <- -0.03066952
#calculate and store logit
logit <- intercept + (time*b_time) + (diff*b_diff) +
((time*diff)*b_interact)
#function to change logit to probability
logit2prob <- function(logit) {
odds <- exp(logit)
prob <- odds/(1+odds)
}
#Store probability
prob <- logit2prob(logit)
prob
}
# Define server to return win probability
server <- function(input, output) {
#Store reactive values
home.pts <- reactive({input$home.pts})
away.pts <- reactive({input$away.pts})
time <- reactive({input$time})
output$win_prob <- renderPrint({win_prob(reactive({input$home.pts}),
reactive({input$away.pts}), reactive({input$time}))})
}
# Run the application
shinyApp(ui = ui, server = server)
If someone can please help me I would greatly appreciate it!
Thank you!
Using reactivity
server <- function(input, output) {
#Store reactive values
home.pts <- reactive({input$home.pts})
away.pts <- reactive({input$away.pts})
time <- reactive({input$time})
output$win_prob <- renderPrint({win_prob(home.pts(), away.pts(), time())})
}
Using ObserveEvent
server <- function(input, output) {
data <- reactiveValues()
observeEvent(input$goButton,{
data$home.pts <- input$home.pts
data$away.pts <- input$away.pts
data$time <- input$time
})
output$win_prob <- renderPrint({
req(data$home.pts) #to delay displaying result until user press Apply
win_prob(data$home.pts,data$away.pts, data$time)})
}
Now you can see the deference between the two approaches
Well you don't need to store all your inputs in reactive values. They already update themselves. When you have an actionButton, the best way to trigger an event from the click on the button is to use observeEvent. If I understood well, I would rewrite your server function like this:
# Define server to return win probability
server <- function(input, output) {
observeEvent(input$goButton, {
output$win_prob <- renderPrint({
win_prob(input$home.pts,
input$away.pts,
input$time)
})
})
}
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.
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,...], ...)
}
})
I know this question has been addressed multiple times and I've researched those instances that I've found, but have not found a solution that works.
I'm using an actionButton() as a Run button-- the intent is to not re-run the simulation unless the actionButton is clicked. I've used observe({ }) and isolate({ }) as I've seen discussed here, but still have several problems. I'll discuss the problems, then include the code below. The app is in early stages presently, and ONLY the second simulation on the drop down menu is partly implemented, so after starting the app select "Dorriefish growth/reproduction tradeoffs" from the selectInput() menu. Don't be concerned by any other rough spots at this time.
When the app begins, the run button behaves as expected in the sense that moving the top two sliders (S and p) does not cause the simulation to run or display output in a separate graphics device (reps.df == 1 is a special case requiring a dev.new()). At this point, input$runSim (the run button) == 0 because it has not been clicked yet.
First problem: when the run button is clicked, the graphics device opens and the simulation runs as expected, then ANOTHER graphics device opens and the same simulation displays again. Be patient while the first simulation display finishes-- a second will open on top of it. When those are closed (by clicking on their window controls), the next time the run button is pressed the same simulation is displayed a third time, then another graphics device opens and displays a new simulation run. If those graphics devices are closed, subsequent clicks on the run button behave as expected, opening one graphics device and displaying one, unique simulation run each time. Why do the first two clicks on the run button produce TWO graphics devices and repeat the first simulation run three times? (Pounds head on desk.)
Second problem: after the first time the run button is pushed, input$runSim increments and thereafter any movement of the S and p sliders causes a new graphics device to open and display a new simulation run. I don't want this behavior-- I need the simulation to display ONLY when the run button is clicked, not automatically when other input parameters are changed. I want the nominal behavior of the submitButton(), but I've read online that an actionButton with observe and isolate is the better practice. For the life of me I just cannot get it to isolate the run button function from the other sliders changing when input$runSim is greater than zero, i.e. after the first time it is clicked. There does not appear to be any obvious way to reset the value of that actionButton variable back to zero after a simulation run has been displayed, so after that first click the button no longer prevents new simulations whenever any other input variable is updated. (Pounds head some more.)
In summary: 1) why do the first two clicks on the run button each cause two graphics device windows to open, and why do they display the first simulation run three times? 2) How can I make the simulation run and display ONLY when the run button is clicked after the first time it is clicked?
Here is my (very preliminary) code:
ui.r
# filename: ui.r
# Michael Camann, Humboldt State University, 2014
################################################################################
#
# Define the user interface
#
################################################################################
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"
)
)
)
)
)
)
server.r
# filename: server.r
# Michael Camann, Humboldt State University, 2014
library(shiny)
################################################################################
#
# Dorrie fish reproduction/growth trade-offs
#
################################################################################
# This function implements the Doriefish simulation exercise distributed in Java
# with Cain et al Ecology, 2nd ed.
# Arguments:
#
# S The switch point in grams for transitioning from growth to reproduction.
# Default = 10 g.
#
# p Probability of predation. Default = 0.12.
#
# show Logical. If TRUE (default), print and plot single simulation output. Set
# to FALSE when running multiple simulations in order to average the number
# of offspring across multiple simulations, in which case viewing the
# results of individual simulations isn't necessary.
df.sim <- function(S=10, p=0.12, show=TRUE)
{
if (S < 10 | S > 50) stop("S must be between 10 and 50 grams.")
doriefish <- 10 # cohort size
imass <- 5 # initial mass
mass <- rep(imass, doriefish) # init vector of dorrie fish mass
dead <- rep(FALSE, doriefish) # init vector of mortality status
mhistory <- matrix(dead, nrow=1, byrow=TRUE) # init a matrix of mortality history
offspring.t <- 0 # init offspring count
total.offspring <- vector() # storage vector
while(any(dead==FALSE)) # continue until all are dead
{
repro.t <- mass >= S & !dead # who reproduces during this time step?
offspring.t <- offspring.t + sum(mass[repro.t==TRUE]/5) # one offspring per 5 g body mass
total.offspring <- c(total.offspring, offspring.t) # keep track of offspring each time step
mass[!dead & !repro.t] <- mass[!dead & !repro.t] + 5 # incr mass by 5 g if not reproducing
die.t <- sapply(1:length(dead), function(x) runif(1) <= p) # stochastic selection of some for predation
dead <- dead | die.t # update the mortality vector
mhistory <- rbind(mhistory, dead) # update the mortality history matrix
}
rownames(mhistory) <- c(1:nrow(mhistory))
rval <- list(S=S, p=p, mass=mass, mhistory=mhistory, offspring.t=total.offspring,
offspring=total.offspring[length(total.offspring)], show=show)
class(rval) <- "df.sim"
return(rval)
}
print.df.sim <- function(sim) # print function for df.sim()
{
if(sim$show)
{
cat("\n\tDoriefish simulation\n\n")
cat("Switch point from growth to reproduction:", sim$S, "g.\n\n")
cat("Probability of predation:", sim$p, "per time step.\n\n")
cat("Time to cohort extinction:", length(sim$offspring.t), "time steps.\n\n")
cat("Total adult Doriefish biomass:", sum(sim$mass), "g.\n\n")
cat("Total offspring produced:", sim$offspring, "\n\n")
plot(sim)
}
}
plot.df.sim <- function(sim, sstep=FALSE, s=0.75, ...) # plot function for df.sim()
{
opar <- par(no.readonly=TRUE) # save graphics parameters
txt <- paste("Total offspring:", sim$offspring,
" Time to cohort extinction:", length(sim$offspring.t), "time steps.")
step.through <- function(sim, s=0.5, txt=txt)
{
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(s)
}
mtext(txt, side=1, at=0, line=5, adj=0)
}
if(sstep) step.through(sim, s, txt)
else
{
par(fig=c(0,1,0.1,1), xpd=NA)
plot(sim$offspring.t, type="h", xlab="Time steps",
ylab="Cumulative Doriefish offspring", ...)
mtext(txt, side=1, at=0, line=5, adj=0)
}
par(opar)
}
################################################################################
#
# Define the shiny server
#
################################################################################
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()
plot(sim(), sstep=TRUE)
}
}, # end case dorriefish
) # end switch(input$sim)
}) # end renderPlot()
}) # end isolate()
}) # end observe()
}) # end shinyServer()
Thanks in advance for any advice you can offer. I'm rather new to Shiny and obviously need more time with it.
I had a look at your code and tried it myself.
I think the main problem is within your ShinyServer method. A "renderPlot" within a "reactive" within an "Isolate" within an "observe" seems like a bad idea. Surely "renderPlot" and "observe" shouldn't be encapsulated within other reactive expressions, they are reactive endpoints. Here you have a really clear overview of how to use the reactive expressions which helped me a lot: http://rstudio.github.io/shiny/tutorial/#reactivity-overview
I tried to rewrite your ShinyServer code to follow that philosophy:
shinyServer(function(input, output) {
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({
if(input$runSim == 0) return()
isolate({
switch(input$sim,
dorriefish = {
if (input$reps.df == 1)
{
plot(sim(), sstep=TRUE)
}
}, # end case dorriefish
) # end switch(input$sim)
}) # end isolate
}) # end renderPlot()
}) # end shinyServer()
This seems to work fine.
Notice I also removed the
dev.new()
I don't think there's a need to open a plotting device within shiny, that's what the renderPlot function takes care of.
And as a final tip I suggest you have a look at a visual debugger for shiny (and R in general) so you can trace every bit of code: there's one within RStudio or you could install the StatET plugin for eclipse. It helps a bunch to see what gets called when, to see the reactive expressions at work.
I would recommend using actionButton with observeEvent. The minimal example would be as follow:
In your server.R file you would need the following:
shinyServer(
function(input, output) {
observeEvent(input$run, {
# simulation code
})
})
The observeEvent is then triggered by actionButton in ui.R:
actionButton("run", label = "Run Simulation")
The button is decorated with the id run. After it's hit the input$run on the server side is registered with observeEvent. Once it's triggered the function in the observeEvent is performed (# simulation code in the example).
The above is, I hope, a solution to your problem 2). It doesn't explain the problem 1) but it should solve it.