[Bugs-r-devel] SF.net SVN: bugs-r:[145] trunk/BRugs/R

[<chr...@us...>]

Revision: 145
          http://bugs-r.svn.sourceforge.net/bugs-r/?rev=145&view=rev
Author:   chris-jackson
Date:     2010-05-07 13:13:10 +0000 (Fri, 07 May 2010)

Log Message:
-----------
Fix for crash in samplesSize on non-scalar nodes, returns 0 for non-sampled nodes.
buildMCMC returns NA instead of crashing for node with no sample
Comments corrected in model.setIts.R and model.setOR.R

Modified Paths:
--------------
    trunk/BRugs/R/buildMCMC.R
    trunk/BRugs/R/model.setIts.R
    trunk/BRugs/R/model.setOR.R
    trunk/BRugs/R/samples.size.R

Modified: trunk/BRugs/R/buildMCMC.R
===================================================================
--- trunk/BRugs/R/buildMCMC.R	2010-05-05 21:43:23 UTC (rev 144)
+++ trunk/BRugs/R/buildMCMC.R	2010-05-07 13:13:10 UTC (rev 145)
@@ -41,28 +41,32 @@
     numChains <- samplesGetLastChain() - samplesGetFirstChain() + 1
     sampleSize <- sampleSize %/% numChains
     beg <- end - sampleSize * thin + 1
-    samples <- lapply(mons, subBuildMCMC)
-    samplesChain <- vector(mode="list", length=numChains)
-
-    for(i in 1:numChains){
-        if (is.R())
-          temp <- sapply(samples, function(x) x[,i])
-        else 
-          temp <- sapply(samples, function(x,j) { x[,j]}, j=i)
+    if (sampleSize==0) {
+        mcmcobj <- NA
+    }
+    else { 
+        samples <- lapply(mons, subBuildMCMC)
+        samplesChain <- vector(mode="list", length=numChains)
+        for(i in 1:numChains){
+            if (is.R())
+                temp <- sapply(samples, function(x) x[,i])
+            else 
+                temp <- sapply(samples, function(x,j) { x[,j]}, j=i)
 ##### If we want to special-case 1D-mcmc objects:
-#        if(ncol(temp) == 1){
-#            dim(temp) <- NULL
-#            samplesChain[[i]] <- temp
-#        }
-#        else{
-       samplesChain[[i]] <- temp
-       colnames(samplesChain[[i]]) <- mons
-#        }
+                                        #        if(ncol(temp) == 1){
+                                        #            dim(temp) <- NULL
+                                        #            samplesChain[[i]] <- temp
+                                        #        }
+                                        #        else{
+            samplesChain[[i]] <- temp
+            colnames(samplesChain[[i]]) <- mons
+                                        #        }
+        }
+        mcmcobj <- lapply(samplesChain, mcmc, start = beg, end = end, thin = thin)
     }
-    mcmcobj <- lapply(samplesChain, mcmc, start = beg, end = end, thin = thin)
     if(is.R())
-      class(mcmcobj) <- "mcmc.list"
+        class(mcmcobj) <- "mcmc.list"
     else
-      oldClass(mcmcobj) <- "mcmc.list"
+        oldClass(mcmcobj) <- "mcmc.list"
     mcmcobj
 }

Modified: trunk/BRugs/R/model.setIts.R
===================================================================
--- trunk/BRugs/R/model.setIts.R	2010-05-05 21:43:23 UTC (rev 144)
+++ trunk/BRugs/R/model.setIts.R	2010-05-07 13:13:10 UTC (rev 145)
@@ -1,6 +1,6 @@
 "modelSetIts" <-
 function(factoryName, iterations)
-#   Set the length of adaptive phase
+#   Set maximum number of iterations in iterative algorithms
 {
     name <- sQuote(factoryName)
     command <- paste("UpdaterMethods.SetFactory(", name, 

Modified: trunk/BRugs/R/model.setOR.R
===================================================================
--- trunk/BRugs/R/model.setOR.R	2010-05-05 21:43:23 UTC (rev 144)
+++ trunk/BRugs/R/model.setOR.R	2010-05-07 13:13:10 UTC (rev 145)
@@ -1,6 +1,6 @@
 "modelSetOR" <-
 function(factoryName, overRelaxation)
-#   Set the length of adaptive phase
+#   Set over-relaxed updating
 {
     name <- sQuote(factoryName)
     command <- paste("UpdaterMethods.SetFactory(", name, 

Modified: trunk/BRugs/R/samples.size.R
===================================================================
--- trunk/BRugs/R/samples.size.R	2010-05-05 21:43:23 UTC (rev 144)
+++ trunk/BRugs/R/samples.size.R	2010-05-07 13:13:10 UTC (rev 145)
@@ -2,6 +2,13 @@
 function(node)
 #   Size of stored sample of single component of OpenBUGS name
 {
+    sM <- samplesMonitors(node)
+    # Doesn't distinguish between nodes not in the model and nodes not monitored
+    # so returns 0 for non-existent nodes
+    if (any(grep("^no monitor set", sM))) return(0)    
+    if (any(grep("^model has probably not yet been updated", sM))) return(0)
+    if(length(sM) > 1 || sM != node)
+        stop("node must be a scalar variable from the model")
     command <- paste("SamplesEmbed.SetVariable(", shQuote(node), ")")
     .CmdInterpreter(command)
     command <- "SamplesEmbed.SampleSize"


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.