[Pomp-commits] r1084 - pkg/pomp/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Feb 22 20:43:06 CET 2015


Author: kingaa
Date: 2015-02-22 20:43:06 +0100 (Sun, 22 Feb 2015)
New Revision: 1084

Modified:
   pkg/pomp/R/proposals.R
Log:
- update proposals

Modified: pkg/pomp/R/proposals.R
===================================================================
--- pkg/pomp/R/proposals.R	2015-02-22 19:38:41 UTC (rev 1083)
+++ pkg/pomp/R/proposals.R	2015-02-22 19:43:06 UTC (rev 1084)
@@ -1,25 +1,33 @@
-mvn.rw.proposal.fn <- function (rw.sd) {
-  parnm <- colnames(rw.sd)
-  n <- ncol(rw.sd)
+mvn.diag.rw <- function (rw.sd) {
+  if (!is.numeric(rw.sd)) {
+    stop(sQuote("rw.sd")," must be a named numeric vector")
+  }
+  rw.sd <- rw.sd[rw.sd>0]
+  parnm <- names(rw.sd)
+  n <- length(rw.sd)
   if (is.null(parnm))
     stop(sQuote("rw.sd")," must have names")
-  if (is.matrix(rw.sd)) {
-    if (nrow(rw.sd)!=ncol(rw.sd))
-      stop(sQuote("rw.sd")," must be a square matrix")
-    ch <- try (chol(rw.sd,pivot=TRUE))
-    if (inherits(ch,"try-error"))
-      stop("error in Choleski factorization of ",sQuote("rw.sd"))
-    oo <- order(attr(ch,"pivot"))
-    Q <- ch[,oo]
-    fn <- function (theta) {
-      theta[parnm] <- theta[parnm]+Q.rnorm(n=n,mean=0,sd=1)
-      theta
-    }
-  } else {
-    fn <- function (theta) {
-      theta[parnm] <- rnorm(n=n,mean=theta[parnm],sd=rw.sd)
-      theta
-    }
+  function (theta) {
+    theta[parnm] <- rnorm(n=n,mean=theta[parnm],sd=rw.sd)
+    theta
   }
-  fn
 }
+
+mvn.rw <- function (rw.var) {
+  rw.var <- as.matrix(rw.var)
+  parnm <- colnames(rw.var)
+  n <- ncol(rw.var)
+  if (is.null(parnm))
+    stop(sQuote("rw.var")," must have row- and column-names")
+  if (nrow(rw.var)!=ncol(rw.var))
+    stop(sQuote("rw.var")," must be a square matrix")
+  ch <- try (chol(rw.var,pivot=TRUE))
+  if (inherits(ch,"try-error"))
+    stop("error in Choleski factorization of ",sQuote("rw.var"))
+  oo <- order(attr(ch,"pivot"))
+  Q <- ch[,oo]
+  function (theta) {
+    theta[parnm] <- theta[parnm]+Q%*%rnorm(n=n,mean=0,sd=1)
+    theta
+  }
+}



More information about the pomp-commits mailing list