version 0.8

cran · Apr 14, 2011 · 5b15521 · 5b15521
1 parent e77d6e3
commit 5b15521
Show file tree

Hide file tree

Showing 27 changed files with 442 additions and 177 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: simecol
-Version: 0.7-2
-Date: 2011-03-24
+Version: 0.8
+Date: 2011-04-14
 Title: Simulation of ecological (and other) dynamic systems
 Author: Thomas Petzoldt
 Depends: R (>= 2.11), deSolve, methods, lattice
@@ -15,6 +15,6 @@ Description: simecol is an object oriented framework to simulate
         of code.
 License: GPL (>= 2)
 URL: http://www.simecol.de/
-Packaged: 2011-03-24 23:13:36 UTC; user
+Packaged: 2011-08-10 08:32:59 UTC; user
 Repository: CRAN
-Date/Publication: 2011-03-26 15:45:02
+Date/Publication: 2011-08-10 10:13:54
diff --git a/MD5 b/MD5
@@ -0,0 +1,99 @@
+371700e63a628b5ac1041a41918ff7cb *DESCRIPTION
+7c85006881d27917522cef00caa2d4be *NAMESPACE
+9b3e977812938b50737f9d905d919bb1 *R/aaa_classes.R
+340625379911655ce54368d00c5e90a5 *R/accessors.R
+ead60e8d7e43b62af4d74a0a1240d401 *R/addtoenv.R
+6ca506529100f9d044acd0463adcb43c *R/approxTime.R
+c65fc62147b88ab243a7684ccbcec649 *R/coerce.R
+a5379ee42bda991b14ea9e46e344acb3 *R/constructors.R
+b8fcf7f00647a1069d66860862bea2e9 *R/fitOdeModel.R
+dde818776990e178d09908e43be7a4eb *R/fromtoby.R
+23f8b661b8c07fbb937bf23fbd54e343 *R/iteration.R
+6fc03920668a61d1bf14139c86dd2949 *R/mixNamedVec.R
+21bcbca6b01f795015a259e014bedc23 *R/neighbours.R
+d7eab92ba17bd2fb34dc789a20ec73b9 *R/p.constrain.R
+87fd2853071c0004bb51984c253fc504 *R/pcuseries.R
+0719e8a29a02a5cf86396f1675a3c841 *R/peaks.R
+e8e79b60d31f9fa1f8a350f2b038d1ef *R/plot.R
+d8d5b8a7be1e8670338710e2272bfcf2 *R/print.R
+ffdb1434b99b715905ec4a136c243a4a *R/sEdit.R
+241c894f01676b2c7b2f60975122fbdf *R/seedfill.R
+896d78634a193e0afdc17d6229355e01 *R/sim.R
+e5798526ebd6cda070d03453304f4a82 *R/ssqOdeModel.R
+29b6fb5733cd215588630781b1436c64 *data/CA.rda
+666abfe50ed7248313e334567511b13b *data/chemostat.rda
+8d093a41e7b4c8bba2e3b5103d87d471 *data/conway.rda
+19f923845a3b889951e132655ce3bc2b *data/diffusion.rda
+dde696004aa9bb419de2eade73b8e9e2 *data/lv.rda
+46ada8d07947a248a4d26fd3cb07baa4 *data/lv3.rda
+2e80d0874c93df7b90398c079c400cbe *data/upca.rda
+8609cb45cbc05486f13e258b1026ef2a *demo/00Index
+9593f14e8bda587049f731b34b6fdbe2 *demo/jss.R
+9a77470f3875554ab310e35a6404177e *inst/CITATION
+a0e45d853a7be1b36de0087c212c667b *inst/FAQ.txt
+f7bf65dabfb0545ce7dc665cac84f794 *inst/NEWS
+465be0dc509b82a1426d5332bbaf5773 *inst/THANKS
+eac092b586ad5243adef07bd38b31bd7 *inst/ToDo.txt
+3b62665461a88e539047c2920426a339 *inst/WISHLIST
+cd5e76ca30400231b9e6f713b79ca0a0 *inst/doc/a-simecol-introduction.pdf
+590faaa0032cea0c08dfe7f7859e2137 *inst/doc/b-simecol-howtos.pdf
+686accaa04554feffe53df74eb20b150 *inst/doc/ca.pdf
+c6f3372e18710befc0fe7a9a52f634f2 *inst/doc/classes.pdf
+83486c3a764fd74472c7fd81b22c82c1 *inst/doc/examples/CA.R
+892fa7f751313ae0d3c6d35533fd145a *inst/doc/examples/chemostat.R
+d5bf6fd6e96e42f42232eb11d1a1b5f5 *inst/doc/examples/conway.R
+c308ab7633abd778d3f8fbec0545fda8 *inst/doc/examples/diffusion_A.R
+00e89beee89f984cd93c9dd0820d114e *inst/doc/examples/diffusion_B.R
+7170e1941d7668184bd7317eded7f31f *inst/doc/examples/dynload/clotka.c
+aacf0a7e33966588ce15c7484fbd9ba8 *inst/doc/examples/dynload/simecol_clotka.R
+9872804a6b014f79f2a869144d45d287 *inst/doc/examples/dynload/test_clotka.R
+bea9534d6f0947de0001c9ad08dc79a0 *inst/doc/examples/fitOdeModel/initval.R
+76e225a0e1e5454df7d8de79876a9374 *inst/doc/examples/fitOdeModel/weighted.R
+05c2930049e39a787be6f9dee83355a7 *inst/doc/examples/ibm_daphnia.R
+2030f46c6a4c6091a3b02bf67b4a7abf *inst/doc/examples/logist.R
+fd9cc7b927438869acc894e1aca7c006 *inst/doc/examples/lv.R
+71714b5e260038783355a5fc0d8a756d *inst/doc/examples/lv3.R
+cda04e1980cb25aad2c8cad977991b8a *inst/doc/examples/lv3_approxfun.R
+984674fbf5bf070e681edae588bb7165 *inst/doc/examples/stoch_ca.R
+bd870526f1934004dea1e3f56691274f *inst/doc/examples/stoch_ca_simple.R
+129ea95b94f2f2614ac306ab3f5ec578 *inst/doc/examples/upca.R
+9209c621fdf948216c788a7ec475ab9a *inst/doc/ibm_daphnia.R
+8841865a3d9897fc8c7f1e92b9a78d38 *inst/doc/index.html
+92e903f33d4067a7fbc89fa4e7571c92 *inst/doc/jss.bst
+597d284e5204836c015463ad73e972ab *inst/doc/jss.cls
+65a630349080f4cc2884fbb04b6d022a *inst/doc/simecol.bib
+14418b0d96975e8c5c43bc307d974afd *inst/doc/statespace.pdf
+f4f34f0b1d26dd6db059faefebb64ab9 *inst/doc/vignette.cls
+9096a9f825108963524fa589d7cdcccb *man/CA.Rd
+5591eb519593d41a617058737bdc1dc1 *man/addtoenv.Rd
+466a77e29c8008118126c2d44bce11a6 *man/approxTime.Rd
+fcc8075b0a4d95c97bb84c027840c1d5 *man/as.simObj.Rd
+4180668eb25303c5fb258a7a4a3ff817 *man/chemostat.Rd
+956c91bcfa9485e7987f5fc6a911553d *man/conway.Rd
+08c8bf095c6932874a918f99dacc38f2 *man/diffusion.Rd
+9ef15ca58ef8acb35a877ea9932120d6 *man/eightneighbours.Rd
+7b25bfa9a310376d40b5c8e1356a9d98 *man/fitOdeModel.Rd
+fd1a0dc0500b6594a3285a413c60cbab *man/fixParms.Rd
+223fa3d2fd5e838851e5204462ada3c3 *man/fromtoby.Rd
+a0462917439624aa4dfd41b32857cd7f *man/initialize-methods.Rd
+cf32da08bc43bb6421d89148166b1ab3 *man/iteration.Rd
+be2a201a6360371242a3ade6eb3ba2a7 *man/listOrNULL.Rd
+3ee8ed8cda4778e27eea2538bc9573a8 *man/lv.Rd
+42a26444348846df0f7d148a6659897f *man/lv3.Rd
+5e4f7bdaf0e58ccdd1cf0e7d3a68bba6 *man/mixNamedVec.Rd
+274b80320c68d7743bd047006ffbad70 *man/neighbours.Rd
+b86f9eb9f0139c08c33f96a36e7703c3 *man/observer.Rd
+9e99144fbbd0a2778456e319e39032f6 *man/odeModel.Rd
+238f9f4ad71b826577c0d5d2929ac6df *man/p.constrain.Rd
+357c9fb03e1e9e78d1bbf91c4ef6c374 *man/parms.Rd
+8428e7ec41667b0dca1c19e9ecb0acc8 *man/pcuseries.Rd
+c701f7bdb286ad8bb9e9e32796864784 *man/peaks.Rd
+5969564daf4bf7e85b8ec3e031276b92 *man/plot-methods.Rd
+44f62c2ed97bfd153793001f710752a3 *man/print-methods.Rd
+bf2e07efb24692587495ff1580aff6ff *man/sEdit.Rd
+789954f2a7450fff9fcf79b5039b4625 *man/seedfill.Rd
+2197ffaa539b0dd623b33d3c9399f8c1 *man/sim.Rd
+34beb2d4990eb30d529eaacf0ff60dd9 *man/simecol-package.Rd
+7ff6ad207a771c0444348d720e4d620b *man/ssqOdeModel.Rd
+03e25c81b8ebbdda2e06feaac20f8700 *man/upca.Rd
+4d48ef51becca2992625cf5f6110456c *src/simecol.c
diff --git a/R/iteration.R b/R/iteration.R
@@ -22,11 +22,11 @@ setMethod("iteration", "numeric",
     parms <- c(parms, DELTAT = 0)
     nm    <- c("time", if (!is.null(attr(y, "names")))
              names(y) else as.character(1:n))
-    out <- unlist(func(times[1], y, parms))
+    out <- unlist(func(times[1], y, parms, ...))
     for (i in 2:length(times)) {
       time <- times[i]
       parms["DELTAT"] <- times[i] - times[i - (i > 1)] # is zero if i == 1
-      y    <- unlist(func(time, y, parms))
+      y    <- unlist(func(time, y, parms, ...))
       out  <- rbind(out, y)
       if (animate) {
         plot(out, ...)
@@ -65,14 +65,19 @@ setMethod("iteration", "simObj",
     parms$DELTAT <- 0
     res <- observer(init, times[1], 1, NULL, y)
     if (is.vector(res)) {
-        out  <- res
-      } else {
-        out  <- list(res)
-      }
+      out  <- res
+    } else {
+      out  <- list(res)
+    }
+    ## if (is.null(inputs)) print("no inputs")   ## for testing
     for (i in 2:length(times)) {
       time <- times[i]
       parms$DELTAT <- times[i] - times[i-1]
-      init <- func(time, init, parms)
+      if (is.null(inputs)) {
+        init <- func(time, init, parms)          # '...', would break 'delay'
+      } else {
+        init <- func(time, init, parms, inputs)  # '...', would break 'delay'
+      }
       res  <- observer(init, time, i, out, y)
       if (is.vector(res)) {
         out  <- rbind(out, res, deparse.level = 0)
@@ -83,7 +88,7 @@ setMethod("iteration", "simObj",
       ##   use the observer mechanism instead
       if (animate) {
          y@out   <- out
-         plot(y, index=i, ...)
+         plot(y, index = i, ...)
       }
     }
     if(is.vector(res)) {
@@ -112,11 +117,11 @@ setMethod("iteration", "odeModel",
     parms <- c(parms, DELTAT = 0)
     nm  <- c("time", if (!is.null(attr(init, "names")))
              names(init) else as.character(1:n))
-    out <- unlist(func(times[1], init, parms))
+    out <- unlist(func(times[1], init, parms, ...))
     for (i in 2:length(times)) {
       time <- times[i]
       parms["DELTAT"] <- times[i] - times[i - (i > 1)] # is zero if i == 1
-      init <- unlist(func(time, init, parms))
+      init <- unlist(func(time, init, parms, ...))
       out  <- rbind(out, init)
       if (animate) {
         y@out   <- out

diff --git a/R/neighbours.R b/R/neighbours.R
@@ -8,40 +8,63 @@ eightneighbours <- function(x){
   y <- rep(0, length(x))
   z <- .C("eightneighbours", as.integer(n), as.integer(m),
           as.double(x), y=as.double(y), PACKAGE="simecol")$y
+  dim(z) <- c(n, m)
   z
 }
 
-neighbours <- function(x, state=NULL, wdist=NULL, tol=1e-4){
+neighbours <- function(x, state = NULL, wdist = NULL, tol = 1e-4, bounds = 0){
   if (!is.matrix(x))    stop("x must be a matrix")
   if (!is.null(state) & !is.numeric(state)) stop("state must be numeric or NULL")
   if (!is.null(wdist) & !is.numeric(wdist)) stop("wdist must be numeric or NULL")
   if (!is.numeric(tol)) stop("tol must be numeric")
 
+  #if (length(bounds) %% 4)
+  #  warning("length of 'bounds' argument must be either one or four")
+  bounds <- rep(bounds, length.out = 4)
+  ## pack this into an integer bit mask
+  bound <- sum(bounds * c(1L, 2L, 4L, 8L))
+
   n <- dim(x)[1]
   m <- dim(x)[2]
-  
+
   y <- rep(0, length(x))
-  # if wdist not given do the same as eightneighbours
+  ## if wdist not given do the same as eightneighbours
   if (is.null(wdist)) wdist <- matrix(c(1,1,1,1,0,1,1,1,1), nrow=3)
-  
+
   ndist <- dim(wdist)[1]
   mdist <- dim(wdist)[2]
   if (mdist != ndist) stop ("wdist must be a sqare matrix")
+
+  if ((ndist > n) || (ndist > m))
+    stop("dimensions of weight matrix must be smaller dimensions of state matrix")
+
   ## default: all nonzero states in matrix counted
   ## we simply set all nonzero states to 1 and check against 1
   if (is.null(state)) {
     state <- 1
-    x[x !=0] <- 1
+    x[x != 0] <- 1
+  }
+
+  if (bound == 0) {
+    ## sligtly faster version
+    z <- .C("neighbours", as.integer(n), as.integer(m),
+            as.double(x), y = as.double(y),
+            as.integer(ndist), as.double(wdist),
+            as.double(state[1]), as.double(tol[1]),
+            PACKAGE = "simecol")$y
+  } else {
+    ## more general version
+    z <- .C("xneighbours", as.integer(n), as.integer(m),
+            as.double(x), y = as.double(y),
+            as.integer(ndist), as.double(wdist),
+            as.double(state[1]), as.double(tol[1]),
+            as.integer(bound),
+            PACKAGE = "simecol")$y
   }
-
-  z <- .C("neighbours", as.integer(n), as.integer(m),
-          as.double(x), y=as.double(y),
-          as.integer(ndist), as.double(wdist),
-          as.double(state[1]), as.double(tol[1]),
-          PACKAGE="simecol")$y
+  dim(z) <- c(n, m)
   z
 }
 
-## aliases 
+## aliases
 eightneighbors <- eightneighbours
 neighbors      <- neighbours
diff --git a/R/plot.R b/R/plot.R
@@ -8,26 +8,56 @@ setMethod("plot", c("simObj", "missing"),
   }
 )
 
+## old plot method
+#setMethod("plot", c("odeModel", "missing"),
+#  function(x, y, ...) {
+#  	if (is.null(x@out)) stop("Please simulate the model before plotting")
+#    oldpar <- par(no.readonly=TRUE)
+#    on.exit(par(oldpar))
+#  	out    <- as.data.frame(x@out)
+#    nstates <- ncol(out) - 1
+#    ## one figure per page if nstates = 1
+#    ## two figures if nstates = 2
+#    ## four figures if nstates > 2
+#    par(mfrow=c(1 + (nstates > 1), 1 + (nstates > 2)))
+#    nam <- names(out)
+#    for (i in 1:nstates) {
+#      graphics:::plot(out[[1]], out[[i+1]],
+#                      type="l", xlab=nam[1], ylab=nam[i+1], ...)
+#      if ((i %%4) ==0  & nstates > i) readline("press return for next page")
+#    }
+#  }
+#)
+
+## experimental plot method leveraging the functionality of package deSolve
 setMethod("plot", c("odeModel", "missing"),
   function(x, y, ...) {
   	if (is.null(x@out)) stop("Please simulate the model before plotting")
-    oldpar <- par(no.readonly=TRUE)
-    on.exit(par(oldpar))
-  	out    <- as.data.frame(x@out)
-    nstates <- ncol(out) - 1
-    ## one figure per page if nstates = 1
-    ## two figures if nstates = 2
-    ## four figures if nstates > 2
-    par(mfrow=c(1 + (nstates > 1), 1 + (nstates > 2)))
-    nam <- names(out)
-    for (i in 1:nstates) {
-      graphics:::plot(out[[1]], out[[i+1]],
-                      type="l", xlab=nam[1], ylab=nam[i+1], ...)
-      if ((i %%4) ==0  & nstates > i) readline("press return for next page")
-    }
+    do.call("plot", alist(x@out, ...))
+
+  }
+)
+
+setMethod("plot", c("odeModel", "odeModel"),
+  function(x, y, ...) {
+  	if (is.null(x@out)) stop("Please simulate the model before plotting")
+  	ldots   <- list(...)
+  	if (length(ldots) == 0) {
+     do.call("plot", alist(x@out, y = NULL, y@out))  	  	
+  	} else {
+    	for(i in 1:length(ldots)) {
+    	  obj <- ldots[[i]]
+    	  if (is(obj, "odeModel")) {
+    	    ldots[[i]] <- obj@out # use only the out slot
+  	    }
+  	    # else use the full object, possibly graphics parameters
+    	}
+    	 do.call("plot", c(alist(x@out, y@out), ldots))
+  	}
   }
 )
 
+
 setMethod("plot", c("gridModel", "missing"),
   function(x, y, index=1:length(x@out), delay=0, ...) {
    	if (is.null(x@out)) stop("Please simulate the model before plotting")

diff --git a/data/diffusion.rda b/data/diffusion.rda
diff --git a/data/lv3.rda b/data/lv3.rda
diff --git a/inst/NEWS b/inst/NEWS
@@ -1,3 +1,8 @@
+0.8
+o periodic boundary conditions in neighbours
+o compatibility tweaks
+o updated examples
+
 0.7-2
 o remove two other obsolete files from inst/doc
 

diff --git a/inst/ToDo.txt b/inst/ToDo.txt
@@ -4,8 +4,10 @@
  - continue with package vignettes (add case-studies)
 
 2010-11-29
-
-- check if passing "inputs" the same is also possible with the other sim methods
+- check if passing "inputs" is also possible with the other sim methods: partly done
 - pass also "equations" more explicitly?
 - documentation updates
-- improve plot function for comparing scenarios
+- improve plot function for comparing scenarios: done
+
+2011-08-09
+- find way to reduce size of S4 help file index
diff --git a/inst/WISHLIST b/inst/WISHLIST
@@ -1,5 +1,5 @@
 o graphical representatiopn of models in the helpfiles???
-o improved constrained algorithms for parameter optimization (model fitting)
+o improve interface to FME for model fitting
 o dynamic size of internal C buffers for seedfill
 o improved dialog version to edit parameters (Tcl/Tk)
 o alternative solution to avoid addtoenv()

diff --git a/inst/doc/a-simecol-introduction.pdf b/inst/doc/a-simecol-introduction.pdf
diff --git a/inst/doc/b-simecol-howtos.pdf b/inst/doc/b-simecol-howtos.pdf
diff --git a/inst/doc/examples/conway.R b/inst/doc/examples/conway.R
@@ -11,16 +11,15 @@ conway <- new("gridModel",
     nb     <- eightneighbours(x)
     surviv <- (x >  0 & (nb %in% parms$srv))
     gener  <- (x == 0 & (nb %in% parms$gen))
-    x      <- as.numeric((surviv + gener) > 0)
-    dim(x) <- dim(init)
+    x <- matrix((surviv + gener) > 0, nrow = nrow(init))
     return(x)
   },
   parms  = list(srv = c(2, 3), gen = 3),
   times  = 1:17,
-  init   = matrix(round(runif(1000)), ncol=40),
+  init   = matrix(round(runif(1000)), ncol = 40),
   solver = "iteration"
 )
 
-plot(sim(conway), axes=FALSE)
+plot(sim(conway), axes = FALSE)
 
 
diff --git a/inst/doc/examples/diffusion_A.R b/inst/doc/examples/diffusion_A.R
@@ -3,7 +3,7 @@
 ########################################################################
 
 diffusion <- new("rwalkModel",
-  main = function(time, init, parms, inputs = NULL) {
+  main = function(time, init, parms, inputs) {
     # inputs  <- obj@inputs
     speed   <- parms$speed
     xleft   <- parms$area[1]

diff --git a/inst/doc/examples/diffusion_B.R b/inst/doc/examples/diffusion_B.R
@@ -3,7 +3,7 @@
 ########################################################################
 
 diffusion <- rwalkModel(
-  main = function(time, init, parms, inputs = NULL) {
+  main = function(time, init, parms, inputs) {
     speed   <- parms$speed
     xleft   <- parms$area[1]
     xright  <- parms$area[2]