├── oshinys_0.1-1.zip ├── oshinys_0.2-1.zip ├── oshinys_0.2-3.zip ├── oshinys_0.1-1.tar.gz ├── oshinys_0.2-1.tar.gz ├── oshinys_0.2-3.tar.gz ├── source ├── oshinys.Rproj ├── man │ ├── sir.app.Rd │ ├── tsir.app.Rd │ ├── seirs.app.Rd │ ├── ricker.app.Rd │ ├── seir.app.Rd │ ├── lpatribolium.app.Rd │ ├── nicholsonbailey.app.Rd │ ├── rossmacdonald.app.Rd │ ├── negbinparasitoid.app.Rd │ ├── rosenzweigmacarthur.app.Rd │ ├── lotkavolterrapredation.app.Rd │ ├── lotkavolterracompetition.app.Rd │ └── flowField.Rd ├── NAMESPACE ├── R │ ├── onAttach.R │ ├── ricker.R │ ├── sir.R │ ├── seirs.R │ ├── flowField.R │ └── allapps3.R └── DESCRIPTION ├── HOWTO └── README.md /oshinys_0.1-1.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/objornstad/oshinys/HEAD/oshinys_0.1-1.zip -------------------------------------------------------------------------------- /oshinys_0.2-1.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/objornstad/oshinys/HEAD/oshinys_0.2-1.zip -------------------------------------------------------------------------------- /oshinys_0.2-3.zip: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/objornstad/oshinys/HEAD/oshinys_0.2-3.zip -------------------------------------------------------------------------------- /oshinys_0.1-1.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/objornstad/oshinys/HEAD/oshinys_0.1-1.tar.gz -------------------------------------------------------------------------------- /oshinys_0.2-1.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/objornstad/oshinys/HEAD/oshinys_0.2-1.tar.gz -------------------------------------------------------------------------------- /oshinys_0.2-3.tar.gz: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/objornstad/oshinys/HEAD/oshinys_0.2-3.tar.gz -------------------------------------------------------------------------------- /source/oshinys.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: No 4 | SaveWorkspace: No 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageRoxygenize: rd,collate,namespace 22 | -------------------------------------------------------------------------------- /source/man/sir.app.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sir.R 3 | \docType{data} 4 | \name{sir.app} 5 | \alias{sir.app} 6 | \title{Launch a shiny-app simulating the SIR model} 7 | \format{An object of class \code{shiny.appobj} of length 5.} 8 | \usage{ 9 | sir.app 10 | } 11 | \description{ 12 | Launch a shiny-app simulating the SIR model 13 | } 14 | \details{ 15 | Launch app for details 16 | } 17 | \examples{ 18 | \dontrun{sir.app} 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /source/man/tsir.app.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/allapps3.R 3 | \docType{data} 4 | \name{tsir.app} 5 | \alias{tsir.app} 6 | \title{Launch a shiny-app simulating TSIR model} 7 | \format{An object of class \code{shiny.appobj} of length 5.} 8 | \usage{ 9 | tsir.app 10 | } 11 | \description{ 12 | Launch a shiny-app simulating TSIR model 13 | } 14 | \details{ 15 | Launch app for details 16 | } 17 | \examples{ 18 | \dontrun{tsir.app} 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /source/man/seirs.app.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/seirs.R 3 | \docType{data} 4 | \name{seirs.app} 5 | \alias{seirs.app} 6 | \title{Launch a shiny-app simulating the SEIRS model} 7 | \format{An object of class \code{shiny.appobj} of length 5.} 8 | \usage{ 9 | seirs.app 10 | } 11 | \description{ 12 | Launch a shiny-app simulating the SEIRS model 13 | } 14 | \details{ 15 | Launch app for details 16 | } 17 | \examples{ 18 | \dontrun{seirs.app} 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /source/man/ricker.app.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ricker.R 3 | \docType{data} 4 | \name{ricker.app} 5 | \alias{ricker.app} 6 | \title{Launch a shiny-app simulating the Ricker model} 7 | \format{An object of class \code{shiny.appobj} of length 5.} 8 | \usage{ 9 | ricker.app 10 | } 11 | \description{ 12 | Launch a shiny-app simulating the Ricker model 13 | } 14 | \details{ 15 | Launch app for details 16 | } 17 | \examples{ 18 | \dontrun{Ricker.app} 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /source/man/seir.app.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/allapps3.R 3 | \docType{data} 4 | \name{seir.app} 5 | \alias{seir.app} 6 | \title{Launch a shiny-app simulating the seasonal SEIR model} 7 | \format{An object of class \code{shiny.appobj} of length 5.} 8 | \usage{ 9 | seir.app 10 | } 11 | \description{ 12 | Launch a shiny-app simulating the seasonal SEIR model 13 | } 14 | \details{ 15 | Launch app for details 16 | } 17 | \examples{ 18 | \dontrun{seir.app} 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /source/man/lpatribolium.app.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/allapps3.R 3 | \docType{data} 4 | \name{lpatribolium.app} 5 | \alias{lpatribolium.app} 6 | \title{Launch a shiny-app simulating the LPA model} 7 | \format{An object of class \code{shiny.appobj} of length 5.} 8 | \usage{ 9 | lpatribolium.app 10 | } 11 | \description{ 12 | Launch a shiny-app simulating the LPA model 13 | } 14 | \details{ 15 | Launch app for details 16 | } 17 | \examples{ 18 | \dontrun{lpatribolium.app} 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /source/man/nicholsonbailey.app.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/allapps3.R 3 | \docType{data} 4 | \name{nicholsonbailey.app} 5 | \alias{nicholsonbailey.app} 6 | \title{Launch a shiny-app simulating the Nicholson-Bailey model} 7 | \format{An object of class \code{shiny.appobj} of length 5.} 8 | \usage{ 9 | nicholsonbailey.app 10 | } 11 | \description{ 12 | Launch a shiny-app simulating the Nicholson-Bailey model 13 | } 14 | \details{ 15 | Launch app for details 16 | } 17 | \examples{ 18 | \dontrun{nicholsonbailey.app} 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /source/man/rossmacdonald.app.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/allapps3.R 3 | \docType{data} 4 | \name{rossmacdonald.app} 5 | \alias{rossmacdonald.app} 6 | \title{Launch a shiny-app simulating the Ross-Macdonald malaria model} 7 | \format{An object of class \code{shiny.appobj} of length 5.} 8 | \usage{ 9 | rossmacdonald.app 10 | } 11 | \description{ 12 | Launch a shiny-app simulating the Ross-Macdonald malaria model 13 | } 14 | \details{ 15 | Launch app for details 16 | } 17 | \examples{ 18 | \dontrun{rossmacdonald.app} 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /source/man/negbinparasitoid.app.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/allapps3.R 3 | \docType{data} 4 | \name{negbinparasitoid.app} 5 | \alias{negbinparasitoid.app} 6 | \title{Launch a shiny-app simulating May's Parasitoid-host Model model} 7 | \format{An object of class \code{shiny.appobj} of length 5.} 8 | \usage{ 9 | negbinparasitoid.app 10 | } 11 | \description{ 12 | Launch a shiny-app simulating May's Parasitoid-host Model model 13 | } 14 | \details{ 15 | Launch app for details 16 | } 17 | \examples{ 18 | \dontrun{negbinparasitoid.app} 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /source/man/rosenzweigmacarthur.app.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/allapps3.R 3 | \docType{data} 4 | \name{rosenzweigmacarthur.app} 5 | \alias{rosenzweigmacarthur.app} 6 | \title{Launch a shiny-app simulating the Rosenzweig-MacArthur model} 7 | \format{An object of class \code{shiny.appobj} of length 5.} 8 | \usage{ 9 | rosenzweigmacarthur.app 10 | } 11 | \description{ 12 | Launch a shiny-app simulating the Rosenzweig-MacArthur model 13 | } 14 | \details{ 15 | Launch app for details 16 | } 17 | \examples{ 18 | \dontrun{rosenzweigmacarthur.app} 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /source/man/lotkavolterrapredation.app.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/allapps3.R 3 | \docType{data} 4 | \name{lotkavolterrapredation.app} 5 | \alias{lotkavolterrapredation.app} 6 | \title{Launch a shiny-app simulating the Lotka-Volterra predation model} 7 | \format{An object of class \code{shiny.appobj} of length 5.} 8 | \usage{ 9 | lotkavolterrapredation.app 10 | } 11 | \description{ 12 | Launch a shiny-app simulating the Lotka-Volterra predation model 13 | } 14 | \details{ 15 | Launch app for details 16 | } 17 | \examples{ 18 | \dontrun{lotkavolterrapredation.app} 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /source/man/lotkavolterracompetition.app.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/allapps3.R 3 | \docType{data} 4 | \name{lotkavolterracompetition.app} 5 | \alias{lotkavolterracompetition.app} 6 | \title{Launch a shiny-app simulating the Lotka-Volterra competition model} 7 | \format{An object of class \code{shiny.appobj} of length 5.} 8 | \usage{ 9 | lotkavolterracompetition.app 10 | } 11 | \description{ 12 | Launch a shiny-app simulating the Lotka-Volterra competition model 13 | } 14 | \details{ 15 | Launch app for details 16 | } 17 | \examples{ 18 | \dontrun{lotkavolterracompetition.app} 19 | } 20 | \keyword{datasets} 21 | -------------------------------------------------------------------------------- /source/NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(flowField) 4 | export(lotkavolterracompetition.app) 5 | export(lotkavolterrapredation.app) 6 | export(lpatribolium.app) 7 | export(negbinparasitoid.app) 8 | export(nicholsonbailey.app) 9 | export(ricker.app) 10 | export(rosenzweigmacarthur.app) 11 | export(rossmacdonald.app) 12 | export(seir.app) 13 | export(seirs.app) 14 | export(sir.app) 15 | export(tsir.app) 16 | importFrom(deSolve,ode) 17 | importFrom(graphics,abline) 18 | importFrom(graphics,curve) 19 | importFrom(graphics,legend) 20 | importFrom(graphics,lines) 21 | importFrom(graphics,plot) 22 | importFrom(graphics,title) 23 | importFrom(polspline,lspec) 24 | importFrom(scatterplot3d,scatterplot3d) 25 | importFrom(shiny,renderPlot) 26 | -------------------------------------------------------------------------------- /source/R/onAttach.R: -------------------------------------------------------------------------------- 1 | .onAttach <- function(libname, pkgname) { 2 | packageStartupMessage("\nCurrent apps are:\n 3 | lpatribolium.app - LPA Tribolium model\n 4 | lotkavolterracompetition.app - Lotka-Volterra competion model\n 5 | lotkavolterrapredation.app - Lotka-Volterra predation model\n 6 | negbinparasitoid.app - May's Negative-Binomial parasitoid-host model\n 7 | nicholsonbailey.app - Nicholson-Bailey Host-Parasitoid model\n 8 | ricker.app - The Ricker ('discrete logisitic') mode\n 9 | rosenzweigmacarthur.app - Rosenzweig-MacArthur Predator-Prey model\n 10 | rossmacdonald.app - A simple Ross-Macdonald type malaria model\n 11 | seir.app - the seasonally forced SEIR model\n 12 | seirs.app - the unforced SEIRS model\n 13 | sir.app - the unforced SIR model\n 14 | tsir.app - the unforced TSIR model with demographic an environmental stochasticity\n 15 | ") 16 | } -------------------------------------------------------------------------------- /HOWTO: -------------------------------------------------------------------------------- 1 | To INSTALL download to your local disk either the tar.gz (mac, unix) or zip file (windows) depending on OS and from within R or Rstudio type: 2 | 3 | > install.packages("/yourpath/oshinys_0.2-3.tar.gz", repos = NULL, type = "source") 4 | 5 | or 6 | 7 | > install.packages("~/yourpath/oshinys_0.2-3.zip", repos = NULL, type = "source") 8 | 9 | Then install the additional required packages from CRAN: 10 | 11 | > install.packages(c("shiny", "deSolve", "scatterplot3d", "polspline")) 12 | 13 | Onced you have done the first insallation you can LAUNCH any app -- for example the Rozenzweig-MacArthur model -- 14 | through Starting R or Rstudio and type: 15 | 16 | > require(oshinys) 17 | 18 | > runApp(RM.app) 19 | 20 | This should start your browser with the shinyApp running. If you can't see any graphics make sure 21 | to maximize the browser window. 22 | 23 | 24 | If you have devtools installed you can alternatively build the package directly from the github source: 25 | 26 | require('devtools') 27 | devtools::install_github('objornstad/oshinys/source') 28 | -------------------------------------------------------------------------------- /source/DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: oshinys 2 | Title: Shiny Apps to Simulate Various Ecological and Epidemiological Models 3 | Version: 0.2-3 4 | Date: 2019-08-26 5 | Author: Ottar N. Bjornstad [aut, cre] 6 | Maintainer: Ottar N. Bjornstad 7 | Authors@R: person(c("Ottar", "N."), "Bjornstad", email = "onb1@psu.edu", role = c("aut", "cre")) 8 | Description: Shiny Apps to simulate various ecological and epidemiological models. Current models are: lpatribolium.app - LPA Tribolium model; lotkavolterracompetition.app - Lotka-Volterra competition model; lotkavolterrapredation.app - Lotka-Volterra predation model; nicholsonbailey.app - Nicholson-Bailey Host-Parasitoid model; negbinparasitoid.app - May's Negative-Binomial parasitoid-host model; ricker.app - The Ricker ("discrete logisitc model"); rosenzweigmacarthur.app - Rosenzweig-MacArthur Predator-Prey model; rossmacdonald.App - A simple Ross-Macdonald type malaria model; SEIR.app - the seasonally forced SEIR model; SEIRS.app - the unforced SEIRS model; SIR.app - the unforced SIR model; TSIR.app - the unforced TSIR model with demographic an environmental stochasticity 9 | Depends: 10 | R (>= 3.2.0), 11 | shiny, 12 | scatterplot3d, 13 | deSolve, 14 | polspline 15 | License: GPL-3 16 | URL: https://github.com/objornstad/ 17 | Encoding: UTF-8 18 | LazyData: true 19 | RoxygenNote: 6.1.1 20 | -------------------------------------------------------------------------------- /source/R/ricker.R: -------------------------------------------------------------------------------- 1 | #' Launch a shiny-app simulating the Ricker model 2 | #' @details 3 | #' Launch app for details 4 | #' @examples 5 | #' \dontrun{Ricker.app} 6 | #' @export 7 | ricker.app=shinyApp( 8 | # This creates the User Interface (UI) 9 | ui = pageWithSidebar( 10 | headerPanel("Ricker Model"), 11 | sidebarPanel( 12 | sliderInput("r", "Growth rate (r):", 1, 13 | min = 0, max = 4, step=.1), 14 | sliderInput("K", "Carrying capacity (K):", 100, 15 | min = 25, max = 200), 16 | numericInput("X0", "Initial number:", 70, 17 | min = 1, max = 200), 18 | numericInput("Tmax", "Tmax:", 20, 19 | min = 1, max = 500) 20 | ), 21 | 22 | mainPanel(tabsetPanel( 23 | tabPanel("Simulation", plotOutput("plot1", height = 500)), 24 | tabPanel("Details", 25 | withMathJax( 26 | helpText("MODEL:"), 27 | helpText("$$X_{t+1} = X_t \\mbox{exp}(r (1- X_t/K))$$"), 28 | helpText("REFERENCE: Ricker WE (1954) Stock and recruitment. 29 | Journal of Fishery Research Board Canada 11: 559-623"), 30 | helpText(eval(Attr)) 31 | ) 32 | ) 33 | ) 34 | ) 35 | ), 36 | 37 | # This creates the 'behind the scenes' code (Server) 38 | server = function(input, output) { 39 | logist = function(r, K, length = 200, X0=70){ 40 | X = rep(NA, length) #set up the empty vector of the right length 41 | X[1] = X0 #setting the abundance at time 1 to N0 42 | 43 | for(i in 2:length){ #iteratively updating the growth model. 44 | #next abundance is determined by previous abundance 45 | X[i] = X[i-1]*exp(r*(1-X[i-1]/K)) 46 | } 47 | return(X) #returning the simulated vector 48 | } 49 | 50 | 51 | 52 | output$plot1 <- renderPlot({ 53 | 54 | X= logist(r=input$r, K=input$K, length=input$Tmax, X0=input$X0) 55 | time = 1:input$Tmax 56 | par(mfrow=c(1,2)) 57 | plot(X, xlab = "time", ylab = "abundance", type="b") # making a time series plot 58 | curve(x*exp(input$r*(1-x/input$K)),0,input$K*3, xlab = "Xt-1", ylab = "Xt") 59 | abline(a=0, b=1) # adding the 1-to-1 line 60 | points(X[1:(input$Tmax-1)],X[2:input$Tmax], col = "red") # adding the points 61 | # from the simulation to the graph 62 | lines(X[1:(input$Tmax-1)], X[2:input$Tmax], col = "red") # adding the line to connect the points 63 | }) 64 | } 65 | ) 66 | 67 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | The oshinys R-package contains shinyApps of a variety of ecological and epidemiological models. 3 | 4 | The package REQUIRES shiny, 5 | scatterplot3d, 6 | deSolve, 7 | phaseR and 8 | polspline R-packages from CRAN to run. 9 | 10 | The source of the Apps are in /source/R/ 11 | ________________________________________ 12 | 13 | Easisest way to install is from within R do: 14 | 15 | install.packages(c("shiny", "deSolve", "scatterplot3d", "polspline", devtools)) 16 | 17 | require('devtools') 18 | 19 | devtools::install_github('objornstad/oshinys/source/') 20 | 21 | THEN launch any app from within R, for example: 22 | 23 | require('oshinys') 24 | 25 | runApp(rosenzweigmacarthur.app) 26 | 27 | 28 | IF you can't install devtools; see HOWTO for "manual" installation 29 | ________________________________________ 30 | 31 | The current models are: 32 | 33 | lpatribolium.app - LPA Tribolium model with a 2D and 3D phase plane 34 | 35 | lotkavolterracompetition.app - Lotka-Volterra competion model with phase plane and isoclines 36 | 37 | lotkavolterrapredation.app - Lotka-Volterra predation model with phase plane and isoclines 38 | 39 | negbinparasitoid.app - May's Negative-Binomial parasitoid-host model 40 | 41 | nicholsonbailey.app - Nicholson-Bailey Host-Parasitoid model 42 | 43 | ricker.app - The Ricker ("discrete logistic") model 44 | 45 | rosenzweigmacarthur.app - Rosenzweig-MacArthur Predator-Prey model with phase plane and isoclines 46 | 47 | rossmacdonald.App - A simple Ross-Macdonald type malaria model 48 | 49 | seir.app - the seasonally forced SEIR model in time and in the phase plane 50 | 51 | seirs.app - the unforced SEIRS model in time and in the phase plane with ressonant periodicity calculations 52 | 53 | sir.app - the unforced SIR model in time and in the phase plane with R0 calculations 54 | 55 | tsir.app - the unforced TSIR model with demographic an environmental stochasticity in time and in 56 | the phase plane and with simulated and transfer function derived periodograms 57 | 58 | ______________________________________ 59 | 60 | NEW! I'm working to embed the Apps in standalone Rmarkdown documents. See 61 | 62 | https://github.com/objornstad/ecomodelmarkdowns 63 | 64 | All these can be launced without compilation after downloading from Rstudio with "> Run Document". 65 | ________________________________ 66 | 67 | All code was written by Ottar N. Bjornstad (onb1@psu.edu) and is licensed under the CC-BY-NC Creative Commons attribution-noncommercial license (http://creativecommons.org/licenses/by-nc/3.0/). Please share & remix non-commercially, mentioning its origin. 68 | 69 | When change, modify and improve any of the apps, please update me with any improvements (as per the CC-BY-NC lisence). 70 | 71 | [![CRAN Status](https://www.r-pkg.org/badges/version/oshinys)](https://cran.r-project.org/package=oshinys) 72 | -------------------------------------------------------------------------------- /source/R/sir.R: -------------------------------------------------------------------------------- 1 | #' Launch a shiny-app simulating the SIR model 2 | #' @details 3 | #' Launch app for details 4 | #' @examples 5 | #' \dontrun{sir.app} 6 | #' @export 7 | sir.app=shinyApp( 8 | # This creates the User Interface (UI) 9 | ui <- pageWithSidebar( 10 | headerPanel("The SIR model"), 11 | sidebarPanel( 12 | sliderInput("beta", "Transmission (yr^-1):", 300, 13 | min = 0, max = 1000), 14 | sliderInput("infper", "Infectious period (days)", 5, 15 | min = 1, max = 100), 16 | sliderInput("mu", "birth rate (/year):", 5, 17 | min = 0, max = 100), 18 | sliderInput("T", "Time range:", 19 | min = 0, max = 1, value = c(0,1)) 20 | ), 21 | mainPanel( 22 | tabsetPanel( 23 | tabPanel("Time", plotOutput("plot1")), 24 | tabPanel("Phase plane", plotOutput("plot2", height = 500)), 25 | tabPanel("Equations", 26 | withMathJax( 27 | helpText("Susceptible $$\\frac{dS}{dt} = \\mu (N - S) - \\frac{\\beta I S}{N}$$"), 28 | helpText("Infecitous $$\\frac{dI}{dt} = \\frac{\\beta I S}{N} - (\\mu+\\sigma) I$$"), 29 | helpText("Removed $$\\frac{dR}{dt} = \\gamma I - \\mu R$$"), 30 | helpText("Reproductive ratio $$R_0 = \\frac{1}{\\gamma+\\mu} \\frac{\\beta N}{N}$$") 31 | )) 32 | 33 | ) 34 | ) 35 | ) 36 | , 37 | 38 | 39 | # This creates the 'behind the scenes' code (Server) 40 | server <- function(input, output) { 41 | sirmod=function(t, x, parms){ 42 | S=x[1] 43 | I=x[2] 44 | R=x[3] 45 | 46 | beta=parms["beta"] 47 | mu=parms["mu"] 48 | gamma=parms["gamma"] 49 | N=parms["N"] 50 | 51 | dS = mu * (N - S) - beta * S * I / N 52 | dI = beta * S * I / N - (mu + gamma) * I 53 | dR = gamma * I - mu * R 54 | res=c(dS, dI, dR) 55 | list(res) 56 | } 57 | 58 | output$plot1 <- renderPlot({ 59 | times = seq(0, input$T[2], by=1/1000) 60 | parms = c(mu = input$mu, N = 1, beta = input$beta, gamma = 61 | 365/input$infper) 62 | start = c(S=0.999, I=0.001, R = 0) 63 | R0 = round(with(as.list(parms), beta/(gamma+mu)), 1) 64 | 65 | AA=with(as.list(parms), 1/(mu*(R0-1))) 66 | GG=with(as.list(parms), 1/(mu+gamma)) 67 | rp=round(2*pi*sqrt(AA*GG),2) 68 | 69 | out=ode(y=start, 70 | times=times, 71 | func=sirmod, 72 | parms=parms) 73 | 74 | out=as.data.frame(out) 75 | 76 | sel=out$time>input$T[1]&out$timeinput$T[1]&out$timeinput$T[1]&out$time 1) { 125 | col <- col[1] 126 | message("Note: col has been reset as required") 127 | } 128 | if (!(arrow.type %in% c("proportional", "equal"))) { 129 | stop("arrow.type must be set to either \"proportional\" or \"equal\"") 130 | } 131 | if (arrow.head <= 0) { 132 | stop("arrow.head is less than or equal to zero") 133 | } 134 | if (frac <= 0) { 135 | stop("frac is less than or equal to zero") 136 | } 137 | if (!is.logical(add)) { 138 | stop("add must be logical") 139 | } 140 | state.names <- ifelse(system == "two.dim", c("x", "y"), "y") 141 | 142 | x <- seq(from = xlim[1], to = xlim[2], length = points) 143 | y <- seq(from = ylim[1], to = ylim[2], length = points) 144 | dx <- dy <- matrix(0, ncol = points, nrow = points) 145 | xmax.length <- x[2] - x[1] 146 | ymax.length <- y[2] - y[1] 147 | if (!add) { 148 | graphics::plot(1, xlim = c(xlim[1] - xmax.length, xlim[2] + xmax.length), 149 | ylim = c(ylim[1] - ymax.length, ylim[2] + ymax.length), 150 | type = "n", xlab = xlab, ylab = ylab, ...) 151 | } 152 | if (system == "one.dim") { 153 | for (i in 1:points) { 154 | dy[1, i] <- deriv(0, stats::setNames(c(y[i]), state.names), 155 | parameters)[[1]] 156 | } 157 | for (i in 2:points) { 158 | dy[i, ] <- dy[1, ] 159 | } 160 | abs.dy <- abs(dy) 161 | abs.dy.non <- abs.dy[which(abs.dy != 0)] 162 | max.abs.dy <- max(abs(dy)) 163 | coefficient <- 164 | frac*min(xmax.length, ymax.length)/ 165 | (2*sqrt(2)*max(sqrt(2*abs.dy.non/(abs.dy.non + (1/abs.dy.non))), 166 | sqrt(2*(1/abs.dy.non)/(abs.dy.non + (1/abs.dy.non))))) 167 | for (i in 1:points) { 168 | for (j in 1:points) { 169 | if (dy[i, j] != 0) { 170 | factor <- sqrt(2/(abs.dy[i, j] + (1/abs.dy[i, j]))) 171 | y.shift <- coefficient*factor*sqrt(abs.dy[i, j]) 172 | x.shift <- coefficient*factor/sqrt(abs.dy[i, j]) 173 | if (dy[i, j] < 0) { 174 | y.shift <- -y.shift 175 | } 176 | } else { 177 | y.shift <- 0 178 | x.shift <- coefficient*sqrt(2) 179 | } 180 | if (arrow.type == "proportional") { 181 | if (dy[i, j] != 0) { 182 | prop <- abs.dy[i, j]/max.abs.dy 183 | y.shift <- y.shift*prop 184 | x.shift <- x.shift*prop 185 | } else { 186 | x.shift <- y.shift*mean(abs.dy)/max.abs.dy 187 | } 188 | } 189 | graphics::arrows(x[i] - x.shift, y[j] - y.shift, x[i] + x.shift, 190 | y[j] + y.shift, length = arrow.head, col = col, ...) 191 | } 192 | } 193 | return(list(add = add, 194 | arrow.head = arrow.head, 195 | arrow.type = arrow.type, 196 | col = col, 197 | deriv = deriv, 198 | dy = dy, 199 | frac = frac, 200 | parameters = parameters, 201 | points = points, 202 | system = system, 203 | x = x, 204 | xlab = xlab, 205 | xlim = xlim, 206 | y = y, 207 | ylab = ylab, 208 | ylim = ylim)) 209 | } else { 210 | for (i in 1:length(x)) { 211 | for (j in 1:length(y)) { 212 | df <- deriv(0, stats::setNames(c(x[i], y[j]), state.names), 213 | parameters) 214 | dx[i, j] <- df[[1]][1] 215 | dy[i, j] <- df[[1]][2] 216 | } 217 | } 218 | abs.dx <- abs(dx) 219 | abs.dy <- abs(dy) 220 | abs.dx.non <- abs.dx[which(abs.dx != 0 & abs.dy != 0)] 221 | abs.dy.non <- abs.dy[which(abs.dx != 0 & abs.dy != 0)] 222 | max.length <- max(sqrt(dx^2 + dy^2)) 223 | coefficient <- 224 | frac*min(xmax.length, ymax.length)/ 225 | (2*sqrt(2)*max(sqrt(2*(abs.dy.non/abs.dx.non)/ 226 | ((abs.dy.non/abs.dx.non) + 227 | (abs.dx.non/abs.dy.non))), 228 | sqrt(2*(abs.dx.non/abs.dy.non)/ 229 | ((abs.dy.non/abs.dx.non) + 230 | (abs.dx.non/abs.dy.non))))) 231 | for (i in 1:points) { 232 | for (j in 1:points) { 233 | if (any(dx[i, j] != 0, dy[i, j] != 0)) { 234 | if (all(dx[i, j] != 0, dy[i, j] != 0)) { 235 | factor <- sqrt(2/((abs.dy[i, j]/abs.dx[i, j]) + 236 | (abs.dx[i, j]/abs.dy[i, j]))) 237 | y.shift <- coefficient*factor*sqrt(abs.dy[i, j]/abs.dx[i, j]) 238 | x.shift <- coefficient*factor/sqrt(abs.dy[i, j]/abs.dx[i, j]) 239 | if (dy[i, j] < 0) { 240 | y.shift <- -abs(y.shift) 241 | } 242 | if (dx[i, j] < 0) { 243 | x.shift <- -abs(x.shift) 244 | } 245 | } 246 | if (all(dx[i, j] == 0, dy[i, j] != 0)) { 247 | y.shift <- coefficient*sqrt(2) 248 | x.shift <- 0 249 | if (dy[i, j] < 0) { 250 | y.shift <- -abs(y.shift) 251 | } 252 | } 253 | if (all(dx[i, j] != 0, dy[i, j] == 0)) { 254 | y.shift <- 0 255 | x.shift <- coefficient*sqrt(2) 256 | if (dx[i, j] < 0) { 257 | x.shift <- -abs(x.shift) 258 | } 259 | } 260 | if (arrow.type == "proportional") { 261 | prop <- sqrt((abs.dx[i, j]^2 + abs.dy[i, j]^2))/max.length 262 | y.shift <- y.shift*prop 263 | x.shift <- x.shift*prop 264 | } 265 | graphics::arrows(x[i] - x.shift, y[j] - y.shift, x[i] + x.shift, 266 | y[j] + y.shift, length = arrow.head, col = col, ...) 267 | } 268 | } 269 | } 270 | } 271 | return(list(add = add, 272 | arrow.head = arrow.head, 273 | arrow.type = arrow.type, 274 | col = col, 275 | deriv = deriv, 276 | dx = dx, 277 | dy = dy, 278 | frac = frac, 279 | parameters = parameters, 280 | points = points, 281 | system = system, 282 | x = x, 283 | xlab = xlab, 284 | xlim = xlim, 285 | y = y, 286 | ylab = ylab, 287 | ylim = ylim)) 288 | } -------------------------------------------------------------------------------- /source/R/allapps3.R: -------------------------------------------------------------------------------- 1 | globalVariables("x") 2 | 3 | Attr=c("ATTRIBUTION: This App was written by Ottar N. Bjornstad (onb1@psu.edu) and is licensed under the Creative Commons attribution-noncommercial license (http://creativecommons.org/licenses/by-nc/3.0/). Please share & remix non-commercially, mentioning its origin: https://github.com/objornstad/oshinys") 4 | 5 | #' Launch a shiny-app simulating the LPA model 6 | #' @details 7 | #' Launch app for details 8 | #' @examples 9 | #' \dontrun{lpatribolium.app} 10 | #' @export 11 | #' @importFrom graphics abline curve legend lines plot title 12 | #' @importFrom shiny renderPlot 13 | #' @importFrom deSolve ode 14 | #' @importFrom scatterplot3d scatterplot3d 15 | #' @importFrom polspline lspec 16 | lpatribolium.app=shinyApp( 17 | # This creates the LPA User Interface (UI) 18 | ui = pageWithSidebar( 19 | tags$head(tags$style( 20 | HTML(' 21 | #sidebar1 { 22 | background-color: #ECECEC; 23 | } 24 | 25 | #sidebar2 { 26 | background-color: #ECECEC 27 | }') 28 | )), 29 | titlePanel("LPA model"), 30 | fluidRow( 31 | column(4, id = "sidebar2", 32 | fluidRow(column(5, id = "sidebar1", 33 | sliderInput("b", "b:", 6.598, 34 | min = 0, max = 10, step=0.1), 35 | sliderInput("cel", "cel:", 1.209e-2, 36 | min = 0, max = 1, step=0.01), 37 | sliderInput("cea", "cea:", 1.155e-2, 38 | min = 0, max = 1, step=0.01) 39 | ), 40 | column(5, offset = 1, id = "sidebar1", 41 | sliderInput("cpa", "cpa:", 4.7e-3, 42 | min = 0, max = 1, step=0.01), 43 | sliderInput("mua", "mua:", 7.629e-3, 44 | min = 0, max = 1, step=0.01), 45 | sliderInput("mul", "mul:", 0.2055, 46 | min = 0, max = 1, step=0.01) 47 | #numericInput("L0", "initial L:", 50, 48 | # min = 0, max = 100), 49 | #numericInput("P0", "initial P:", 0, 50 | # min = 0, max = 100), 51 | #numericInput("A0", "initial A:", 0, 52 | # min = 0, max = 100) 53 | ), 54 | column(1)), 55 | fluidRow( 56 | column(6, offset = 3, id = "sidebar1", 57 | sliderInput("T", "Time range:", 58 | min = 1, max = 500, value = c(1,500)), 59 | checkboxInput("li", "lines", TRUE)), 60 | column(3)) 61 | ), 62 | column(8, 63 | mainPanel( 64 | tabsetPanel( 65 | tabPanel("Time", plotOutput("plot1")), 66 | tabPanel("2D Phase plane", plotOutput("plot2")), 67 | tabPanel("3D Phase plane", plotOutput("plot3")), 68 | tabPanel("Details", 69 | withMathJax( 70 | helpText("MODEL:"), 71 | helpText("Larvae $$L_{t+1} = b A_t e^{-c_{ea}A_t}e^{-c_{el}L_t}$$"), 72 | helpText("Pupae $$P_{t+1} = (1-m_l)L_t$$"), 73 | helpText("Adults $$A_{t+1} = P_te^{-c_{pa}A_t} + (1-m_a)A_t$$"), 74 | helpText("REFERENCE: Costantino RF, Desharnais RA, Cushing JM, Dennis B (1997) Chaotic dynamics 75 | in an insect population. Science 275: 389-391"), 76 | helpText(eval(Attr)) 77 | ))) 78 | ))) 79 | ), 80 | 81 | # This creates the 'behind the scenes' code (Server) 82 | server <- function(input, output) { 83 | 84 | lpa = function(b=6.598, cel=1.209e-2, cea=1.155e-2, mul=0.2055, 85 | cpa=4.7e-3, mua=7.629e-3, init=c(50,0,0), T=500){ 86 | #Initiate empty matrix to hold simulation 87 | res = matrix(NA, nrow=500, ncol=3) 88 | 89 | #Add column names 90 | dimnames(res) = list(NULL, c("L", "P", "A")) 91 | 92 | #store initial conditions in first row 93 | res[1,] = init 94 | 95 | for(i in 2:T){ 96 | #Larval equation 97 | res[i,1] = b*res[i-1,3]*exp(-cel*res[i-1,1]-cea*res[i-1,3]) 98 | #Pupal equation 99 | res[i,2] = res[i-1,1]*(1-mul) 100 | #Adult equation 101 | res[i,3] = res[i-1,2]*exp(-cpa*res[i-1,3])+res[i-1,3]*(1-mua) 102 | } 103 | return(res) 104 | } 105 | 106 | output$plot1 <- renderPlot({ 107 | out=lpa(b=input$b, cel=input$cel, cea=input$cea, mul=input$mul, 108 | cpa=input$cpa, mua=input$mua) 109 | 110 | 111 | plot(input$T[1]:input$T[2], out[input$T[1]:input$T[2],3], type = "b", xlab = "Week", 112 | ylab = "Abundance", xlim=input$T, ylim=c(0, max(out[input$T[1]:input$T[2],c(1,3)]))) 113 | lines(input$T[1]:input$T[2], out[input$T[1]:input$T[2],1], col=2) 114 | legend("topleft", 115 | legend=c("A", "L"), 116 | lty=c(1,1), 117 | pch=c(1,NA), 118 | col=c("black", "red")) 119 | 120 | }) 121 | 122 | output$plot2 <- renderPlot({ 123 | out=lpa(b=input$b, cel=input$cel, cea=input$cea, mul=input$mul, 124 | cpa=input$cpa, mua=input$mua) 125 | 126 | 127 | plot(out[input$T[1]:input$T[2],1], out[input$T[1]:input$T[2],3], type = ifelse(input$li==TRUE, "b", "p"), xlab = "L", 128 | ylab = "A", xlim=c(0, max(out[input$T[1]:input$T[2],1])), 129 | ylim=c(0, max(out[input$T[1]:input$T[2],3]))) 130 | 131 | }) 132 | 133 | output$plot3 <- renderPlot({ 134 | out=lpa(b=input$b, cel=input$cel, cea=input$cea, mul=input$mul, 135 | cpa=input$cpa, mua=input$mua) 136 | 137 | scatterplot3d(x=out[input$T[1]:input$T[2],1], y=out[input$T[1]:input$T[2],2], 138 | z=out[input$T[1]:input$T[2],3], type = ifelse(input$li==TRUE, "b", "p"), xlim=c(0, max(out[input$T[1]:input$T[2],1])), 139 | ylim=c(0, max(out[input$T[1]:input$T[2],2])), 140 | zlim=c(0, max(out[input$T[1]:input$T[2],3])), 141 | xlab="L", ylab="P", zlab="A") 142 | 143 | }) 144 | 145 | 146 | } 147 | ) 148 | 149 | #' Launch a shiny-app simulating the Lotka-Volterra competition model 150 | #' @details 151 | #' Launch app for details 152 | #' @examples 153 | #' \dontrun{lotkavolterracompetition.app} 154 | #' @export 155 | lotkavolterracompetition.app=shinyApp(ui = fluidPage( 156 | # This creates the User Interface (UI) 157 | tags$head(tags$style( 158 | HTML(' 159 | #sidebar1 { 160 | background-color: #D3D3D3; 161 | } 162 | 163 | #sidebar2 { 164 | background-color: #D3D3D3 165 | }') 166 | )), 167 | titlePanel("Lotka-Volterra competition model"), 168 | fluidRow( 169 | column(4, id = "sidebar2", 170 | fluidRow(column(5, id = "sidebar1", 171 | sliderInput("r1", "r1:", 0.3, 172 | min = 0, max = 1, step=0.01), 173 | sliderInput("a", "alpha12:", 0.3, 174 | min = 0, max = 1, step=0.01), 175 | sliderInput("K1", "K1:", 150, 176 | min = 0, max = 300, step=1), 177 | numericInput("N1", "initial N1:", 10, 178 | min = 0, max = 1000)), 179 | column(5, offset = 1, id = "sidebar1", 180 | sliderInput("r2", "r2:", 0.5, 181 | min = 0, max = 1, step=0.01), 182 | sliderInput("b", "alpha21:", 0.7, 183 | min = 0, max = 1, step=0.01), 184 | sliderInput("K2", "K2:", 100, 185 | min = 0, max = 300, step=1), 186 | numericInput("N2", "initial N2:", 15, 187 | min = 0, max = 1000)), 188 | column(1)), 189 | fluidRow( 190 | column(6, offset = 3, id = "sidebar1", 191 | numericInput("Tmax", "Tmax:", 100, 192 | min = 0, max = 200)), 193 | column(3)) 194 | ), 195 | column(8, tabsetPanel( 196 | tabPanel("Simulation", plotOutput("plot1")), 197 | tabPanel("Details", 198 | withMathJax( 199 | helpText("MODEL:"), 200 | helpText("Species 1 $$\\frac{dN_1}{dt} = r_1 N_1 (\\frac{K_1-N_1-\\alpha_{12} N_2}{K_1})$$"), 201 | helpText("Species 2 $$\\frac{dN_2}{dt} = r_2 N_2 (\\frac{K_2-N_2-\\alpha_{21} N_1}{K_2})$$"), 202 | helpText("N_1-isocline $$N_2 = \\frac{K_1 - N_1}{\\alpha_{12}}$$"), 203 | helpText("N_2-isocline $$N_2 = K_2 - \\alpha_{21} N_1$$"), 204 | helpText("Equilibria:"), 205 | helpText("$$N_1^* = \\frac{K_1-\\alpha_{21} K_2}{1-\\alpha_{12} \\alpha_{21}}$$"), 206 | helpText("$$N_2^* = \\frac{K_2-\\alpha_{21} K_1}{1-\\alpha_{12} \\alpha_{21}}$$")), 207 | helpText(eval(Attr)) 208 | ) 209 | ) 210 | )) 211 | ), 212 | 213 | 214 | # This creates the "behind the scenes" code (Server) 215 | server = function(input, output) { 216 | compLV=function(t, y, parameters){ 217 | N1=y[1] 218 | N2=y[2] 219 | 220 | with(as.list(parameters),{ 221 | dN1 = r1*N1*((K1-N1-a*N2)/K1) 222 | dN2 = r2*N2*((K2-N2-b*N1)/K2) 223 | res=c(dN1, dN2) 224 | list(res) 225 | }) 226 | } 227 | 228 | output$plot1 <- renderPlot({ 229 | N1star=(input$K1-input$a*input$K2)/(1-input$a*input$b) 230 | N2star=(input$K2-input$b*input$K1)/(1-input$a*input$b) 231 | 232 | 233 | times = seq(0, input$Tmax, by=0.1) 234 | parms=c(r1=input$r1, r2=input$r2,a=input$a,b=input$b, 235 | K1=input$K1,K2=input$K2) 236 | xstart = c(N1=input$N1, N2=input$N2) 237 | 238 | out=ode(y=xstart, 239 | times=times, 240 | func=compLV, 241 | parms=parms) 242 | 243 | out=as.data.frame(out) 244 | 245 | 246 | par(mfrow=c(1,2)) #This puts two plots side by side each other 247 | plot(times, out$N1, ylab="abundance", xlab="time", type="l", 248 | ylim=range(out[,2:3])) 249 | lines(times, out$N2, col="red") 250 | legend("topright", 251 | legend=c("N1", "N2"), 252 | lty=c(1,1), 253 | col=c("black", "red")) 254 | 255 | plot(NA,xlim=c(0,input$K1*2),ylim=c(0,input$K2*2), xlab="N1", ylab="N2") 256 | fld=flowField(compLV, xlim=c(0,input$K1*2), ylim=c(0,input$K2*2), 257 | parameters=parms, system="two.dim", add=TRUE) 258 | 259 | #null clines 260 | curve((input$K1-x)/input$a,col="black",add=TRUE) 261 | curve(input$K2-input$b*x,col="red",add=TRUE) 262 | abline(v=0,col="black") 263 | abline(h=0,col="red") 264 | points(0,0,pch=19) 265 | points(input$K1,0,pch=19) 266 | points(0,input$K2,pch=19) 267 | if(!any(c(N1star, N2star)<0)) points(N1star,N2star,pch=19) 268 | lines(out[,2], out[,3], lwd=2) 269 | }) 270 | } 271 | ) 272 | 273 | #' Launch a shiny-app simulating the Lotka-Volterra predation model 274 | #' @details 275 | #' Launch app for details 276 | #' @examples 277 | #' \dontrun{lotkavolterrapredation.app} 278 | #' @export 279 | lotkavolterrapredation.app=shinyApp( 280 | # This creates the User Interface (UI) 281 | ui = fluidPage( 282 | tags$head(tags$style( 283 | HTML(" 284 | #sidebar1 { 285 | background-color: #ECECEC; 286 | } 287 | 288 | #sidebar2 { 289 | background-color: #ECECEC 290 | }") 291 | )), 292 | titlePanel("Lotka-Volterra predation model"), 293 | fluidRow( 294 | column(4, id = "sidebar2", 295 | fluidRow(column(5, id = "sidebar1", 296 | sliderInput("r", "r:", 0.6, 297 | min = 0, max = 1, step=0.01), 298 | sliderInput("a", "a:", 0.1, 299 | min = 0, max = 1, step=0.01), 300 | numericInput("N0", "initial N:", 10, 301 | min = 0, max = 100)), 302 | column(5, offset = 1, id = "sidebar1", 303 | sliderInput("b", "b:", 0.1, 304 | min = 0, max = 1, step=0.01), 305 | sliderInput("m", "m:", 0.2, 306 | min = 0, max = 1, step=0.01), 307 | numericInput("P0", "initial P:", 10, 308 | min = 0, max = 100)), 309 | column(1)), 310 | fluidRow( 311 | column(6, offset = 3, id = "sidebar1", 312 | numericInput("Tmax", "Tmax:", 100, 313 | min = 0, max = 200)), 314 | column(3)) 315 | ), 316 | mainPanel(tabsetPanel( 317 | tabPanel("Simulation", plotOutput("plot1", height = 500)), 318 | tabPanel("Details", 319 | withMathJax( 320 | helpText("MODEL:"), 321 | helpText("Prey $$\\frac{dN}{dt} = r N - a N P$$"), 322 | helpText("Predator $$\\frac{dP}{dt} = b a N P - m P$$"), 323 | helpText("N-isocline $$P^* = r/a$$"), 324 | helpText("P-isocline $$N^* = g/b$$"), 325 | helpText("Equilibria $$N^* = g/b, P^* = r/a$$"))), 326 | helpText(eval(Attr)) 327 | ) 328 | ) 329 | ) 330 | ), 331 | 332 | # This creates the "behind the scenes" code (Server) 333 | server = function(input, output) { 334 | LV=function(t, y, parameters){ 335 | N=y[1] 336 | P=y[2] 337 | 338 | with(as.list(parameters),{ 339 | dN = r*N-a*N*P 340 | dP =b*a*N*P-m*P 341 | res=c(dN, dP) 342 | list(res) 343 | }) 344 | } 345 | 346 | output$plot1 <- renderPlot({ 347 | Nstar=input$m/(input$b*input$a) 348 | Pstar=input$r/input$a 349 | 350 | times = seq(0, input$Tmax, by=0.1) 351 | parms=c(r=input$r,a=input$a,b=input$b,m=input$m) 352 | xstart = c(N=input$N0, P=input$P0) 353 | 354 | out=ode(y=xstart, 355 | times=times, 356 | func=LV, 357 | parms=parms) 358 | 359 | out=as.data.frame(out) 360 | 361 | 362 | par(mfrow=c(1,2)) #This puts two plots side by side each other 363 | plot(times, out$N, ylab="abundance", xlab="time", type="l", ylim=range(out[,1:2])) 364 | lines(times, out$P, col="red") 365 | legend("right", 366 | legend=c("N", "P"), 367 | lty=c(1,1), 368 | col=c("black", "red")) 369 | 370 | plot(out$N, out$P, ylab="predator", xlab="prey", type="l", xlim=range(out[,2]), ylim=range(out[,3])) 371 | abline(h=Pstar, col = "black") 372 | abline(v=Nstar, col = "red") 373 | fld=flowField(LV, xlim=range(out[,2]), ylim=range(out[,3]), 374 | parameters=parms, system="two.dim", add=TRUE) 375 | points(0,0,pch = 1) 376 | points(Nstar,Pstar, pch = 19) 377 | }) 378 | } 379 | ) 380 | 381 | #' Launch a shiny-app simulating May's Parasitoid-host Model model 382 | #' @details 383 | #' Launch app for details 384 | #' @examples 385 | #' \dontrun{negbinparasitoid.app} 386 | #' @export 387 | negbinparasitoid.app=shinyApp( 388 | # This creates the User Interface (UI) 389 | # This creates the User Interface (UI) 390 | ui = pageWithSidebar( 391 | headerPanel("May's Parasitoid-host Model"), 392 | sidebarPanel( 393 | sliderInput("R", "Growth rate (R):", 1.1, 394 | min = 1, max = 2, step=.01), 395 | sliderInput("a", "Search efficiency (a):", 0.1, 396 | min = 0, max = .5), 397 | sliderInput("k", "aggregation (k):", 1.5, 398 | min = 0.1, max = 3, step=0.1), 399 | numericInput("P0", "Initial parasitoid:", 10, 400 | min = 1, max = 100), 401 | numericInput("H0", "Initial host:", 20, 402 | min = 1, max = 100), 403 | numericInput("Tmax", "Tmax:", 100, 404 | min = 1, max = 500) 405 | ), 406 | mainPanel(tabsetPanel( 407 | tabPanel("Simulation", plotOutput("plot1", height = 500)), 408 | tabPanel("Phase plane", plotOutput("plot2", height = 500)), 409 | tabPanel("Details", 410 | withMathJax( 411 | helpText("MODEL:"), 412 | helpText("Host $$H_t = R H_{t-1} (1 + a P_{t-1}/k)^{-k}$$"), 413 | helpText("Parasitoid $$P_t = R H_{t-1} (1-(1 + a P_{t-1}/k)^{-k})$$"), 414 | helpText("REFERENCE: May RM (1978) Host-parasitoid systems in patchy 415 | environments: a phenomenological model. J Anim Ecol 47: 833-843"), 416 | helpText(eval(Attr)) 417 | ) 418 | ) 419 | ) 420 | ) 421 | ), 422 | 423 | # This creates the 'behind the scenes' code (Server) 424 | server = function(input, output) { 425 | NB = function(R, a, k, T = 100, H0 = 10, P0 = 1){ 426 | #T is length of simulation (number of time-steps) 427 | #H0 and P0 are initial numbers 428 | #we provide default parameters except for R and a 429 | 430 | H=rep(NA, T) #host series 431 | P=rep(NA, T) #parasitoid series 432 | 433 | H[1] = H0 #Initiating the host series 434 | P[1] = P0 #Initiating the host series 435 | 436 | for(t in 2:T){ 437 | H[t] = R * H[t-1] * (1+ a * P[t-1]/k)^(-k) 438 | P[t] = R * H[t-1] * (1-(1+ a * P[t-1]/k)^(-k)) 439 | if(P[t-1]==0) break 440 | } #end of loop 441 | 442 | #the two vectors of results are stored in a "list" 443 | res= data.frame(H = H, P = P) 444 | 445 | #the list is passed out of this function 446 | return(res) 447 | } #end of function 448 | 449 | 450 | 451 | output$plot1 <- renderPlot({ 452 | 453 | sim= NB(R=input$R, a=input$a, k=input$k, H0=input$H0, P0=input$P0, T=input$Tmax) 454 | time = 1:input$Tmax 455 | 456 | plot(time, sim$H, type= "b",xlab = "Generations", ylab = "Abundance", 457 | ylim = range(sim, na.rm=TRUE)) 458 | points(time, sim$P, type = "b", col = "red") 459 | legend("topleft", 460 | legend=c("H", "P"), 461 | lty=c(1,1), 462 | pch=c(1,1), 463 | col=c("black", "red")) 464 | }) 465 | 466 | output$plot2 <- renderPlot({ 467 | 468 | sim= NB(R=input$R, a=input$a, k=input$k, H0=input$H0, P0=input$P0, T=input$Tmax) 469 | time = 1:input$Tmax 470 | 471 | plot(sim$H, sim$P, type= "b",xlab = "Host", ylab = "Parasitoid") 472 | #Pstar=input$k*(input$R^(1/input$k)-1)/input$a 473 | #Hstar=Pstar*input$R/(input$R-1) 474 | #points(Hstar, Pstar, col=2, pch=19) 475 | }) 476 | } 477 | ) 478 | 479 | #' Launch a shiny-app simulating the Nicholson-Bailey model 480 | #' @details 481 | #' Launch app for details 482 | #' @examples 483 | #' \dontrun{nicholsonbailey.app} 484 | #' @export 485 | nicholsonbailey.app=shinyApp( 486 | # This creates the NB User Interface (UI) 487 | ui = pageWithSidebar( 488 | headerPanel("Nicholson-Bailey Model"), 489 | sidebarPanel( 490 | sliderInput("R", "Growth rate (R):", 1.1, 491 | min = 1, max = 2, step=.01), 492 | sliderInput("a", "Search efficiency (a):", 0.03, 493 | min = 0, max = .5), 494 | numericInput("P0", "Initial parasitoid:", 10, 495 | min = 1, max = 100), 496 | numericInput("H0", "Initial host:", 20, 497 | min = 1, max = 100), 498 | numericInput("Tmax", "Tmax:", 100, 499 | min = 1, max = 500) 500 | ), 501 | mainPanel(tabsetPanel( 502 | tabPanel("Simulation", plotOutput("plot1", height = 500)), 503 | tabPanel("Phase plane", plotOutput("plot2", height = 500)), 504 | tabPanel("Details", 505 | withMathJax( 506 | helpText("MODEL:"), 507 | helpText("Host $$H_t = R H_{t-1} (1 - \\mbox{exp}(- a P_{t-1}))$$"), 508 | helpText("Parasitoid $$P_t = R H_{t-1} \\mbox{exp}(- a P_{t-1})$$"), 509 | helpText("Equilibria $$H^* = \\frac{\\mbox{log}(R)}{a (R-1)}, 510 | P^* = \\frac{\\mbox{log}(R)}{a}$$"))), 511 | helpText("REFERENCE: Nicholson AJ, Bailey VA (1935) The balance of animal populations. 512 | Proceedings of the Zoological Society of London 3: 551-598"), 513 | helpText(eval(Attr)) 514 | ) 515 | ) 516 | ), 517 | 518 | 519 | # This creates the 'behind the scenes' code (Server) 520 | server = function(input, output) { 521 | NB = function(R, a, T = 100, H0 = 10, P0 = 1){ 522 | #T is length of simulation (number of time-steps) 523 | #H0 and P0 are initial numbers 524 | #we provide default parameters except for R and a 525 | 526 | H=rep(NA, T) #host series 527 | P=rep(NA, T) #parasitoid series 528 | 529 | H[1] = H0 #Initiating the host series 530 | P[1] = P0 #Initiating the host series 531 | 532 | for(t in 2:T){ 533 | H[t] = R * H[t-1] * exp(- a * P[t-1]) 534 | P[t] = R * H[t-1] * (1-exp(- a * P[t-1])) 535 | if(P[t-1]==0) break 536 | } #end of loop 537 | 538 | #the two vectors of results are stored in a "list" 539 | res= data.frame(H = H, P = P) 540 | 541 | #the list is passed out of this function 542 | return(res) 543 | } #end of function 544 | 545 | 546 | 547 | output$plot1 <- renderPlot({ 548 | 549 | sim= NB(R=input$R, a=input$a, H0=input$H0, P0=input$P0, T=input$Tmax) 550 | time = 1:input$Tmax 551 | 552 | plot(time, sim$H, type= "b",xlab = "Generations", ylab = "Abundance", 553 | ylim = range(sim, na.rm=TRUE)) 554 | points(time, sim$P, type = "b", col = "red") 555 | legend("topleft", 556 | legend=c("H", "P"), 557 | lty=c(1,1), 558 | pch=c(1,1), 559 | col=c("black", "red")) 560 | }) 561 | 562 | 563 | output$plot2 <- renderPlot({ 564 | 565 | sim= NB(R=input$R, a=input$a, H0=input$H0, P0=input$P0, T=input$Tmax) 566 | time = 1:input$Tmax 567 | Hstar=log(input$R)/(input$a*(input$R-1)) 568 | Pstar=log(input$R)/input$a 569 | plot(sim$H, sim$P, type= "b",xlab = "Host", ylab = "Parasitoid") 570 | points(Hstar, Pstar, col=2, pch=19) 571 | }) 572 | 573 | } 574 | ) 575 | 576 | #' Launch a shiny-app simulating the Rosenzweig-MacArthur model 577 | #' @details 578 | #' Launch app for details 579 | #' @examples 580 | #' \dontrun{rosenzweigmacarthur.app} 581 | #' @export 582 | rosenzweigmacarthur.app=shinyApp( 583 | # This creates the User Interface (UI) 584 | ui = fluidPage( 585 | tags$head(tags$style( 586 | HTML(' 587 | #sidebar1 { 588 | background-color: #ECECEC; 589 | } 590 | 591 | #sidebar2 { 592 | background-color: #ECECEC 593 | }') 594 | )), 595 | titlePanel("Rosenzweig-MacArthur model"), 596 | fluidRow( 597 | column(4, id = "sidebar2", 598 | fluidRow(column(5, id = "sidebar1", 599 | sliderInput("r", "r:", 0.1, 600 | min = 0, max = 1, step=0.01), 601 | sliderInput("K", "K:", 30, 602 | min = 0, max = 300, step=1), 603 | sliderInput("a", "a:", 0.2, 604 | min = 0, max = 1, step=0.01), 605 | numericInput("N", "initial N:", 10, 606 | min = 0, max = 100)), 607 | column(5, offset = 1, id = "sidebar1", 608 | sliderInput("c", "c:", 20, 609 | min = 0, max = 100, step=0.1), 610 | sliderInput("b", "b:", 0.1, 611 | min = 0, max = 1, step=0.01), 612 | sliderInput("g", "g:", 0.05, 613 | min = 0, max = 1, step=0.01), 614 | numericInput("P", "initial P:", 1, 615 | min = 0, max = 100)), 616 | column(1)), 617 | fluidRow( 618 | column(6, offset = 3, id = "sidebar1", 619 | numericInput("Tmax", "Tmax:", 1000, 620 | min = 0, max = 5000)), 621 | column(3)) 622 | ), 623 | #column(8, plotOutput("plot1", height = 500)) 624 | column(8, tabsetPanel( 625 | tabPanel("Time", plotOutput("plot1")), 626 | tabPanel("Phase plane", plotOutput("plot2")), 627 | tabPanel("Details", 628 | withMathJax( 629 | helpText("MODEL:"), 630 | helpText("Prey $$\\frac{dN}{dt} = r N (1-\\frac{N}{K}) - \\frac{a N P}{c+N}$$"), 631 | helpText("Predator $$\\frac{dP}{dt} = \\frac{b N P}{c+N} - g P$$"), 632 | helpText("N-isocline $$P^* = (r-rN/K)(c+N)/a$$"), 633 | helpText("P-isocline $$N^* = gc/(b-g)$$"), 634 | helpText("Equilibria $$N^* = gc/(b-g), P^* = (r-rN^*/K)(c+N^*)/a$$"), 635 | helpText("REFERENCE: Rosenzweig ML, MacArthur RH (1963) Graphical representation 636 | and stability conditions of predator-prey interactions. Am Nat 97: 209-223"), 637 | helpText(eval(Attr)) 638 | )) 639 | 640 | 641 | ) 642 | ) 643 | ) 644 | ), 645 | 646 | # This creates the "behind the scenes" code (Server) 647 | server = function(input, output){ 648 | RM=function(t, y, parameters){ 649 | N=y[1] 650 | P=y[2] 651 | 652 | r=parameters["r"] 653 | K=parameters["K"] 654 | a=parameters["a"] 655 | c=parameters["c"] 656 | b=parameters["b"] 657 | g=parameters["g"] 658 | 659 | dN = r*N*(1-N/K)-a*N*P/(c+N) 660 | dP = b*N*P/(c+N)-g*P 661 | res=c(dN,dP) 662 | list(res) 663 | } 664 | 665 | output$plot1 <- renderPlot({ 666 | 667 | times = seq(0, input$Tmax, by=0.1) 668 | parms=c(r=input$r, K=input$K,a=input$a, 669 | c=input$c,b=input$b,g=input$g) 670 | xstart = c(N=input$N, P=input$P) 671 | 672 | out=ode(y=xstart, 673 | times=times, 674 | func=RM, 675 | parms=parms) 676 | 677 | out=as.data.frame(out) 678 | 679 | r=parms["r"] 680 | K=parms["K"] 681 | a=parms["a"] 682 | c=parms["c"] 683 | b=parms["b"] 684 | g=parms["g"] 685 | 686 | 687 | plot(out$time, out$N, ylab="abundance", xlab="time", type="l", ylim=range(out[,2:3])) 688 | lines(out$time, out$P, col="red") 689 | legend("topright", 690 | legend=c("N", "P"), 691 | lty=c(1,1), 692 | col=c("black", "red")) 693 | }) 694 | 695 | output$plot2 <- renderPlot({ 696 | 697 | times = seq(0, input$Tmax, by=0.1) 698 | parms=c(r=input$r, K=input$K,a=input$a, 699 | c=input$c,b=input$b,g=input$g) 700 | xstart = c(N=input$N, P=input$P) 701 | 702 | out=ode(y=xstart, 703 | times=times, 704 | func=RM, 705 | parms=parms) 706 | 707 | out=as.data.frame(out) 708 | 709 | r=parms["r"] 710 | K=parms["K"] 711 | a=parms["a"] 712 | c=parms["c"] 713 | b=parms["b"] 714 | g=parms["g"] 715 | 716 | #null clines 717 | plot(out$N, out$P, ylab='predator', xlab='prey', type='l', 718 | xlim=range(out$N), ylim= range(out$P)) 719 | abline(h=0, col = "green") 720 | abline(v=0, col = "red") 721 | curve(r*(1-x/K)*(c+x)/a,from = 0, to = max(c(90, out$N)), col = "green",add=T) 722 | abline(v=g*c/(b-g),col = "red") 723 | fld=flowField(RM, xlim=range(out$N), ylim=range(out$P), 724 | parameters=parms, system="two.dim", add=TRUE) 725 | legend("topright", 726 | legend=c("N-iso", "P-iso"), 727 | lty=c(1,1), 728 | col=c("green", "red")) 729 | 730 | # points(Nstar,Pstar,pch = 1) 731 | 732 | }) 733 | 734 | 735 | } 736 | ) 737 | 738 | #' Launch a shiny-app simulating the Ross-Macdonald malaria model 739 | #' @details 740 | #' Launch app for details 741 | #' @examples 742 | #' \dontrun{rossmacdonald.app} 743 | #' @export 744 | rossmacdonald.app=shinyApp( 745 | # This creates the User Interface (UI) 746 | ui <- pageWithSidebar( 747 | headerPanel(""), 748 | sidebarPanel( 749 | sliderInput("gamma", "gamma", 1/7, 750 | min = 0, max = 1), 751 | sliderInput("a", "a", 1/4, 752 | min = 0, max = 1), 753 | sliderInput("b", "b", 0.5, 754 | min = 0, max = 1), 755 | sliderInput("c", "c", 0.9, 756 | min = 0, max = 1), 757 | sliderInput("mu", "mu", 1/7, 758 | min = 0, max = 1), 759 | sliderInput("m", "m", 10, 760 | min = 1, max = 100) 761 | ), 762 | 763 | mainPanel(tabsetPanel( 764 | tabPanel("Phase plane", plotOutput("plot1", height = 500)), 765 | tabPanel("Details", 766 | withMathJax( 767 | helpText("MODEL:"), 768 | helpText("$$dx/dt = (a b Y / X) y (1-x) -\\gamma x$$"), 769 | helpText("$$dy/dt = a c x (1-y)- \\mu y,$$"), 770 | div("where x is the fraction of infected humans, y is fraction of infected mosquitos, m = Y/X is mosquito-to-human ratio, gamma is human recovery rate, 1/mu is mosquito life expectancy, a is biting rate (1 / gonotrophic-cycle), b is human probability of getting infected by infected mosquito, c is probability of mosquito infection from infected human."), 771 | helpText("ISOCLINES:"), 772 | helpText("$$x^*=\\gamma x / (a b m)(1-x)$$"), 773 | helpText("$$y^* =a c x / (a c x + \\mu)$$"), 774 | helpText("$$R_0 = m a^2 b c / \\mu \\gamma$$"), 775 | helpText("REFERENCE: Macdonald, G. (1957). The epidemiology and control of malaria. The Epidemiology and Control of Malaria. CaB direct"), 776 | helpText(eval(Attr)) 777 | ) 778 | ) 779 | ) 780 | ) 781 | ), 782 | 783 | # This creates the 'behind the scenes' code (Server) 784 | server <- function(input, output) { 785 | grfn=function(t, y, parameters){ 786 | X=y[1] 787 | Y=y[2] 788 | with(as.list(parameters),{ 789 | dx=a*b*m*Y*(1-X)-gamma*X 790 | dy=a*c*X*(1-Y)-mu*Y 791 | gr=c(dx, dy) 792 | list(gr) 793 | }) 794 | } 795 | 796 | 797 | output$plot1 <- renderPlot({ 798 | times=seq(0, 365*2, by=.1) 799 | 800 | parameters = c(gamma = input$gamma, a = input$a, b=input$b, c=input$c, mu=input$mu, m=input$m) 801 | start=c(0.01, 0.01) 802 | 803 | out=ode(y=start, 804 | times=times, 805 | func=grfn, 806 | parms=parameters) 807 | 808 | out=as.data.frame(out) 809 | 810 | with(as.list(parameters),{ 811 | curve(gamma*x/((a*b*m)*(1-x)), 0,1, ylim=c(0,1), xlab="x", ylab="y") 812 | R0=m*a^2*b*c/(mu*gamma) 813 | title(paste ("R0=", round(R0,2))) 814 | curve(a*c*x/(a*c*x+mu), 0,1, add=TRUE, col="red") 815 | fld=flowField(grfn, xlim=c(0,1), ylim=c(0,1), 816 | parameters=parameters, system="two.dim", add=TRUE, 817 | ylab="H", xlab="M") 818 | 819 | }) 820 | points(out[,2], out[, 3]) 821 | legend("topleft", c("H isocline", "M isocline", "Trajectory"), lty=c(1,1,0), col=c(1,2, 1), pch=c(NA,NA, 1)) 822 | }) 823 | } 824 | ) 825 | 826 | #' Launch a shiny-app simulating the seasonal SEIR model 827 | #' @details 828 | #' Launch app for details 829 | #' @examples 830 | #' \dontrun{seir.app} 831 | #' @export 832 | seir.app=shinyApp( 833 | # This creates the User Interface (UI) 834 | ui = pageWithSidebar( 835 | headerPanel("Seasonally forced SEIR"), 836 | sidebarPanel( 837 | sliderInput("beta0", "Transmission (yr^-1):", 1000, 838 | min = 0, max = 3000), 839 | sliderInput("beta1", "Seasonality:", 0, 840 | min = 0, max = 1), 841 | sliderInput("Ip", "Infectious period (days)", 5, 842 | min = 1, max = 100), 843 | sliderInput("oneoversigma", "Latent period (days):", 8, 844 | min = 1, max = 100), 845 | sliderInput("mu", "birth rate (per 1000):", 0.02, 846 | min = 0, max = .1), 847 | sliderInput("T", "Time range:", 848 | min = 0, max = 100, value = c(0,20)), 849 | checkboxInput("lg", "un-Log", TRUE) 850 | ), 851 | mainPanel( 852 | tabsetPanel( 853 | tabPanel("Time", plotOutput("plot1")), 854 | tabPanel("Phase plane", plotOutput("plot2")), 855 | tabPanel("Details", 856 | withMathJax( 857 | helpText("MODEL:"), 858 | helpText("Susceptible $$\\frac{dS}{dt} = \\mu (N - S) - \\frac{\\beta(t) I S}{N}$$"), 859 | helpText("Exposed $$\\frac{dE}{dt} = \\frac{\\beta(t) I S}{N} - (\\mu+\\sigma) E$$"), 860 | helpText("Infectious $$\\frac{dI}{dt} = \\sigma E - (\\mu+\\gamma) I$$"), 861 | helpText("Removed $$\\frac{dR}{dt} = \\gamma I - \\mu R$$"), 862 | helpText("Seasonality $$\\beta(t) = \\beta_0 (1 + \\beta_1 cos(2 \\pi t))$$"), 863 | helpText("Reproductive ratio $$R_0 = \\frac{\\sigma}{\\sigma +\\mu} \\frac{1}{\\gamma+\\mu} \\frac{\\beta N}{N}$$"), 864 | helpText("REFERENCE: Earn DJD, Rohani P, Bolker BM, Grenfell BT (2000) A simple model for complex dynamical transitions in epidemics. 865 | Science 287: 667-670"), 866 | helpText(eval(Attr)) 867 | )) 868 | 869 | ) 870 | ) 871 | ), 872 | 873 | # This creates the 'behind the scenes' code (Server) 874 | server = function(input, output) { 875 | seirmod2=function(t, x, params){ 876 | S=x[1] 877 | E=x[2] 878 | I=x[3] 879 | R=x[4] 880 | 881 | mu=params["mu"] 882 | N=params["N"] 883 | beta0=params["beta0"] 884 | beta1=params["beta1"] 885 | sigma=params["sigma"] 886 | gamma=params["gamma"] 887 | 888 | dS = mu * (N - S) - beta0 * (1+beta1*cos(2*pi*t))* S * I / N 889 | dE = beta0 * (1+beta1*cos(2*pi * t))* S * I / N - (mu + sigma) * E 890 | dI = sigma * E - (mu + gamma) * I 891 | dR = gamma * I - mu * R 892 | res=c(dS, dE, dI, dR) 893 | list(res) 894 | } 895 | 896 | 897 | 898 | output$plot1 <- renderPlot({ 899 | 900 | times = seq(0, input$T[2], by=1/100) 901 | paras = c(mu = input$mu, N = 1, beta0 = input$beta0, beta1 = input$beta1, sigma = 365/input$oneoversigma, gamma = 365/input$Ip) 902 | xstart = c(S=0.06, E=0, I=0.001, R = 0.939) 903 | R0 = round(with(as.list(paras), sigma/(sigma+mu)*beta0/(gamma+mu)), 1) 904 | 905 | out=ode(y=xstart, 906 | times=times, 907 | func=seirmod2, 908 | parms=paras) 909 | 910 | out=as.data.frame(out) 911 | 912 | sel=out$time>input$T[1]&out$timeinput$T[1]&out$time