Nothing
##############################################################################################
#### this section updates the input boxes if a rValues$ssClass updates
####
#######this observer is intended to run any time ssClass changes
####### it needs to be able to update inputs
#observeEvent(rValues$ssClass,{
observeEvent(rValues$ssClass@title,{
if (!is.null(rValues$ssClass@title))
updateTextInput(session,"title",value=isolate(rValues$ssClass@title))
})
observeEvent(rValues$ssClass@date,{
if (!is.null(rValues$ssClass@date))
updateDateInput(session,"date",value=isolate(rValues$ssClass@date))
})
observeEvent(rValues$ssClass@num.perm.reps,{
if (!is.null(rValues$ssClass@num.perm.reps))
updateNumericInput(session,"NumPermReps",value=isolate(rValues$ssClass@num.perm.reps))
})
observeEvent(rValues$ssClass@quiet,{
if (!is.null(rValues$ssClass@quiet))
updateCheckboxInput(session,"quiet",value=isolate(rValues$ssClass@quiet))
})
observeEvent(rValues$ssClass@simulator.type,{
if (!is.null(rValues$ssClass@simulator.type)){##sets a bunch of downstream parameters based on simulation type
updateCheckboxInput(session,"coalescent",value=isolate(ifelse(rValues$ssClass@simulator.type=="c",T,F)))
output$simulator <- renderText({paste("Simulator:",rValues$ssClass@simulator)})
if (rValues$ssClass@simulator.type=="c") rValues$ssClass@sim.func <- fsc.run else rValues$ssClass@sim.func <- rms.run
output$simfunc <- renderText({paste("Simulator function:",ifelse(rValues$ssClass@simulator.type=="c","fsc.run","rms.run"))})
if (rValues$ssClass@simulator.type=="c") rValues$ssClass@sim.check.func <- fsc.scenarioCheck else rValues$ssClass@sim.check.func <- rms.scenarioCheck
}
})
observeEvent(rValues$ssClass@num.sim.reps,{
if (!is.null(rValues$ssClass@num.sim.reps))
updateNumericInput(session,"reps",value=isolate(rValues$ssClass@num.sim.reps))
})
observeEvent(rValues$ssClass@analyses.requested,{
if (!is.null(rValues$ssClass@analyses.requested))
updateCheckboxGroupInput(session,"analysesReq",
isolate(names(rValues$ssClass@analyses.requested)[rValues$ssClass@analyses.requested]))
})
observeEvent(rValues$ssClass@wd,{
if (!is.null(rValues$ssClass@wd))
{
if (is.null(supportValues$simroot)) {supportValues$simroot <- "."}
output$simpath <- renderText({
paste("Complete path for simulation 'scratch' directory:",paste(supportValues$simroot,rValues$ssClass@wd,sep="/"))
})
}
})
##scenarios #respect the scenarioNumber!
observeEvent(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@num.pops,{
if (!is.null(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@num.pops))
{
# updateTextInput(session,"numpopsTxt",
# value=paste(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@num.pops))
rValues$ssClass@scenarios[[rValues$scenarioNumber]]@migration[[rValues$migrationNumber+1]] <- mig.mat()
}
})
observeEvent(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@simulator.params,{
if (rValues$ssClass@simulator.type!="c") #rmetasim, for now
{
updateNumericInput(session,"gens",value=isolate(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@simulator.params@num.gen))
updateNumericInput(session,"stages",value=isolate(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@simulator.params@num.stgs))
}
})
#
# this function updates a bunch of user interface items based on the rValues$ssClass entries
#
updateUIs <- function()
{
###genpars
updateNumericInput(session,"reps",value = isolate(rValues$ssClass@num.sim.reps))
updateNumericInput(session,"NumPermReps",value = isolate(rValues$ssClass@num.perm.reps))
######## update the scenario input boxes
choices=1:length(rValues$ssClass@scenarios)
updateSelectInput(session,"scenarioNumber",choices=choices,selected=isolate(as.character(rValues$scenarioNumber)))
updateSelectInput(session,"specScenNumber",choices=choices,selected=isolate(as.character(rValues$scenarioNumber)))
if (!is.null(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@num.pops))
updateTextInput(session,"numpopsTxt",
value=isolate(paste(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@num.pops)))
if (!is.null(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@num.loci))
updateNumericInput(session,"numloci",value=isolate(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@num.loci))
if (!is.null(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@locus.type))
updateSelectInput(session,"loctype",selected=isolate(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@locus.type))
if (!is.null(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@sequence.length))
updateNumericInput(session,"seqlen",value=isolate(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@sequence.length))
if (!is.null(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@mig.helper$migModel))
updateSelectInput(session,"migModel",selected=isolate(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@mig.helper$migModel))
if (!is.null(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@mig.helper$rows))
updateNumericInput(session,"rows",value=isolate(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@mig.helper$rows))
if (!is.null(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@mig.helper$cols))
updateNumericInput(session,"cols",value=isolate(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@mig.helper$cols))
if (!is.null(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@mig.helper$distfun))
updateTextInput(session,"distfun",value=isolate(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@mig.helper$distfun))
if (!is.null(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@mig.helper$migRate))
updateNumericInput(session,"migRate",value=isolate(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@mig.helper$migRate))
###supposed to reset the executables section for fastsimcoal
if (!is.null(rValues$ssClass@simulator))
if (rValues$ssClass@simulator=="fsc")
if (!is.null(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@simulator.params))
{
sim.exec <-
c(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@simulator.params@fastsimcoal.exec,
supportValues$simexec)
sim.exec <- sim.exec[!is.null(sim.exec)]
sim.exec <- basename(Sys.which(sim.exec)) #gets the names of the executables actually on machine
sim.exec <- unique(sim.exec)
sim.exec <- sim.exec[nchar(sim.exec)>2]
if (debug()) print("rendering UI for simexec")
if (debug()) print(sim.exec)
updateSelectInput(session,"fscexec",selected=sim.exec[1],
choices=sim.exec)
}
###rmetasim
if (req(rValues$ssClass@simulator)=="rms")
{
updateNumericInput(session,"stages",
value= isolate(rValues$ssClass@scenarios[[rValues$scenarioNumber]]@simulator.params@num.stgs))
nl = rValues$ssClass@scenarios[[rValues$scenarioNumber]]@num.loci
updateNumericInput(session,"focalLoc",min=1,max=nl)
}
##analysis results
if (!is.null(rValues$ssClass@analysis.results))
{
updateSelectizeInput(session,"gstatsel",choices=isolate(global.stats(rValues$ssClass)),selected=isolate(global.stats(rValues$ssClass)),server=TRUE)
updateSelectizeInput(session,"lstatsel",choices=isolate(locus.stats(rValues$ssClass)),selected=isolate(locus.stats(rValues$ssClass)),server=TRUE)
updateSelectizeInput(session,"pstatsel",choices=isolate(pairwise.stats(rValues$ssClass)), selected=isolate(pairwise.stats(rValues$ssClass)),server=TRUE)
updateNumericInput(session,"vizScenario",max=viz.scenarios(isolate(rValues$ssClass)))
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.