version 0.5-7

Author: suyusung

CHANGELOG

@@ -1,3 +1,9 @@
+2015-8-22 Yu-Sung Su <[email protected]>
+    * DESCRIPTION (Version, Date): 0.5-6
+    * NAMESPACE: add more import
+    * R/jagsParalle: pass data into Glob.env
+
+
 2015-4-19 Yu-Sung Su <[email protected]>
     * DESCRIPTION (Version, Date): 0.5-5
     * DESCRIPTION: SystemRequirements: JAGS (http://mcmc-jags.sourceforge.net)

DESCRIPTION

@@ -1,16 +1,17 @@
 Package: R2jags
-Version: 0.5-6
-Date: 2015-4-21
+Version: 0.5-7
+Date: 2015-8-22
 Title: Using R to Run 'JAGS'
 Author: Yu-Sung Su <[email protected]>,
         Masanao Yajima <[email protected]>,
 Maintainer: Yu-Sung Su <[email protected]>
 Depends: R (>= 2.14.0), rjags (>= 3-3)
-Imports: abind, coda (>= 0.13), methods, R2WinBUGS, parallel
+Imports: abind, coda (>= 0.13), graphics, grDevices, methods,
+        R2WinBUGS, parallel, stats, utils
 SystemRequirements: JAGS (http://mcmc-jags.sourceforge.net)
 Description: Providing wrapper functions to implement Bayesian analysis in JAGS.  Some major features include monitoring convergence of a MCMC model using Rubin and Gelman Rhat statistics, automatically running a MCMC model till it converges, and implementing parallel processing of a MCMC model for multiple chains.
 License: GPL (>= 2)
 NeedsCompilation: no
-Packaged: 2015-04-21 06:08:53 UTC; suyusung
+Packaged: 2015-08-22 14:21:26 UTC; suyusung
 Repository: CRAN
-Date/Publication: 2015-04-21 09:13:50
+Date/Publication: 2015-08-23 10:39:57

MD5

@@ -1,17 +1,17 @@
-43f5f8c459387c94e80fffc0a8cbd0a9 *CHANGELOG
+ddd1007f2ac09996534c4c7a87f5d308 *CHANGELOG
 80d5280342ccaa1edf2a4b1c87a47d94 *COPYING.LIB
-c0c528878e604d86b6fa7e2198eed343 *DESCRIPTION
-1420349789929824c0ba7ad4363b74b8 *NAMESPACE
+55b9117a9ffb2b087cb17a5409a9b04d *DESCRIPTION
+7756418df5cb9f5eddb9cedde0f2fb11 *NAMESPACE
 0993ec3c619611d40927f6a4b24f9f91 *R/AllClass.R
 fb1cd440fb69b6c1a36fd535e78dc680 *R/as.bugs.array2.R
 3d051481132ba73a38f117e0a544842c *R/as.mcmc.R
 9e6b25427b6c52ebdc74e9c431abc55c *R/attach.jags.R
 46e343f5bcfbc633064ada1a8933f78a *R/autojags.R
 f26548b91c8393a102c097d6f9072de0 *R/jags.R
 b5020c366d128f7e48b363a92e85434f *R/jags.sims.R
-8e9c888e07dfcb0a1c2c8d927a0c2259 *R/jags2.R
+a5659542931977193c5518744c933a7e *R/jags2.R
 4b1abee38647e8af6636c71f13cd5510 *R/jags2bugs.R
-46356ebacfcd8d7e1fce775c3f0b1e07 *R/jagsParallel.R
+e3ffaaa247ab456d1bc1f937efecc531 *R/jagsParallel.R
 f84f5317262e71e94270bf600d217b63 *R/mcmc2bugs.R
 5f45c187679ee5855226de41e1618b12 *R/plot.R
 3e6dce1e63d766244e15245250a3781f *R/print.R

NAMESPACE

@@ -1,13 +1,20 @@
 importFrom(methods, "setOldClass")
 
+
+importFrom(graphics, "axis", "lines", "matplot", "par", "plot", "title")
+importFrom(grDevices, rainbow)
+importFrom(stats, "lowess", "quantile", "runif", "sd", "time", "update", "var")
+importFrom(utils, "read.table")
+
+
 importFrom(rjags, "jags.model",
                   "coda.samples",
                   "load.module",
                   "adapt")
 
 importFrom(abind, "abind")
 
-importFrom(coda, "as.mcmc", "mcmc", "as.mcmc.list", "traceplot")
+importFrom(coda, "as.mcmc", "mcmc", "nvar", "varnames", "nchain", "as.mcmc.list", "traceplot")
 
 import(parallel)
 

R/jags2.R

@@ -1,8 +1,8 @@
-jags2 <- function (data, inits, parameters.to.save, model.file = "model.bug", 
-  n.chains = 3, n.iter = 2000, n.burnin = floor(n.iter/2), 
+jags2 <- function (data, inits, parameters.to.save, model.file = "model.bug",
+  n.chains = 3, n.iter = 2000, n.burnin = floor(n.iter/2),
   n.thin = max(1, floor((n.iter - n.burnin)/1000)),
   DIC = TRUE, jags.path = "", working.directory = NULL, clearWD = TRUE,
-  refresh = n.iter/50) 
+  refresh = n.iter/50)
 {
   if (!is.null(working.directory)) {
     working.directory <- path.expand(working.directory)
@@ -14,19 +14,19 @@ jags2 <- function (data, inits, parameters.to.save, model.file = "model.bug",
     savedWD <- getwd()
     working.directory <- savedWD
   }
-  
+
   redo <- ceiling(n.iter - n.burnin)
 
  # data.list <- lapply(as.list(data), get, pos = parent.frame(2))
 #  names(data.list) <- as.list(data)
-  
-  
+
+
   if(is.list(data)){
-    data.list <- data 
-    lapply(data.list, dump, append=TRUE, file="jagsdata.txt", envir=parent.frame(1)) 
+    data.list <- data
+    lapply(data.list, dump, append=TRUE, file="jagsdata.txt", envir=parent.frame(1))
   }
   else{
-    if (!(length(data) == 1 && is.vector(data) && is.character(data) && 
+    if (!(length(data) == 1 && is.vector(data) && is.character(data) &&
           (regexpr("\\.txt$", data) > 0))) {
       data.list <- lapply(as.list(data), get, pos = parent.frame(1))
       names(data.list) <- as.list(data)
@@ -40,7 +40,7 @@ jags2 <- function (data, inits, parameters.to.save, model.file = "model.bug",
       }
       data.list <- data
     }
-     
+
   }
   lapply(names(data.list), dump, append=TRUE, file="jagsdata.txt")
   data <- read.jagsdata("jagsdata.txt")
@@ -55,7 +55,7 @@ jags2 <- function (data, inits, parameters.to.save, model.file = "model.bug",
     }
     write.model(model.file, con = temp)
     model.file <- gsub("\\\\", "/", temp)
-    if (!is.R()) 
+    if (!is.R())
         on.exit(file.remove(model.file), add = TRUE)
   }
   jags.call <- if (jags.path == "") {
@@ -70,15 +70,15 @@ jags2 <- function (data, inits, parameters.to.save, model.file = "model.bug",
   chain.names <- NULL
   if(is.null(inits)){
     no.inits <- TRUE
-  } 
+  }
   else if (is.function(inits)){
     for (i in 1:n.chains) {
       initial.values <- inits()
       inits.files <- c(inits.files, paste("jagsinits", i, ".txt", sep = ""))
       chain.names <- c(chain.names, paste("chain(", i, ")", sep = ""))
       with(initial.values, dump(names(initial.values), file = paste("jagsinits", i, ".txt", sep = "")))
     }
-  } 
+  }
   else if (is.list(inits)){
     if (length(inits)==n.chains){
       for (i in 1:n.chains) {
@@ -90,40 +90,40 @@ jags2 <- function (data, inits, parameters.to.save, model.file = "model.bug",
     } else {
       stop(message="initial value must be specified for all of chains")
     }
-  } 
-  
+  }
+
   if (DIC){
     parameters.to.save <- c(parameters.to.save, "deviance")
     #load.module("dic", quiet = TRUE)
   }
 
-  
-  cat("model clear\ndata clear\n", 
+
+  cat("model clear\ndata clear\n",
       if(DIC){
         "load dic\n"
       },
-      "model in ", "\"", model.file, "\"", "\n", 
+      "model in ", "\"", model.file, "\"", "\n",
       "cd ", "\"", working.directory, "\"", "\n",
-      "data in ", "\"jagsdata.txt\"", "\n", 
-      "compile, nchains(", n.chains, ")", "\n", 
+      "data in ", "\"jagsdata.txt\"", "\n",
+      "compile, nchains(", n.chains, ")", "\n",
       if(!no.inits){
         paste("inits in \"", inits.files, "\", ", chain.names, "\n", sep = "")
-      }, 
-      "initialize", "\n", 
-      "update ", n.burnin, ", by(", refresh, ")\n", 
-      paste("monitor ", parameters.to.save, ", thin(", n.thin, ")\n", sep = ""),      
-      "update ", redo, ", by(", refresh, ")\n", 
+      },
+      "initialize", "\n",
+      "update ", n.burnin, ", by(", refresh, ")\n",
+      paste("monitor ", parameters.to.save, ", thin(", n.thin, ")\n", sep = ""),
+      "update ", redo, ", by(", refresh, ")\n",
       "coda *\n", sep = "", file = "jagsscript.txt")
 
   system(paste(jags.call, "jagsscript.txt"))
-  
-  fit <- jags.sims(parameters.to.save = parameters.to.save, 
-      n.chains = n.chains, n.iter = n.iter, n.burnin = n.burnin, 
+
+  fit <- jags.sims(parameters.to.save = parameters.to.save,
+      n.chains = n.chains, n.iter = n.iter, n.burnin = n.burnin,
       n.thin = n.thin, DIC = DIC)
-  
+
   if (clearWD) {
-      file.remove(c("jagsdata.txt", "CODAindex.txt", inits.files, 
-          "jagsscript.txt", paste("CODAchain", 1:n.chains, 
+      file.remove(c("jagsdata.txt", "CODAindex.txt", inits.files,
+          "jagsscript.txt", paste("CODAchain", 1:n.chains,
               ".txt", sep = "")))
   }
   class(fit) <- "bugs"

R/jagsParallel.R

@@ -13,6 +13,40 @@ jags.parallel <- function (data, inits, parameters.to.save, model.file = "model.
         inits
     }
     jags.model <- model.file
+
+    if( is.character( data ) && length(data) == 1
+                           && regexpr( "\\.txt$", data ) > 0 ) {
+    ## 1. 'data' looks like a file name [UNDOCUMENTED!]
+    if ( all( basename( data ) == data )) {
+      fn2 <- file.path( working.directory, data )
+      if (normalizePath(fn2)!=normalizePath(data)) {  ## file.copy() to same place trashes the file
+        try( file.copy(fn2 , data, overwrite = TRUE ) )
+      }
+    }
+    if ( !file.exists( data ) ) {
+      stop("File",data,"does not exist")
+    }
+    if (file.info(data)["size"]==0) {
+      stop("Empty data file ",data)
+    }
+    e    <- new.env()
+    eval( parse( data ), e )
+    data <- as.list( e )
+  } else if( is.character( data ) ||
+             ( is.list( data ) && all( sapply( data,is.character ) ) ) ){
+    ## 2. data is a character vector or a list of character
+    dlist          <- lapply( as.list( data ), get, envir = parent.frame( 1 ) )
+    names( dlist ) <- unlist( data )
+    data           <- dlist
+  } else if( !is.list( data ) ){
+    stop( "data must be a character vector of object names, a list of object names, or a list of objects" )
+  }
+
+   list2env(data, envir=envir )
+
+
+
+
     .runjags <- function() {
         jagsfit <- jags(data = eval(expression(data)), inits = jags.inits,
             parameters.to.save = eval(expression(jags.params)),
@@ -22,11 +56,11 @@ jags.parallel <- function (data, inits, parameters.to.save, model.file = "model.
             working.directory = eval(expression(working.directory)),
             jags.seed = eval(expression(jags.seed)), progress.bar = "none",
             digits = eval(expression(digits)), RNGname = eval(expression(RNGname)),
-            jags.module = eval(expression(jags.module)), )
+            jags.module = eval(expression(jags.module)) )
         return(jagsfit)
     }
     cl <- makeCluster(n.cluster, methods = FALSE)
-    clusterExport(cl, c(data, "mcmc", "mcmc.list", export_obj_names ), envir = envir)
+    clusterExport(cl, c(names(data), "mcmc", "mcmc.list", export_obj_names ), envir = envir)
     clusterSetRNGStream(cl, jags.seed)
     tryCatch(res <- clusterCall(cl, .runjags), finally = stopCluster(cl))
     result <- NULL