[Pomp-commits] r147 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jun 17 17:46:35 CEST 2009
Author: kingaa
Date: 2009-06-17 17:46:35 +0200 (Wed, 17 Jun 2009)
New Revision: 147
Modified:
pkg/R/nlf-guts.R
Log:
duplicate codes removed
Modified: pkg/R/nlf-guts.R
===================================================================
--- pkg/R/nlf-guts.R 2009-06-17 15:46:10 UTC (rev 146)
+++ pkg/R/nlf-guts.R 2009-06-17 15:46:35 UTC (rev 147)
@@ -190,29 +190,3 @@
LQL
}
-
-dmvnorm <- function (x, mean, sigma, log = FALSE) {
- if (is.vector(x)) {
- x <- matrix(x, ncol = length(x))
- }
- if (missing(mean)) {
- mean <- rep(0, length = ncol(x))
- }
- if (missing(sigma)) {
- sigma <- diag(ncol(x))
- }
- if (NCOL(x) != NCOL(sigma)) {
- stop("x and sigma have non-conforming size")
- }
- if (NROW(sigma) != NCOL(sigma)) {
- stop("sigma must be a square matrix")
- }
- if (length(mean) != NROW(sigma)) {
- stop("mean and sigma have non-conforming size")
- }
- distval <- mahalanobis(x, center = mean, cov = sigma)
- logdet <- sum(log(eigen(sigma, symmetric=TRUE, only.values=TRUE)$values))
- logretval <- -(ncol(x)*log(2*pi) + logdet + distval)/2
- if(log) return(logretval)
- exp(logretval)
-}
More information about the pomp-commits
mailing list