[Pomp-commits] r319 - pkg/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Sep 23 23:55:56 CEST 2010


Author: kingaa
Date: 2010-09-23 23:55:56 +0200 (Thu, 23 Sep 2010)
New Revision: 319

Modified:
   pkg/R/probe.R
Log:
- empirical p-values are computed incorrectly.  fix this.


Modified: pkg/R/probe.R
===================================================================
--- pkg/R/probe.R	2010-09-21 13:45:57 UTC (rev 318)
+++ pkg/R/probe.R	2010-09-23 21:55:56 UTC (rev 319)
@@ -84,6 +84,8 @@
             if (!is.list(probes)) probes <- list(probes)
             if (!all(sapply(probes,is.function)))
               stop(sQuote("probes")," must be a function or a list of functions")
+            if (!all(sapply(probes,function(f)length(formals(f))==1)))
+              stop("each probe must be a function of a single argument")
             if (is.null(seed)) {
               if (exists('.Random.seed',where=.GlobalEnv)) {
                 seed <- get(".Random.seed",pos=.GlobalEnv)
@@ -107,8 +109,9 @@
             quants <- numeric(nprobes)
             names(quants) <- names(datval)
             for (k in seq_len(nprobes)) {
-              tails <- c(sum(simval[,k]>datval[k]),sum(simval[,k]<datval[k])+1)/(nsim+1)
-              pvals[k] <- min(c(2*tails,1))
+              r <- min(sum(simval[,k]>datval[k]),sum(simval[,k]<datval[k]))
+              tails <- (r+1)/(nsim+1)
+              pvals[k] <- min(2*tails,1)
               quants[k] <- sum(simval[,k]<datval[k])/nsim
             }
 



More information about the pomp-commits mailing list