[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