[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