Menu
▾
▴
bugs-r-devel
|
From: <gg...@us...> - 2006-11-24 13:36:32
|
Revision: 4
http://svn.sourceforge.net/bugs-r/?rev=4&view=rev
Author: ggorjan
Date: 2006-11-24 05:31:35 -0800 (Fri, 24 Nov 2006)
Log Message:
-----------
populating SVN for BRugs
Added Paths:
-----------
trunk/BRugs/DESCRIPTION
trunk/BRugs/NAMESPACE
trunk/BRugs/R/
trunk/BRugs/R/BRugsFit.R
trunk/BRugs/R/bgr.grid.R
trunk/BRugs/R/bgr.point.R
trunk/BRugs/R/buffer.R
trunk/BRugs/R/bugs.data.R
trunk/BRugs/R/bugs.inits.R
trunk/BRugs/R/buildMCMC.R
trunk/BRugs/R/current.values.R
trunk/BRugs/R/dic.clear.R
trunk/BRugs/R/dic.set.R
trunk/BRugs/R/dic.stats.R
trunk/BRugs/R/dimensions.R
trunk/BRugs/R/formatdata.R
trunk/BRugs/R/get.chain.R
trunk/BRugs/R/get.graphObj.R
trunk/BRugs/R/get.num.chains.R
trunk/BRugs/R/get.updaterObj.R
trunk/BRugs/R/loadModule.R
trunk/BRugs/R/model.adaptivePhase.R
trunk/BRugs/R/model.check.R
trunk/BRugs/R/model.compile.R
trunk/BRugs/R/model.data.R
trunk/BRugs/R/model.dynamic.R
trunk/BRugs/R/model.factory.R
trunk/BRugs/R/model.gen.inits.R
trunk/BRugs/R/model.get.seed.R
trunk/BRugs/R/model.inits.R
trunk/BRugs/R/model.iteration.R
trunk/BRugs/R/model.modules.R
trunk/BRugs/R/model.names.R
trunk/BRugs/R/model.precision.R
trunk/BRugs/R/model.save.state.R
trunk/BRugs/R/model.set.seed.R
trunk/BRugs/R/model.setAP.R
trunk/BRugs/R/model.setIts.R
trunk/BRugs/R/model.setOR.R
trunk/BRugs/R/model.update.R
trunk/BRugs/R/plot.autoC.R
trunk/BRugs/R/plot.bgr.R
trunk/BRugs/R/plot.density.R
trunk/BRugs/R/plot.history.R
trunk/BRugs/R/ranks.clear.R
trunk/BRugs/R/ranks.set.R
trunk/BRugs/R/ranks.stats.R
trunk/BRugs/R/samples.autoC.R
trunk/BRugs/R/samples.bgr.R
trunk/BRugs/R/samples.clear.R
trunk/BRugs/R/samples.coda.R
trunk/BRugs/R/samples.correl.R
trunk/BRugs/R/samples.density.R
trunk/BRugs/R/samples.get.beg.R
trunk/BRugs/R/samples.get.end.R
trunk/BRugs/R/samples.get.firstChain.R
trunk/BRugs/R/samples.get.lastChain.R
trunk/BRugs/R/samples.get.thin.R
trunk/BRugs/R/samples.history.R
trunk/BRugs/R/samples.monitors.R
trunk/BRugs/R/samples.sample.R
trunk/BRugs/R/samples.set.R
trunk/BRugs/R/samples.set.beg.R
trunk/BRugs/R/samples.set.end.R
trunk/BRugs/R/samples.set.firstChain.R
trunk/BRugs/R/samples.set.lastChain.R
trunk/BRugs/R/samples.set.thin.R
trunk/BRugs/R/samples.size.R
trunk/BRugs/R/samples.stats.R
trunk/BRugs/R/set.values.R
trunk/BRugs/R/summary.clear.R
trunk/BRugs/R/summary.set.R
trunk/BRugs/R/summary.stats.R
trunk/BRugs/R/unix/
trunk/BRugs/R/unix/help.R
trunk/BRugs/R/windows/
trunk/BRugs/R/windows/help.R
trunk/BRugs/R/write.datafile.R
trunk/BRugs/R/write.model.R
trunk/BRugs/R/zzz.R
trunk/BRugs/configure
trunk/BRugs/configure.win
trunk/BRugs/data/
trunk/BRugs/data/ratsdata.RData
trunk/BRugs/data/ratsinits.RData
trunk/BRugs/man/
trunk/BRugs/man/BRugs.Rd
trunk/BRugs/man/BRugsFit.Rd
trunk/BRugs/man/bgr.point.Rd
trunk/BRugs/man/buffer.Rd
trunk/BRugs/man/bugs.data.Rd
trunk/BRugs/man/bugs.inits.Rd
trunk/BRugs/man/buildMCMC.Rd
trunk/BRugs/man/current.values.Rd
trunk/BRugs/man/dic.Rd
trunk/BRugs/man/dimensions.Rd
trunk/BRugs/man/get.Obj.Rd
trunk/BRugs/man/get.chain.Rd
trunk/BRugs/man/get.num.chains.Rd
trunk/BRugs/man/help.WinBUGS.Rd
trunk/BRugs/man/loadModule.Rd
trunk/BRugs/man/model.adaptivePhase.Rd
trunk/BRugs/man/model.check.Rd
trunk/BRugs/man/model.compile.Rd
trunk/BRugs/man/model.data.Rd
trunk/BRugs/man/model.dynamic.Rd
trunk/BRugs/man/model.factory.Rd
trunk/BRugs/man/model.gen.inits.Rd
trunk/BRugs/man/model.inits.Rd
trunk/BRugs/man/model.iteration.Rd
trunk/BRugs/man/model.modules.Rd
trunk/BRugs/man/model.names.Rd
trunk/BRugs/man/model.precision.Rd
trunk/BRugs/man/model.save.state.Rd
trunk/BRugs/man/model.seed.Rd
trunk/BRugs/man/model.setAP.Rd
trunk/BRugs/man/model.update.Rd
trunk/BRugs/man/plot.autoC.Rd
trunk/BRugs/man/plot.bgr.Rd
trunk/BRugs/man/plot.density.Rd
trunk/BRugs/man/plot.history.Rd
trunk/BRugs/man/ranks.Rd
trunk/BRugs/man/rats.Rd
trunk/BRugs/man/samples.autoC.Rd
trunk/BRugs/man/samples.bgr.Rd
trunk/BRugs/man/samples.clear.Rd
trunk/BRugs/man/samples.coda.Rd
trunk/BRugs/man/samples.correl.Rd
trunk/BRugs/man/samples.density.Rd
trunk/BRugs/man/samples.get.Rd
trunk/BRugs/man/samples.history.Rd
trunk/BRugs/man/samples.monitors.Rd
trunk/BRugs/man/samples.sample.Rd
trunk/BRugs/man/samples.set.Rd
trunk/BRugs/man/samples.setting.Rd
trunk/BRugs/man/samples.size.Rd
trunk/BRugs/man/samples.stats.Rd
trunk/BRugs/man/set.values.Rd
trunk/BRugs/man/summary.Rd
trunk/BRugs/man/write.datafile.Rd
trunk/BRugs/man/write.model.Rd
trunk/BRugs/tests/
trunk/BRugs/tests/BRugs.R
trunk/BRugs/tests/BRugs.Rout.save
Added: trunk/BRugs/DESCRIPTION
===================================================================
--- trunk/BRugs/DESCRIPTION (rev 0)
+++ trunk/BRugs/DESCRIPTION 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,13 @@
+Package: BRugs
+Title: OpenBUGS and its R interface BRugs
+Version: 0.3-3
+Date: 2006-09-12
+Author: The Chief Software Bug is Andrew Thomas, with web assistance from Real Bug Bob O'Hara. Other members of the BUGS team are statisticians David Spiegelhalter, Nicky Best, Dave Lunn and Ken Rice. Dave Lunn has also made major contributions to the software development. R Code modified, extended and packaged for R by Uwe Ligges and Sibylle Sturtz. Some ideas taken from the R2WinBUGS package based on code by Andrew Gelman.
+Description: An R package containing OpenBUGS and its R interface BRugs.
+Maintainer: Uwe Ligges <li...@st...>
+Depends: R (>= 2.0.0)
+Suggests: coda
+SystemRequirements: currently the only supported OS is Windows, we expect to support Linux in future releases
+License: GPL version 2
+URL: http://mathstat.helsinki.fi/openbugs/
+Packaged: Tue Sep 12 09:02:32 2006; ligges
Added: trunk/BRugs/NAMESPACE
===================================================================
--- trunk/BRugs/NAMESPACE (rev 0)
+++ trunk/BRugs/NAMESPACE 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,20 @@
+useDynLib(BRugs)
+export(BRugsFit, bugsData, bugsInits, buildMCMC, currentValues,
+dicClear, dicSet, dicStats,
+getGraphObj, getNumChains,
+getUpdaterObj, help.BRugs, help.WinBUGS, loadModule,
+modelAdaptivePhase, modelCheck, modelCompile, modelData,
+modelGenInits, modelGetSeed, modelInits, modelIteration,
+modelModules, modelNames, modelPrecision, modelSaveState,
+modelSetAP, modelSetIts, modelSetOR, modelSetSeed,
+modelUpdate, modelEnable, modelDisable,
+modelEnableDynamic, modelDisableDynamic,
+plotAutoC, plotBgr, plotDensity,
+plotHistory, ranksClear, ranksSet, ranksStats,
+samplesAutoC, samplesBgr, samplesClear, samplesCoda,
+samplesCorrel, samplesDensity, samplesGetBeg, samplesGetEnd,
+samplesGetFirstChain, samplesGetLastChain, samplesGetThin, samplesHistory,
+samplesMonitors, samplesSample, samplesSet, samplesSetBeg,
+samplesSetEnd, samplesSetFirstChain, samplesSetLastChain, samplesSetThin,
+samplesSize, samplesStats, setValues, summaryClear,
+summarySet, summaryStats, writeModel)
Added: trunk/BRugs/R/BRugsFit.R
===================================================================
--- trunk/BRugs/R/BRugsFit.R (rev 0)
+++ trunk/BRugs/R/BRugsFit.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,43 @@
+BRugsFit <-
+function(modelFile, data, inits, numChains = 3, parametersToSave,
+ nBurnin = 1000, nIter = 1000, nThin = 1,
+ DIC = TRUE, working.directory = NULL, digits = 5,
+ BRugsVerbose = getOption("BRugsVerbose")){
+
+ if(is.null(BRugsVerbose))
+ BRugsVerbose <- TRUE
+ op <- options("BRugsVerbose" = BRugsVerbose)
+ on.exit(options(op))
+ if(!is.null(working.directory)){
+ savedWD <- getwd()
+ setwd(working.directory)
+ on.exit(setwd(savedWD), add = TRUE)
+ }
+ if(!file.exists(modelFile)) stop(modelFile, " does not exist")
+ if(file.info(modelFile)$isdir) stop(modelFile, " is a directory, but a file is required")
+ modelCheck(modelFile)
+ if(!(is.vector(data) && is.character(data) && all(file.exists(data))))
+ data <- bugsData(data, digits = digits)
+ modelData(data)
+ modelCompile(numChains)
+ if(missing(inits)){
+ modelGenInits()
+ }
+ else{
+ if(is.list(inits) || is.function(inits) || (is.character(inits) && !any(file.exists(inits))))
+ inits <- bugsInits(inits = inits, numChains = numChains, digits = digits)
+ if(BRugsVerbose) print(inits)
+ modelInits(inits)
+ }
+ samplesSetThin(nThin)
+ modelUpdate(nBurnin)
+ if(DIC){
+ dicSet()
+ on.exit(dicClear(), add = TRUE)
+ }
+ samplesSet(parametersToSave)
+ modelUpdate(nIter)
+ sims <- samplesStats("*")
+# class(sims) <- "BRugsFit"
+ return(list(Stats = sims, DIC = if(DIC) dicStats()))
+}
Property changes on: trunk/BRugs/R/BRugsFit.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/bgr.grid.R
===================================================================
--- trunk/BRugs/R/bgr.grid.R (rev 0)
+++ trunk/BRugs/R/bgr.grid.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,19 @@
+"bgrGrid" <-
+function(node, bins = 50)
+# Calculate grid of points at which to evaluate bgr statistic
+{
+ command <- paste("SamplesEmbed.SetVariable(", sQuote(node), ") END")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ command <- paste("SamplesEmbed.SampleSize")
+ sampleSize <- as.integer(.C("Integer", command, nchar(command),
+ integer(1), integer(1), PACKAGE="BRugs")[[3]])
+ beg <- samplesGetBeg()
+ end <- min(c(samplesGetEnd(), modelIteration()))
+ numChains <- samplesGetLastChain() - samplesGetFirstChain() + 1
+ sampleSize <- sampleSize %/% numChains
+ beg <- end - (sampleSize - 1)
+ delta <- sampleSize %/% bins
+ grid <- ((1 : (bins - 1)) * delta) + beg
+ grid <- c(grid, end)
+ grid
+}
Property changes on: trunk/BRugs/R/bgr.grid.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/bgr.point.R
===================================================================
--- trunk/BRugs/R/bgr.point.R (rev 0)
+++ trunk/BRugs/R/bgr.point.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,28 @@
+"bgrPoint" <-
+function(node, iteration)
+# Calculate the bgr statistic at iteration
+{
+ oldEnd <- samplesGetEnd()
+ on.exit(samplesSetEnd(oldEnd))
+ samplesSetEnd(as.integer(iteration))
+ numChains <- getNumChains()
+ command <- paste("SamplesEmbed.SetVariable(", sQuote(node), ")")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ command <- "SamplesEmbed.SampleSize"
+ sampleSize <- as.integer(.C("Integer", command, nchar(command),
+ integer(1), integer(1), PACKAGE="BRugs")[[3]])
+ command <- "SamplesEmbed.Sample"
+ sample <- .C("RealArray", command, nchar(command), real(sampleSize),
+ as.integer(sampleSize), integer(1), PACKAGE="BRugs")[[3]]
+ lenChain <- sampleSize %/% numChains
+ dq <- quantile(sample, c(0.1, 0.9), names = FALSE)
+ d.delta <- dq[2] - dq[1]
+ n.delta <- 0
+ for (i in 1:numChains) {
+ nq <- quantile(sample[((i - 1) * lenChain + 1) : (i * lenChain)], c(0.1, 0.9), names = FALSE)
+ n.delta <- n.delta + nq[2] - nq[1]
+ }
+ n.delta <- n.delta / numChains
+ bgr.stat <- d.delta / n.delta
+ return(c(iteration, n.delta, d.delta, bgr.stat))
+}
Property changes on: trunk/BRugs/R/bgr.point.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/buffer.R
===================================================================
--- trunk/BRugs/R/buffer.R (rev 0)
+++ trunk/BRugs/R/buffer.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,4 @@
+buffer <- function(){
+ buffer <- file.path(tempdir(), "buffer.txt")
+ message(readLines(buffer))
+}
Property changes on: trunk/BRugs/R/buffer.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/bugs.data.R
===================================================================
--- trunk/BRugs/R/bugs.data.R (rev 0)
+++ trunk/BRugs/R/bugs.data.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,11 @@
+"bugsData" <-
+function(data, fileName = file.path(getwd(), "data.txt"), digits = 5){
+ if(is.numeric(unlist(data)))
+ write.datafile(lapply(data, formatC, digits = digits, format = "E"), fileName)
+ else {
+ data.list <- lapply(as.list(data), get, pos = parent.frame(2))
+ names(data.list) <- as.list(data)
+ write.datafile(lapply(data.list, formatC, digits = digits, format = "E"), fileName)
+ }
+ invisible(fileName)
+}
Property changes on: trunk/BRugs/R/bugs.data.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/bugs.inits.R
===================================================================
--- trunk/BRugs/R/bugs.inits.R (rev 0)
+++ trunk/BRugs/R/bugs.inits.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,16 @@
+"bugsInits" <-
+function (inits, numChains = 1, fileName, digits = 5){
+ if(missing(fileName))
+ fileName <- file.path(getwd(), paste("inits", 1:numChains, ".txt", sep = ""))
+ if(length(fileName) != numChains)
+ stop("numChains = ", numChains, " filenames must be specified")
+ if(!is.null(inits)){
+ for (i in 1:numChains){
+ if (is.function(inits))
+ write.datafile(lapply(inits(), formatC, digits = digits, format = "E"), fileName[i])
+ else
+ write.datafile(lapply(inits[[i]], formatC, digits = digits, format = "E"), fileName[i])
+ }
+ }
+ invisible(fileName)
+}
Property changes on: trunk/BRugs/R/bugs.inits.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/buildMCMC.R
===================================================================
--- trunk/BRugs/R/buildMCMC.R (rev 0)
+++ trunk/BRugs/R/buildMCMC.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,83 @@
+buildMCMC <- function(node, beg = samplesGetBeg(), end = samplesGetEnd(),
+ firstChain = samplesGetFirstChain(), lastChain = samplesGetLastChain(),
+ thin = samplesGetThin()){
+
+ oldBeg <- samplesGetBeg()
+ oldEnd <- samplesGetEnd()
+ oldFirstChain <- samplesGetFirstChain()
+ oldLastChain <- samplesGetLastChain()
+ oldThin <- samplesGetThin()
+ on.exit({
+ samplesSetBeg(oldBeg)
+ samplesSetEnd(oldEnd)
+ samplesSetFirstChain(oldFirstChain)
+ samplesSetLastChain(oldLastChain)
+ samplesSetThin(oldThin)
+ })
+ samplesSetBeg(beg)
+ samplesSetEnd(end)
+ samplesSetFirstChain(firstChain)
+ samplesSetLastChain(lastChain)
+ thin <- max(c(thin, 1))
+ samplesSetThin(thin)
+ mons <- samplesMonitors(node)
+
+ subBuildMCMC <- function(node){
+ sM <- samplesMonitors(node)
+ if(length(sM) > 1 || sM != node)
+ stop("node must be a scalar variable from the model, for arrays use samplesAutoC")
+ nodeName <- sQuote(node)
+ command <- paste("SamplesEmbed.SetVariable(", nodeName, ")")
+ .C("CmdInterpreter", command, nchar(command), integer(1),
+ PACKAGE = "BRugs")
+ command <- "SamplesEmbed.SampleSize"
+ sampleSize <- as.integer(.C("Integer", command, nchar(command),
+ integer(1), integer(1), PACKAGE = "BRugs")[[3]])
+ command <- "SamplesEmbed.Sample"
+ sample <- .C("RealArray", command, nchar(command), real(sampleSize),
+ sampleSize, integer(1), PACKAGE = "BRugs")[[3]]
+ numChains <- samplesGetLastChain() - samplesGetFirstChain() + 1
+ matrix(sample, ncol = numChains)
+ }
+
+ nodeName <- sQuote(mons[1])
+ command <- paste("SamplesEmbed.SetVariable(", nodeName, ")")
+ .C("CmdInterpreter", command, nchar(command), integer(1),
+ PACKAGE = "BRugs")
+ command <- "SamplesEmbed.SampleSize"
+ sampleSize <- as.integer(.C("Integer", command, nchar(command),
+ integer(1), integer(1), PACKAGE = "BRugs")[[3]])
+ end <- min(c(modelIteration(), samplesGetEnd()))
+ thin <- samplesGetThin()
+ numChains <- samplesGetLastChain() - samplesGetFirstChain() + 1
+ sampleSize <- sampleSize %/% numChains
+ beg <- end - (sampleSize - 1) * thin
+ beg <- beg %/% thin
+ end <- end %/% thin
+
+ samples <- lapply(mons, subBuildMCMC)
+ samplesChain <- vector(mode="list", length=numChains)
+
+ for(i in 1:numChains){
+ temp <- sapply(samples, function(x) x[,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
+# }
+ }
+
+ require(coda)
+ mcmcobj <- lapply(samplesChain, mcmc, start = beg, end = end, thin = thin)
+ class(mcmcobj) <- "mcmc.list"
+ mcmcobj
+}
+
+
+
+
+
Property changes on: trunk/BRugs/R/buildMCMC.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/current.values.R
===================================================================
--- trunk/BRugs/R/current.values.R (rev 0)
+++ trunk/BRugs/R/current.values.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,16 @@
+"currentValues" <-
+function(nodeLabel)
+# Get current value of node
+{
+ nodeLabel <- as.character(nodeLabel)
+ command <- "BugsRobjects.Set"
+ len <- nchar(command)
+ .C("CharArray", command, as.integer(len), nodeLabel, nchar(nodeLabel), integer(1), PACKAGE="BRugs")
+ command <- "BugsRobjects.Size"
+ nodeSize <- .C("Integer", command, nchar(command), integer(1), integer(1), PACKAGE="BRugs")[[3]]
+ if(nodeSize == -1)
+ stop(nodeLabel, " is not a node in BUGS model")
+ command <- "BugsRobjects.Values"
+ .C("RealArray", command, nchar(command), as.real(rep(NA, nodeSize)),
+ as.integer(nodeSize), integer(1), NAOK = TRUE, PACKAGE="BRugs")[[3]]
+}
Property changes on: trunk/BRugs/R/current.values.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/dic.clear.R
===================================================================
--- trunk/BRugs/R/dic.clear.R (rev 0)
+++ trunk/BRugs/R/dic.clear.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,8 @@
+"dicClear" <-
+function()
+# Clear monitor for dic
+{
+ command <- "DevianceEmbed.StatsGuard;DevianceEmbed.Clear"
+ invisible(.C("CmdInterpreter", command, nchar(command),
+ integer(1), PACKAGE="BRugs"))
+}
Property changes on: trunk/BRugs/R/dic.clear.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/dic.set.R
===================================================================
--- trunk/BRugs/R/dic.set.R (rev 0)
+++ trunk/BRugs/R/dic.set.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,9 @@
+"dicSet" <-
+function()
+# Set a monitor for dic
+{
+ command <- "DevianceEmbed.SetVariable('*');DevianceEmbed.SetGuard;DevianceEmbed.Set"
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ if(getOption("BRugsVerbose"))
+ buffer()
+}
Property changes on: trunk/BRugs/R/dic.set.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/dic.stats.R
===================================================================
--- trunk/BRugs/R/dic.stats.R (rev 0)
+++ trunk/BRugs/R/dic.stats.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,14 @@
+"dicStats" <-
+function()
+# Calculate dic statistics
+{
+ command <- "DevianceEmbed.SetVariable('*');DevianceEmbed.StatsGuard;DevianceEmbed.Stats"
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ buffer <- file.path(tempdir(), "buffer.txt")
+ rlb <- readLines(buffer)
+ len <- length(rlb)
+ if (len > 1)
+ read.table(buffer)
+ else
+ message(rlb)
+}
Property changes on: trunk/BRugs/R/dic.stats.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/dimensions.R
===================================================================
--- trunk/BRugs/R/dimensions.R (rev 0)
+++ trunk/BRugs/R/dimensions.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,22 @@
+"dimensions" <-
+function(node)
+# Get dimension information for quantity in OpenBUGS model
+{
+ nodeLabel <- as.character(node)
+ if(!(nodeLabel %in% modelNames()))
+ stop("node must be a variable name from the model")
+ command <- "BugsRobjects.Set"
+ .C("CharArray", command, nchar(command), as.character(nodeLabel),
+ nchar(nodeLabel), integer(1), PACKAGE="BRugs")
+ command <- "BugsRobjects.NumSlots"
+ numSlots <- as.integer(.C("Integer", command, nchar(command),
+ integer(1), integer(1), PACKAGE="BRugs")[3])
+ dimensions <- integer(numSlots)
+ command <- "BugsRobjects.Dimensions"
+ if (numSlots > 0)
+ dimensions <- .C("IntegerArray", command, nchar(command),
+ as.integer(dimensions), as.integer(numSlots),
+ integer(1), PACKAGE="BRugs")[[3]]
+ else dimensions <- NULL
+ return(dimensions)
+}
Property changes on: trunk/BRugs/R/dimensions.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/formatdata.R
===================================================================
--- trunk/BRugs/R/formatdata.R (rev 0)
+++ trunk/BRugs/R/formatdata.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,24 @@
+"formatdata" <-
+function (datalist){
+ if (!is.list(datalist) || is.data.frame(datalist))
+ stop("argument to formatdata() ", "must be a list")
+ n <- length(datalist)
+ datalist.string <- vector(n, mode = "list")
+ for (i in 1:n) {
+ if (length(datalist[[i]]) == 1)
+ datalist.string[[i]] <- paste(names(datalist)[i],
+ "=", as.character(datalist[[i]]), sep = "")
+ if (is.vector(datalist[[i]]) && length(datalist[[i]]) > 1)
+ datalist.string[[i]] <- paste(names(datalist)[i],
+ "=c(", paste(as.character(datalist[[i]]), collapse = ", "),
+ ")", sep = "")
+ if (is.array(datalist[[i]]))
+ datalist.string[[i]] <- paste(names(datalist)[i],
+ "= structure(.Data= c(", paste(as.character(as.vector(aperm(datalist[[i]]))),
+ collapse = ", "), "), .Dim=c(", paste(as.character(dim(datalist[[i]])),
+ collapse = ", "), "))", sep = "")
+ }
+ datalist.tofile <- paste("list(", paste(unlist(datalist.string),
+ collapse = ", "), ")", sep = "")
+ return(datalist.tofile)
+}
Property changes on: trunk/BRugs/R/formatdata.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/get.chain.R
===================================================================
--- trunk/BRugs/R/get.chain.R (rev 0)
+++ trunk/BRugs/R/get.chain.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,7 @@
+"getChain" <-
+function()
+# Get chain field
+{
+ command<- "BugsEmbed.chain"
+ as.integer(.C("Integer", command, nchar(command), integer(1), integer(1), PACKAGE="BRugs")[[3]])
+}
Property changes on: trunk/BRugs/R/get.chain.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/get.graphObj.R
===================================================================
--- trunk/BRugs/R/get.graphObj.R (rev 0)
+++ trunk/BRugs/R/get.graphObj.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,9 @@
+"getGraphObj" <-
+function(node)
+# Get type of GraphNode objects
+{
+ command <- paste("BugsEmbed.SetVariable(", sQuote(node), "); BugsEmbed.Nodes")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ buffer <- file.path(tempdir(), "buffer.txt")
+ read.table(buffer)
+}
Property changes on: trunk/BRugs/R/get.graphObj.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/get.num.chains.R
===================================================================
--- trunk/BRugs/R/get.num.chains.R (rev 0)
+++ trunk/BRugs/R/get.num.chains.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,8 @@
+"getNumChains" <-
+function()
+# Get numChains field
+{
+ command<- "BugsEmbed.numChains"
+ as.integer(.C("Integer", command, nchar(command),
+ integer(1), integer(1), PACKAGE="BRugs")[[3]])
+}
Property changes on: trunk/BRugs/R/get.num.chains.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/get.updaterObj.R
===================================================================
--- trunk/BRugs/R/get.updaterObj.R (rev 0)
+++ trunk/BRugs/R/get.updaterObj.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,9 @@
+"getUpdaterObj" <-
+function(node)
+# Get type of UpdaterUpdaters objects
+{
+ command <- paste("BugsEmbed.SetVariable(", sQuote(node), "); BugsEmbed.Methods")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ buffer <- file.path(tempdir(), "buffer.txt")
+ read.table(buffer)
+}
Property changes on: trunk/BRugs/R/get.updaterObj.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/loadModule.R
===================================================================
--- trunk/BRugs/R/loadModule.R (rev 0)
+++ trunk/BRugs/R/loadModule.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,9 @@
+"loadModule" <-
+function(module)
+# Load module
+{
+ command <- as.character(module)
+ .C("Load", command, nchar(command), integer(1), PACKAGE="BRugs")
+ if(getOption("BRugsVerbose"))
+ buffer()
+}
Property changes on: trunk/BRugs/R/loadModule.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.adaptivePhase.R
===================================================================
--- trunk/BRugs/R/model.adaptivePhase.R (rev 0)
+++ trunk/BRugs/R/model.adaptivePhase.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,8 @@
+"modelAdaptivePhase" <-
+function()
+# Get endOfAdapting field
+{
+ command <- "BugsInterface.endOfAdapting"
+ (as.integer(.C("Integer", command, nchar(command),
+ integer(1), integer(1), PACKAGE="BRugs")[[3]])) - 1
+}
Property changes on: trunk/BRugs/R/model.adaptivePhase.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.check.R
===================================================================
--- trunk/BRugs/R/model.check.R (rev 0)
+++ trunk/BRugs/R/model.check.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,17 @@
+"modelCheck" <-
+function(fileName)
+# Check that OpenBUGS model is syntactically correct
+{
+ path <- dirname(fileName)
+ path <- if(path == ".") getwd() else path
+ fileName <- file.path(path, basename(fileName))
+ if(!file.exists(fileName))
+ stop("File ", fileName, " does not exist")
+ if(file.info(fileName)$isdir)
+ stop(fileName, " is a directory, but a file is required")
+ command <- paste("BugsEmbed.SetFilePath(", sQuote(fileName),
+ ");BugsEmbed.ParseGuard;BugsEmbed.Parse", sep = "")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ if(getOption("BRugsVerbose"))
+ buffer()
+}
Property changes on: trunk/BRugs/R/model.check.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.compile.R
===================================================================
--- trunk/BRugs/R/model.compile.R (rev 0)
+++ trunk/BRugs/R/model.compile.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,15 @@
+"modelCompile" <-
+function(numChains = 1)
+# Compile OpenBUGS model
+{
+ if(!is.numeric(numChains))
+ stop("numChains ", "must be numeric")
+ numChains <- as.integer(numChains)
+ command <- paste("BugsEmbed.CompileGuard",
+ ";BugsEmbed.numChains :=", as.character(numChains), "; BugsEmbed.Compile", sep = "")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ samplesSetFirstChain(1)
+ samplesSetLastChain(numChains)
+ if(getOption("BRugsVerbose"))
+ buffer()
+}
Property changes on: trunk/BRugs/R/model.compile.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.data.R
===================================================================
--- trunk/BRugs/R/model.data.R (rev 0)
+++ trunk/BRugs/R/model.data.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,19 @@
+"modelData" <-
+function(fileName = "data.txt")
+{
+# Load data for OpenBUGS model
+ for(i in fileName){
+ path <- dirname(i)
+ path <- if(path == ".") getwd() else path
+ fileNm <- file.path(path, basename(i))
+ if(!file.exists(fileNm))
+ stop("File ", fileNm, " does not exist")
+ if(file.info(fileNm)$isdir)
+ stop(fileNm, " is a directory, but a file is required")
+ command <- paste("BugsEmbed.SetFilePath(", sQuote(fileNm),
+ ");BugsEmbed.LoadDataGuard;BugsEmbed.LoadData", sep = "")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ if(getOption("BRugsVerbose"))
+ buffer()
+ }
+}
Property changes on: trunk/BRugs/R/model.data.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.dynamic.R
===================================================================
--- trunk/BRugs/R/model.dynamic.R (rev 0)
+++ trunk/BRugs/R/model.dynamic.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,15 @@
+"modelEnableDynamic" <-
+function()
+# Enable Dynamic Compilation
+{
+ command <- "BugsEmbed.CompiledGuard; BugsEmbed.EnableDynamic"
+ invisible(.C("Integer", command, nchar(command), integer(1), integer(1), PACKAGE="BRugs")[[3]])
+}
+
+"modelDisableDynamic" <-
+function()
+# Disable Dynamic Compilation
+{
+ command <- "BugsEmbed.CompiledGuard; BugsEmbed.DisableDynamic"
+ invisible(.C("Integer", command, nchar(command), integer(1), integer(1), PACKAGE="BRugs")[[3]])
+}
Property changes on: trunk/BRugs/R/model.dynamic.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.factory.R
===================================================================
--- trunk/BRugs/R/model.factory.R (rev 0)
+++ trunk/BRugs/R/model.factory.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,11 @@
+modelDisable <- function(factory){
+ command <- paste("UpdaterMethods.SetFactory('", factory,"');UpdaterMethods.Disable", sep = "")
+ invisible(.C("CmdInterpreter", comand, nchar(command), integer(1)))
+
+}
+
+
+modelEnable <- function(factory){
+ command <- paste("UpdaterMethods.SetFactory('", factory,"');UpdaterMethods.Enable", sep = "")
+ invisible(.C("CmdInterpreter", command, nchar(command), integer(1)))
+}
Property changes on: trunk/BRugs/R/model.factory.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.gen.inits.R
===================================================================
--- trunk/BRugs/R/model.gen.inits.R (rev 0)
+++ trunk/BRugs/R/model.gen.inits.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,10 @@
+"modelGenInits" <-
+function()
+# Generate initial values for OpenBUGS model
+{
+ command <- paste("BugsEmbed.GenerateInitsGuard;", "BugsEmbed.GenerateInits")
+ .C("CmdInterpreter", command, nchar(command),
+ integer(1), PACKAGE="BRugs")
+ if(getOption("BRugsVerbose"))
+ buffer()
+}
Property changes on: trunk/BRugs/R/model.gen.inits.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.get.seed.R
===================================================================
--- trunk/BRugs/R/model.get.seed.R (rev 0)
+++ trunk/BRugs/R/model.get.seed.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,11 @@
+"modelGetSeed" <-
+function(i = 1)
+# Get the seed of random number generator
+{
+ if(!is.numeric(i))
+ stop("i ", "must be numeric")
+ command <- paste("BugsEmbed.index := ", as.integer(i), ";BugsEmbed.GetRNState")
+ res <- .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")[[3]]
+ if(res) stop("Getting seed returned with an error.")
+ buffer()
+}
Property changes on: trunk/BRugs/R/model.get.seed.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.inits.R
===================================================================
--- trunk/BRugs/R/model.inits.R (rev 0)
+++ trunk/BRugs/R/model.inits.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,32 @@
+"modelInits" <-
+function(fileName, chainNum = NULL)
+# Load initial values for OpenBUGS model
+{
+ if(is.null(chainNum))
+ chainNum <- getChain() + seq(along = fileName) - 1
+ if(!is.numeric(chainNum))
+ stop("chainNum ", "must be numeric")
+ if(length(fileName) != length(chainNum))
+ stop("length(chainNum) ", "must be equal to the number of filenames given")
+ chainNum <- as.integer(chainNum)
+ path <- dirname(fileName)
+ path <- ifelse(path == ".", getwd(), path)
+ fileName <- file.path(path, basename(fileName))
+ fileExist <- !file.exists(fileName)
+ if(any(fileExist))
+ stop("File(s) ", fileName[fileExist], " do(es) not exist.")
+ for(i in seq(along = fileName)){
+ if(file.info(fileName[i])$isdir)
+ stop(fileName[i], " is a directory, but a file is required.")
+ filename <- sQuote(fileName[i])
+ command <- paste("BugsEmbed.SetFilePath(", filename,
+ "); BugsEmbed.LoadInitsGuard; BugsEmbed.chain := ",
+ as.character(chainNum[i]), "; BugsEmbed.LoadInits")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ if(getOption("BRugsVerbose")){
+ cat("Initializing chain ", chainNum[i], ": ", sep="")
+ buffer()
+ }
+ }
+ invisible()
+}
Property changes on: trunk/BRugs/R/model.inits.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.iteration.R
===================================================================
--- trunk/BRugs/R/model.iteration.R (rev 0)
+++ trunk/BRugs/R/model.iteration.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,8 @@
+"modelIteration" <-
+function()
+# Get iteration field
+{
+ command <- "BugsEmbed.iteration"
+ as.integer(.C("Integer", command, nchar(command),
+ integer(1), integer(1), PACKAGE="BRugs")[[3]])
+}
Property changes on: trunk/BRugs/R/model.iteration.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.modules.R
===================================================================
--- trunk/BRugs/R/model.modules.R (rev 0)
+++ trunk/BRugs/R/model.modules.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,9 @@
+"modelModules" <-
+function()
+# List loaded OpenBUGS components
+{
+ command <- "BugsEmbed.Modules"
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ buffer <- file.path(tempdir(), "buffer.txt")
+ read.table(buffer)
+}
Property changes on: trunk/BRugs/R/model.modules.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.names.R
===================================================================
--- trunk/BRugs/R/model.names.R (rev 0)
+++ trunk/BRugs/R/model.names.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,9 @@
+"modelNames" <-
+function()
+{
+# gets names in OpenBUGS model
+ command <- "BugsRobjects.Names"
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ buffer <- file.path(tempdir(), "buffer.txt")
+ readLines(buffer)
+}
Property changes on: trunk/BRugs/R/model.names.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.precision.R
===================================================================
--- trunk/BRugs/R/model.precision.R (rev 0)
+++ trunk/BRugs/R/model.precision.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,11 @@
+"modelPrecision" <-
+function(prec)
+# Set the precision to which results are displayed
+{
+ if(!is.numeric(prec))
+ stop("prec ", "must be numeric")
+ prec <- as.integer(prec)
+ command <- paste("BugsMappers.SetPrec(", prec, ")")
+ invisible(.C("CmdInterpreter", command, nchar(command),
+ integer(1), PACKAGE="BRugs"))
+}
Property changes on: trunk/BRugs/R/model.precision.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.save.state.R
===================================================================
--- trunk/BRugs/R/model.save.state.R (rev 0)
+++ trunk/BRugs/R/model.save.state.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,9 @@
+"modelSaveState" <- function(stem)
+{
+# Saves the sate of each chain in OpenBUGS model
+ command <- paste("BugsEmbed.UpdateGuard",
+ ";BugsEmbed.WriteChains(", sQuote(stem), ")")
+ .C("CmdInterpreter", as.character(command), nchar(command), integer(1), PACKAGE="BRugs")
+ if(getOption("BRugsVerbose"))
+ buffer()
+}
Property changes on: trunk/BRugs/R/model.save.state.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.set.seed.R
===================================================================
--- trunk/BRugs/R/model.set.seed.R (rev 0)
+++ trunk/BRugs/R/model.set.seed.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,18 @@
+"modelSetSeed" <-
+function(newSeed)
+# Set the seed of random number generator
+{
+ if(!is.numeric(newSeed))
+ stop("newSeed ", "must be numeric")
+ newSeed <- as.integer(newSeed)
+ for(i in seq(along=newSeed)){
+ command <- paste("BugsEmbed.index :=", i, "; BugsEmbed.new :=", newSeed[i],
+ ";BugsEmbed.SetRNGuard; BugsEmbed.SetRNState")
+ res <- .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")[[3]]
+ }
+ if(!res){
+ if(getOption("BRugsVerbose"))
+ message("Seed successfully set")
+ }else stop("Setting seed returned with an error.")
+
+}
Property changes on: trunk/BRugs/R/model.set.seed.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.setAP.R
===================================================================
--- trunk/BRugs/R/model.setAP.R (rev 0)
+++ trunk/BRugs/R/model.setAP.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,12 @@
+"modelSetAP" <-
+function(factoryName, adaptivePhase)
+# Set the length of adaptive phase
+{
+ name <- sQuote(factoryName)
+ command <- paste("UpdaterMethods.SetFactory(", name,
+ ") ;UpdaterMethods.AdaptivePhaseGuard;",
+ "UpdaterMethods.SetAdaptivePhase(",
+ adaptivePhase,
+ ")", sep = "")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+}
Property changes on: trunk/BRugs/R/model.setAP.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.setIts.R
===================================================================
--- trunk/BRugs/R/model.setIts.R (rev 0)
+++ trunk/BRugs/R/model.setIts.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,12 @@
+"modelSetIts" <-
+function(factoryName, iterations)
+# Set the length of adaptive phase
+{
+ name <- sQuote(factoryName)
+ command <- paste("UpdaterMethods.SetFactory(", name,
+ ") ;UpdaterMethods.IterationsGuard;",
+ "UpdaterMethods.SetIterations(",
+ iterations,
+ ")", sep = "")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+}
Property changes on: trunk/BRugs/R/model.setIts.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.setOR.R
===================================================================
--- trunk/BRugs/R/model.setOR.R (rev 0)
+++ trunk/BRugs/R/model.setOR.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,12 @@
+"modelSetOR" <-
+function(factoryName, overRelaxation)
+# Set the length of adaptive phase
+{
+ name <- sQuote(factoryName)
+ command <- paste("UpdaterMethods.SetFactory(", name,
+ ") ;UpdaterMethods.OverRelaxationGuard;",
+ "UpdaterMethods.SetOverRelaxation(",
+ overRelaxation,
+ ")", sep = "")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+}
Property changes on: trunk/BRugs/R/model.setOR.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/model.update.R
===================================================================
--- trunk/BRugs/R/model.update.R (rev 0)
+++ trunk/BRugs/R/model.update.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,21 @@
+"modelUpdate" <-
+function(numUpdates, thin = 1, overRelax = FALSE)
+# Update the each chain in OpenBUGS model numUpdates * thin time
+{
+ if(!is.numeric(numUpdates))
+ stop("numUpdates ", "must be numeric")
+ numUpdates <- as.integer(numUpdates)
+ if(!is.numeric(thin))
+ stop("thin ", "must be numeric")
+ thin <- as.integer(thin)
+ if(!is.logical(overRelax))
+ stop("overRelax ", "must be logical")
+ command <- paste("BugsEmbed.UpdateGuard",
+ ";BugsEmbed.thin := ", thin,
+ ";BugsEmbed.overRelax := ", as.integer(overRelax),
+ ";BugsEmbed.updates := ", numUpdates,
+ ";BugsEmbed.Update")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ if(getOption("BRugsVerbose"))
+ buffer()
+}
Property changes on: trunk/BRugs/R/model.update.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/plot.autoC.R
===================================================================
--- trunk/BRugs/R/plot.autoC.R (rev 0)
+++ trunk/BRugs/R/plot.autoC.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,26 @@
+"plotAutoC" <-
+function(node, plot = TRUE, colour = c("red", "blue", "green", "yellow", "black"),
+ lwd = 5, main = NULL, ...)
+# Plot auto correlation function for single component of OpenBUGS name
+{
+ sM <- samplesMonitors(node)
+ if(length(sM) > 1 || sM != node)
+ stop("node must be a scalar variable from the model, for arrays use samplesAutoC")
+ nodeName <- sQuote(node)
+ command <- paste("SamplesEmbed.SetVariable(", nodeName, ")")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ command <- "SamplesEmbed.SampleSize"
+ sampleSize <- as.integer(.C("Integer", command, nchar(command),
+ integer(1), integer(1), PACKAGE="BRugs")[3])
+ command <- "SamplesEmbed.Sample"
+ sample <- .C("RealArray", command, nchar(command), real(sampleSize),
+ as.integer(sampleSize), integer(1), PACKAGE="BRugs")[[3]]
+ chain <- samplesGetFirstChain()
+ if (sd(sample) > 1.0E-10)
+ acfresult <- acf(sample, col = colour[chain], main = if(is.null(main)) nodeName else main,
+ lwd = lwd, demean = TRUE, plot = plot, ...)
+ else stop("ACF cannot be computed/plotted: standard deviation <= 1.0E-10")
+ acfresult$series <- node
+ if(plot) invisible(acfresult)
+ else return(acfresult)
+}
Property changes on: trunk/BRugs/R/plot.autoC.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/plot.bgr.R
===================================================================
--- trunk/BRugs/R/plot.bgr.R (rev 0)
+++ trunk/BRugs/R/plot.bgr.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,33 @@
+"plotBgr" <-
+function(node, plot = TRUE, main = NULL, xlab = "iteration", ylab = "bgr",
+ col = c("red", "blue", "green"), bins = 50, ...)
+# Plot bgr diagnostic for single component of OpenBUGS name
+{
+ sM <- samplesMonitors(node)
+ if(length(sM) > 1 || sM != node)
+ stop("node must be a scalar variable from the model, for arrays use samplesAutoC")
+ grid <- bgrGrid(node, bins = bins)
+ bgr <- sapply(grid, bgrPoint, node = node)
+ yRange <- range(bgr[4,])
+ yRange <- c(0, max(c(1.2, yRange[2])))
+ nRange <- range(bgr[2,])
+ nRange <- c(min(c(0, nRange[1])), nRange[2])
+ nDelta <- nRange[2] - nRange[1]
+ dRange <- range(bgr[3,])
+ dRange <- c(min(c(0, dRange[1])), dRange[2])
+ dDelta <- dRange[2] - dRange[1]
+ max <- 2 * max(c(nDelta, dDelta))
+ bgr[2,] <- bgr[2,] / max
+ bgr[3,] <- bgr[3,] / max
+ if(plot){
+ plot(grid, bgr[4,], ylim = yRange, type = "l",
+ main = if(is.null(main)) node else main, xlab = xlab, ylab = ylab, col = col[1], ...)
+ lines(grid, bgr[2,], col = col[2], ...)
+ lines(grid, bgr[3,], col = col[3], ...)
+ }
+ bgr <- data.frame(t(bgr))
+ names(bgr) <- c("Iteration", "pooledChain80pct", "withinChain80pct", "bgrRatio")
+ bgr$Iteration <- as.integer(bgr$Iteration)
+ if(plot) invisible(bgr)
+ else return(bgr)
+}
Property changes on: trunk/BRugs/R/plot.bgr.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/plot.density.R
===================================================================
--- trunk/BRugs/R/plot.density.R (rev 0)
+++ trunk/BRugs/R/plot.density.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,34 @@
+"plotDensity" <-
+function(node, main = NULL, xlab = "" , ylab = "", col = "red", ...)
+# Plot posterior density for single component of OpenBUGS name
+{
+ sM <- samplesMonitors(node)
+ if(length(sM) > 1 || sM != node)
+ stop("node must be a scalar variable from the model, for arrays use samplesAutoC")
+ nodeName <- sQuote(node)
+ command <- paste("SamplesEmbed.SetVariable(", nodeName, ")")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ command <- "SamplesEmbed.SampleSize"
+ sampleSize <- as.integer(.C("Integer", command, nchar(command),
+ integer(1), integer(1), PACKAGE="BRugs")[[3]])
+ command <- "SamplesEmbed.Sample"
+ sample <- .C("RealArray", command, nchar(command), real(sampleSize),
+ as.integer(sampleSize), integer(1), PACKAGE="BRugs")[[3]]
+ absSample <- abs(sample)
+ intSample <- as.integer(absSample + 1.0E-10)
+ zero <- absSample - intSample
+ intSample <- as.integer(sample)
+ if (sum(zero) > 0){
+ d <- density(sample, adjust = 1.25)
+ plot(d$x, d$y, type = "l", main = if(is.null(main)) nodeName else main,
+ xlab = xlab , ylab = ylab, col = col, ...)
+ }
+ else{
+ histogram <- table(intSample) / sampleSize
+ xRange <- range(intSample)
+ xLim <- c(xRange[1] - 0.5, xRange[2] + 0.5)
+ plot(histogram, type = "h", xlim = xLim, ylim = c(0, 1),
+ main = if(is.null(main)) nodeName else main,
+ xlab = xlab , ylab = ylab, col = col, ...)
+ }
+}
Property changes on: trunk/BRugs/R/plot.density.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/plot.history.R
===================================================================
--- trunk/BRugs/R/plot.history.R (rev 0)
+++ trunk/BRugs/R/plot.history.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,37 @@
+"plotHistory" <-
+function(node, plot = TRUE, colour = c("red", "blue", "green", "yellow", "black"),
+ main = NULL, xlab = "iteration", ylab = "", ...)
+# Plot history for single component of OpenBUGS name
+{
+ sM <- samplesMonitors(node)
+ if(length(sM) > 1 || sM != node)
+ stop("node must be a scalar variable from the model, for arrays use samplesAutoC")
+ nodeName <- sQuote(node)
+ command <- paste("SamplesEmbed.SetVariable(", nodeName, ")")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ command <- "SamplesEmbed.SampleSize"
+ sampleSize <- as.integer(.C("Integer", command, nchar(command),
+ integer(1), integer(1), PACKAGE="BRugs")[3])
+ command <- "SamplesEmbed.Sample"
+ sample <- .C("RealArray", command, nchar(command), real(sampleSize),
+ sampleSize, integer(1), PACKAGE="BRugs")[[3]]
+ end <- min(c(modelIteration(), samplesGetEnd()))
+ thin <- samplesGetThin()
+ numChains <- samplesGetLastChain() - samplesGetFirstChain() + 1
+ sampleSize <- sampleSize %/% numChains
+ beg <- end - (sampleSize - 1) * thin
+ beg <- beg %/% thin
+ end <- end %/% thin
+ x <- (beg:end) * thin
+ y <- matrix(sample, ncol = numChains)
+ if(plot){
+ plot(x, y[,1], ylim = range(sample), type = "n",
+ main = if(is.null(main)) nodeName else main,
+ xlab = xlab , ylab = ylab, ...)
+ for(chain in 1:numChains){
+ lines(x, y[,chain], col = colour[chain], ...)
+ }
+ invisible(y)
+ }
+ else return(y)
+}
Property changes on: trunk/BRugs/R/plot.history.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/ranks.clear.R
===================================================================
--- trunk/BRugs/R/ranks.clear.R (rev 0)
+++ trunk/BRugs/R/ranks.clear.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,11 @@
+"ranksClear" <-
+function(node)
+# Clears a ranks monitor for vector quantity in OpenBUGS model
+{
+ nodeName <- sQuote(node)
+ command <- paste("RanksEmbed.SetVariable(", nodeName, "); RanksEmbed.StatsGuard;",
+ "RanksEmbed.Clear")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ if(getOption("BRugsVerbose"))
+ buffer()
+}
Property changes on: trunk/BRugs/R/ranks.clear.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/ranks.set.R
===================================================================
--- trunk/BRugs/R/ranks.set.R (rev 0)
+++ trunk/BRugs/R/ranks.set.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,11 @@
+"ranksSet" <-
+function(node)
+# Set a ranks monitor for vector quantity node in OpenBUGS model
+{
+ nodeName <- sQuote(node)
+ command <- paste("RanksEmbed.SetVariable(", nodeName, "); RanksEmbed.SetGuard;",
+ "RanksEmbed.Set")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ if(getOption("BRugsVerbose"))
+ buffer()
+}
Property changes on: trunk/BRugs/R/ranks.set.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/ranks.stats.R
===================================================================
--- trunk/BRugs/R/ranks.stats.R (rev 0)
+++ trunk/BRugs/R/ranks.stats.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,18 @@
+"ranksStats" <-
+function(node)
+# Calculates ranks statistics for vector valued node in OpenBUGS model
+{
+ if(length(node) > 1 || node == "*")
+ stop("node cannot be a vector, nor '*'")
+ nodeName <- sQuote(node)
+ command <- paste("RanksEmbed.SetVariable(", nodeName, "); RanksEmbed.StatsGuard;",
+ "RanksEmbed.Stats")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ buffer <- file.path(tempdir(), "buffer.txt")
+ rlb <- readLines(buffer)
+ len <- length(rlb)
+ if (len > 1)
+ read.table(buffer)
+ else
+ message(rlb)
+}
Property changes on: trunk/BRugs/R/ranks.stats.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/samples.autoC.R
===================================================================
--- trunk/BRugs/R/samples.autoC.R (rev 0)
+++ trunk/BRugs/R/samples.autoC.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,35 @@
+"samplesAutoC" <-
+function(node, chain, beg = samplesGetBeg(), end = samplesGetEnd(),
+thin = samplesGetThin(), plot = TRUE, mfrow = c(3, 2), ask = NULL, ann = TRUE, ...)
+# Plot auto correlation function
+{
+ if(is.null(ask))
+ ask <- !((dev.cur() > 1) && !dev.interactive())
+ oldBeg <- samplesGetBeg()
+ oldEnd <- samplesGetEnd()
+ oldFirstChain <- samplesGetFirstChain()
+ oldLastChain <- samplesGetLastChain()
+ oldThin <- samplesGetThin()
+ on.exit({
+ samplesSetBeg(oldBeg)
+ samplesSetEnd(oldEnd)
+ samplesSetFirstChain(oldFirstChain)
+ samplesSetLastChain(oldLastChain)
+ samplesSetThin(oldThin)
+ })
+ beg <- max(beg, modelAdaptivePhase())
+ samplesSetBeg(beg)
+ samplesSetEnd(end)
+ chain <- max(c(1, chain))
+ chain <- min(c(getNumChains(), chain))
+ samplesSetFirstChain(chain)
+ samplesSetLastChain(chain)
+ thin <- max(c(thin, 1))
+ samplesSetThin(thin)
+ mons <- samplesMonitors(node)
+ par(mfrow = mfrow, ask = ask, ann = ann)
+ result <- lapply(mons, plotAutoC, plot = plot, ...)
+ names(result) <- mons
+ if(plot) invisible(result)
+ else return(result)
+}
Property changes on: trunk/BRugs/R/samples.autoC.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/samples.bgr.R
===================================================================
--- trunk/BRugs/R/samples.bgr.R (rev 0)
+++ trunk/BRugs/R/samples.bgr.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,35 @@
+"samplesBgr" <-
+function(node, beg = samplesGetBeg(), end = samplesGetEnd(),
+ firstChain = samplesGetFirstChain(), lastChain = samplesGetLastChain(),
+ thin = samplesGetThin(), bins = 50, plot = TRUE, mfrow = c(3, 2),
+ ask = NULL, ann = TRUE, ...)
+# Plot bgr statistic
+{
+ if(is.null(ask))
+ ask <- !((dev.cur() > 1) && !dev.interactive())
+ oldBeg <- samplesGetBeg()
+ oldEnd <- samplesGetEnd()
+ oldFirstChain <- samplesGetFirstChain()
+ oldLastChain <- samplesGetLastChain()
+ oldThin <- samplesGetThin()
+ on.exit({
+ samplesSetBeg(oldBeg)
+ samplesSetEnd(oldEnd)
+ samplesSetFirstChain(oldFirstChain)
+ samplesSetLastChain(oldLastChain)
+ samplesSetThin(oldThin)
+ })
+ beg <- max(beg, modelAdaptivePhase())
+ samplesSetBeg(beg)
+ samplesSetEnd(end)
+ samplesSetFirstChain(firstChain)
+ samplesSetLastChain(lastChain)
+ thin <- max(c(thin, 1))
+ samplesSetThin(thin)
+ mons <- samplesMonitors(node)
+ par(mfrow = mfrow, ask = ask, ann = ann)
+ result <- lapply(mons, plotBgr, bins = bins, plot = plot, ...)
+ names(result) <- mons
+ if(plot) invisible(result)
+ else return(result)
+}
Property changes on: trunk/BRugs/R/samples.bgr.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/samples.clear.R
===================================================================
--- trunk/BRugs/R/samples.clear.R (rev 0)
+++ trunk/BRugs/R/samples.clear.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,11 @@
+"samplesClear" <-
+function(node)
+# Clear a sample monitor
+{
+ nodeName <- sQuote(node)
+ command <- paste("SamplesEmbed.SetVariable(", nodeName,
+ ");SamplesEmbed.HistoryGuard;SamplesEmbed.Clear")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ if(getOption("BRugsVerbose"))
+ buffer()
+}
Property changes on: trunk/BRugs/R/samples.clear.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/samples.coda.R
===================================================================
--- trunk/BRugs/R/samples.coda.R (rev 0)
+++ trunk/BRugs/R/samples.coda.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,39 @@
+"samplesCoda" <- function(node, stem, beg = samplesGetBeg(),
+ end = samplesGetEnd(), firstChain = samplesGetFirstChain(),
+ lastChain = samplesGetLastChain(), thin = samplesGetThin())
+{
+# Write out CODA files
+
+ if(!is.character(node) || length(node)!=1)
+ stop("'node' must be character of length 1")
+ if(!is.character(stem) || length(stem)!=1)
+ stop("'stem' must be character of length 1")
+ if(dirname(stem) == ".")
+ stem <- file.path(getwd(), basename(stem))
+
+ oldBeg <- samplesGetBeg()
+ oldEnd <- samplesGetEnd()
+ oldFirstChain <- samplesGetFirstChain()
+ oldLastChain <- samplesGetLastChain()
+ oldThin <- samplesGetThin()
+ on.exit({
+ samplesSetBeg(oldBeg)
+ samplesSetEnd(oldEnd)
+ samplesSetFirstChain(oldFirstChain)
+ samplesSetLastChain(oldLastChain)
+ samplesSetThin(oldThin)
+ })
+ beg <- max(beg, modelAdaptivePhase())
+ samplesSetBeg(beg)
+ samplesSetEnd(end)
+ samplesSetFirstChain(firstChain)
+ samplesSetLastChain(lastChain)
+ thin <- max(c(thin, 1))
+ samplesSetThin(thin)
+ command <- paste("SamplesEmbed.SetVariable(", sQuote(node),
+ ");SamplesEmbed.StatsGuard;", "SamplesEmbed.CODA(",
+ sQuote(stem), ")")
+ .C("CmdInterpreter", as.character(command), nchar(command),
+ integer(1), PACKAGE="BRugs")
+ buffer()
+}
Property changes on: trunk/BRugs/R/samples.coda.R
___________________________________________________________________
Name: svn:keywords
+ Id
Added: trunk/BRugs/R/samples.correl.R
===================================================================
--- trunk/BRugs/R/samples.correl.R (rev 0)
+++ trunk/BRugs/R/samples.correl.R 2006-11-24 13:31:35 UTC (rev 4)
@@ -0,0 +1,38 @@
+"samplesCorrel" <-
+function(node0, node1, beg = samplesGetBeg(), end = samplesGetEnd(),
+firstChain = samplesGetFirstChain(), lastChain = samplesGetLastChain(),
+thin = samplesGetThin())
+# Correlation matrix of two quantities in OpenBUGS model
+{
+ oldBeg <- samplesGetBeg()
+ oldEnd <- samplesGetEnd()
+ oldFirstChain <- samplesGetFirstChain()
+ oldLastChain <- samplesGetLastChain()
+ oldThin <- samplesGetThin()
+ on.exit({
+ samplesSetBeg(oldBeg)
+ samplesSetEnd(oldEnd)
+ sa...
[truncated message content] |
|
From: <gg...@us...> - 2006-11-24 13:57:59
|
Revision: 5
http://svn.sourceforge.net/bugs-r/?rev=5&view=rev
Author: ggorjan
Date: 2006-11-24 05:57:58 -0800 (Fri, 24 Nov 2006)
Log Message:
-----------
adding inst folder and CITATION file
Added Paths:
-----------
trunk/BRugs/inst/
trunk/BRugs/inst/CITATION
Added: trunk/BRugs/inst/CITATION
===================================================================
--- trunk/BRugs/inst/CITATION (rev 0)
+++ trunk/BRugs/inst/CITATION 2006-11-24 13:57:58 UTC (rev 5)
@@ -0,0 +1,19 @@
+citHeader("To cite the R package BRugs in publications use:")
+
+citEntry(entry = "article",
+ title = "Making BUGS Open",
+ author = personList(
+ person(first="Andrew", last="Thomas", email=""),
+ person(first="Bob", last="O'Hara", email=""),
+ person(first="Uwe", last="Ligges", email="Uwe...@R-..."),
+ person(first="Sibylle", last="Sturtz", email="st...@st...")),
+ journal = "R News",
+ year = 2006,
+ pages = "12--17",
+ number = 1,
+ volume = 6,
+ url = "http://cran.r-project.org/doc/Rnews/",
+ textVersion = paste("Thomas, A., O'Hara, B., Ligges, U., and Sturtz, S. (2006).",
+ "Making BUGS Open.",
+ "R News 6 (1), 12-17.")
+ )
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <woo...@us...> - 2007-08-03 14:47:07
|
Revision: 33
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=33&view=rev
Author: woodard_
Date: 2007-08-03 07:47:08 -0700 (Fri, 03 Aug 2007)
Log Message:
-----------
Allow samplesMonitors to handle vectors of parameter names rather than a single parameter name. Fix typos in error messages. More edits for improved compatibility with S-PLUS.
Modified Paths:
--------------
trunk/BRugs/R/buildMCMC.R
trunk/BRugs/R/plot.bgr.R
trunk/BRugs/R/plot.density.R
trunk/BRugs/R/plot.history.R
trunk/BRugs/R/samples.monitors.R
trunk/BRugs/man/help.WinBUGS.Rd
Modified: trunk/BRugs/R/buildMCMC.R
===================================================================
--- trunk/BRugs/R/buildMCMC.R 2007-07-31 18:19:44 UTC (rev 32)
+++ trunk/BRugs/R/buildMCMC.R 2007-08-03 14:47:08 UTC (rev 33)
@@ -83,6 +83,9 @@
}
mcmcobj <- lapply(samplesChain, mcmc, start = beg, end = end, thin = thin)
- class(mcmcobj) <- "mcmc.list"
+ if(is.R())
+ class(mcmcobj) <- "mcmc.list"
+ else
+ oldClass(mcmcobj) <- "mcmc.list"
mcmcobj
}
Modified: trunk/BRugs/R/plot.bgr.R
===================================================================
--- trunk/BRugs/R/plot.bgr.R 2007-07-31 18:19:44 UTC (rev 32)
+++ trunk/BRugs/R/plot.bgr.R 2007-08-03 14:47:08 UTC (rev 33)
@@ -5,7 +5,7 @@
{
sM <- samplesMonitors(node)
if(length(sM) > 1 || sM != node)
- stop("node must be a scalar variable from the model, for arrays use samplesAutoC")
+ stop("node must be a scalar variable from the model, for arrays use samplesBgr")
grid <- bgrGrid(node, bins = bins)
bgr <- sapply(grid, bgrPoint, node = node)
yRange <- range(bgr[4,])
Modified: trunk/BRugs/R/plot.density.R
===================================================================
--- trunk/BRugs/R/plot.density.R 2007-07-31 18:19:44 UTC (rev 32)
+++ trunk/BRugs/R/plot.density.R 2007-08-03 14:47:08 UTC (rev 33)
@@ -4,7 +4,7 @@
{
sM <- samplesMonitors(node)
if(length(sM) > 1 || sM != node)
- stop("node must be a scalar variable from the model, for arrays use samplesAutoC")
+ stop("node must be a scalar variable from the model, for arrays use samplesDensity")
nodeName <- sQuote(node)
command <- paste("SamplesEmbed.SetVariable(", nodeName, ")")
.C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
Modified: trunk/BRugs/R/plot.history.R
===================================================================
--- trunk/BRugs/R/plot.history.R 2007-07-31 18:19:44 UTC (rev 32)
+++ trunk/BRugs/R/plot.history.R 2007-08-03 14:47:08 UTC (rev 33)
@@ -5,7 +5,7 @@
{
sM <- samplesMonitors(node)
if(length(sM) > 1 || sM != node)
- stop("node must be a scalar variable from the model, for arrays use samplesAutoC")
+ stop("node must be a scalar variable from the model, for arrays use samplesHistory")
nodeName <- sQuote(node)
command <- paste("SamplesEmbed.SetVariable(", nodeName, ")")
.C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
Modified: trunk/BRugs/R/samples.monitors.R
===================================================================
--- trunk/BRugs/R/samples.monitors.R 2007-07-31 18:19:44 UTC (rev 32)
+++ trunk/BRugs/R/samples.monitors.R 2007-08-03 14:47:08 UTC (rev 33)
@@ -2,6 +2,7 @@
function(node)
# List all sample monitors corresponding to node
{
+ if (is.R()){
command <- paste("SamplesEmbed.SetVariable(", sQuote(node),
");SamplesEmbed.StatsGuard;SamplesEmbed.Labels")
.C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
@@ -16,10 +17,34 @@
invisible("model has probably not yet been updated")
}
else {
- if (is.R())
scan(buffer, what = "character", quiet = TRUE, sep="\n")
- else
- scan(buffer, what = "character", sep="\n")
}
}
+ } else {
+ sampsMonsSingle <- function(node){
+ command <- paste("SamplesEmbed.SetVariable(", sQuote(node),
+ ");SamplesEmbed.StatsGuard;SamplesEmbed.Labels")
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ buffer <- file.path(tempdir(), "buffer.txt")
+ rlb <- readLines(buffer)
+ len <- length(rlb)
+ if (len == 1 && rlb == "command is not allowed (greyed out)")
+ message(rlb)
+ else{
+ if(len == 0){
+ message("model has probably not yet been updated")
+ invisible("model has probably not yet been updated")
+ }
+ else {
+ scan(buffer, what = "character", sep="\n")
+ }
+ }
+ }
+ for(i in seq(along=node)){
+ mons <- lapply(node, sampsMonsSingle)
+ }
+ mons <- unlist(mons)
+ return(mons)
+
+ }
}
Modified: trunk/BRugs/man/help.WinBUGS.Rd
===================================================================
--- trunk/BRugs/man/help.WinBUGS.Rd 2007-07-31 18:19:44 UTC (rev 32)
+++ trunk/BRugs/man/help.WinBUGS.Rd 2007-08-03 14:47:08 UTC (rev 33)
@@ -8,6 +8,9 @@
\arguments{
\item{browser}{the name of the program to be used as hypertext browser. It should be in the PATH, or a full path specified.}
}
+\details{
+ Not yet available in S-PLUS.
+}
\seealso{\code{\link{help.BRugs}}}
\examples{
\dontrun{
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <li...@us...> - 2007-09-14 11:21:59
|
Revision: 55
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=55&view=rev
Author: ligges
Date: 2007-09-14 04:21:12 -0700 (Fri, 14 Sep 2007)
Log Message:
-----------
some more deleted functions (get*Obj) - API has gone, NAMESPACE adapted
Modified Paths:
--------------
trunk/BRugs/NAMESPACE
Removed Paths:
-------------
trunk/BRugs/R/get.graphObj.R
trunk/BRugs/R/get.updaterObj.R
trunk/BRugs/man/get.Obj.Rd
Modified: trunk/BRugs/NAMESPACE
===================================================================
--- trunk/BRugs/NAMESPACE 2007-09-14 10:13:36 UTC (rev 54)
+++ trunk/BRugs/NAMESPACE 2007-09-14 11:21:12 UTC (rev 55)
@@ -2,8 +2,7 @@
importFrom(coda, mcmc)
export(BRugsFit, bugsData, bugsInits, buildMCMC, currentValues,
dicClear, dicSet, dicStats,
-getGraphObj, getNumChains,
-getUpdaterObj, help.BRugs, help.WinBUGS, loadModule,
+getNumChains, help.BRugs, help.WinBUGS,
modelAdaptivePhase, modelCheck, modelCompile, modelData,
modelGenInits, modelGetSeed, modelInits, modelIteration,
modelModules, modelNames, modelPrecision, modelSaveState,
Deleted: trunk/BRugs/R/get.graphObj.R
===================================================================
--- trunk/BRugs/R/get.graphObj.R 2007-09-14 10:13:36 UTC (rev 54)
+++ trunk/BRugs/R/get.graphObj.R 2007-09-14 11:21:12 UTC (rev 55)
@@ -1,9 +0,0 @@
-"getGraphObj" <-
-function(node)
-# Get type of GraphNode objects
-{
- command <- paste("BugsEmbed.SetVariable(", sQuote(node), "); BugsEmbed.Nodes")
- .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
- buffer <- file.path(tempdir(), "buffer.txt")
- read.table(buffer)
-}
Deleted: trunk/BRugs/R/get.updaterObj.R
===================================================================
--- trunk/BRugs/R/get.updaterObj.R 2007-09-14 10:13:36 UTC (rev 54)
+++ trunk/BRugs/R/get.updaterObj.R 2007-09-14 11:21:12 UTC (rev 55)
@@ -1,9 +0,0 @@
-"getUpdaterObj" <-
-function(node)
-# Get type of UpdaterUpdaters objects
-{
- command <- paste("BugsEmbed.SetVariable(", sQuote(node), "); BugsEmbed.Methods")
- .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
- buffer <- file.path(tempdir(), "buffer.txt")
- read.table(buffer)
-}
Deleted: trunk/BRugs/man/get.Obj.Rd
===================================================================
--- trunk/BRugs/man/get.Obj.Rd 2007-09-14 10:13:36 UTC (rev 54)
+++ trunk/BRugs/man/get.Obj.Rd 2007-09-14 11:21:12 UTC (rev 55)
@@ -1,30 +0,0 @@
-\name{getObj}
-\alias{getGraphObj}
-\alias{getUpdaterObj}
-\title{Expert functions}
-\description{Getting class names of Component Pascal object}
-\usage{
-getGraphObj(node)
-getUpdaterObj(node)
-}
-\arguments{
- \item{node}{Character vector of length 1, name of a variable in the model.}
-}
-\details{
-OpenBUGS creates Component Pascal objects to represent each component of a name in the graphial model.
-}
-\value{
-\code{getGraphObj} returns a data frame of the class names of the Component Pascal object associated with each component.
-
-\code{getUpdaterObj} returns a data frame of the class names of the Component Pascal object
-for each component of a variable that needs updating.
-}
-\seealso{\code{\link{BRugs}}, \code{\link{help.WinBUGS}}}
-\keyword{interface}
-
-
-
-
-
-
-
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <li...@us...> - 2007-07-25 09:26:32
|
Revision: 31
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=31&view=rev
Author: ligges
Date: 2007-07-25 02:25:49 -0700 (Wed, 25 Jul 2007)
Log Message:
-----------
- OpenBUGS 3.0.1 has been integrated (most of the work done by Dawn Woodard, Insighful, thank you Dawn!)
- BRugs has been ported to S-PLUS (all of the work done by Dawn Woodard, Insighful, thank you Dawn!)
Modified Paths:
--------------
trunk/BRugs/DESCRIPTION
trunk/BRugs/NAMESPACE
trunk/BRugs/R/bgr.point.R
trunk/BRugs/R/bugs.data.R
trunk/BRugs/R/bugs.inits.R
trunk/BRugs/R/buildMCMC.R
trunk/BRugs/R/dic.stats.R
trunk/BRugs/R/model.check.R
trunk/BRugs/R/model.data.R
trunk/BRugs/R/model.factory.R
trunk/BRugs/R/model.inits.R
trunk/BRugs/R/plot.autoC.R
trunk/BRugs/R/plot.density.R
trunk/BRugs/R/plot.history.R
trunk/BRugs/R/samples.autoC.R
trunk/BRugs/R/samples.bgr.R
trunk/BRugs/R/samples.density.R
trunk/BRugs/R/samples.history.R
trunk/BRugs/R/samples.monitors.R
trunk/BRugs/R/samples.sample.R
trunk/BRugs/R/samples.stats.R
trunk/BRugs/R/summary.stats.R
trunk/BRugs/R/unix/help.R
trunk/BRugs/R/windows/help.R
trunk/BRugs/R/write.model.R
trunk/BRugs/R/zzz.R
trunk/BRugs/configure
trunk/BRugs/man/BRugs.Rd
trunk/BRugs/man/samples.autoC.Rd
trunk/BRugs/man/samples.bgr.Rd
trunk/BRugs/man/samples.density.Rd
trunk/BRugs/man/samples.history.Rd
trunk/BRugs/tests/BRugs.Rout.save
Added Paths:
-----------
trunk/BRugs/inst/README-inst_OpenBUGS
Modified: trunk/BRugs/DESCRIPTION
===================================================================
--- trunk/BRugs/DESCRIPTION 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/DESCRIPTION 2007-07-25 09:25:49 UTC (rev 31)
@@ -1,12 +1,11 @@
Package: BRugs
-Title: OpenBUGS and its R interface BRugs
-Version: 0.3-3
-Date: 2006-09-12
+Title: OpenBUGS and its R / S-PLUS interface BRugs
+Version: 0.4-0
+Date: 2007-07-24
Author: The Chief Software Bug is Andrew Thomas, with web assistance from Real Bug Bob O'Hara. Other members of the BUGS team are statisticians David Spiegelhalter, Nicky Best, Dave Lunn and Ken Rice. Dave Lunn has also made major contributions to the software development. R Code modified, extended and packaged for R by Uwe Ligges and Sibylle Sturtz. Some ideas taken from the R2WinBUGS package based on code by Andrew Gelman.
-Description: An R package containing OpenBUGS and its R interface BRugs.
+Description: An R / S-PLUS package containing OpenBUGS and its R / S-PLUS interface BRugs.
Maintainer: Uwe Ligges <li...@st...>
-Depends: R (>= 2.0.0)
-Suggests: coda
+Depends: R (>= 2.5.0), coda
SystemRequirements: currently the only supported OS is Windows, we expect to support Linux in future releases
License: GPL version 2
URL: http://mathstat.helsinki.fi/openbugs/
Modified: trunk/BRugs/NAMESPACE
===================================================================
--- trunk/BRugs/NAMESPACE 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/NAMESPACE 2007-07-25 09:25:49 UTC (rev 31)
@@ -1,4 +1,5 @@
useDynLib(BRugs)
+importFrom(coda, mcmc)
export(BRugsFit, bugsData, bugsInits, buildMCMC, currentValues,
dicClear, dicSet, dicStats,
getGraphObj, getNumChains,
Modified: trunk/BRugs/R/bgr.point.R
===================================================================
--- trunk/BRugs/R/bgr.point.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/bgr.point.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -12,14 +12,24 @@
sampleSize <- as.integer(.C("Integer", command, nchar(command),
integer(1), integer(1), PACKAGE="BRugs")[[3]])
command <- "SamplesEmbed.Sample"
- sample <- .C("RealArray", command, nchar(command), real(sampleSize),
- as.integer(sampleSize), integer(1), PACKAGE="BRugs")[[3]]
+ if (is.R())
+ sample <- .C("RealArray", command, nchar(command), real(sampleSize),
+ as.integer(sampleSize), integer(1), PACKAGE="BRugs")[[3]]
+ else
+ sample <- .C("RealArray", command, nchar(command), double(sampleSize),
+ as.integer(sampleSize), integer(1), PACKAGE="BRugs")[[3]]
lenChain <- sampleSize %/% numChains
- dq <- quantile(sample, c(0.1, 0.9), names = FALSE)
+ if (is.R())
+ dq <- quantile(sample, c(0.1, 0.9), names = FALSE)
+ else
+ dq <- quantile(sample, c(0.1, 0.9))
d.delta <- dq[2] - dq[1]
n.delta <- 0
for (i in 1:numChains) {
- nq <- quantile(sample[((i - 1) * lenChain + 1) : (i * lenChain)], c(0.1, 0.9), names = FALSE)
+ if (is.R())
+ nq <- quantile(sample[((i - 1) * lenChain + 1) : (i * lenChain)], c(0.1, 0.9), names = FALSE)
+ else
+ nq <- quantile(sample[((i - 1) * lenChain + 1) : (i * lenChain)], c(0.1, 0.9))
n.delta <- n.delta + nq[2] - nq[1]
}
n.delta <- n.delta / numChains
Modified: trunk/BRugs/R/bugs.data.R
===================================================================
--- trunk/BRugs/R/bugs.data.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/bugs.data.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -1,11 +1,237 @@
-"bugsData" <-
+"bugsData" <-
function(data, fileName = file.path(getwd(), "data.txt"), digits = 5){
if(is.numeric(unlist(data)))
- write.datafile(lapply(data, formatC, digits = digits, format = "E"), fileName)
+ if(is.R()) {
+ write.datafile(lapply(data, formatC, digits = digits, format = "E"), fileName)
+ }
+ else {
+ writeDatafileS4(data, towhere = "data.txt")
+ }
else {
- data.list <- lapply(as.list(data), get, pos = parent.frame(2))
- names(data.list) <- as.list(data)
- write.datafile(lapply(data.list, formatC, digits = digits, format = "E"), fileName)
- }
+ if(is.R()) {
+ data.list <- lapply(as.list(data), get, pos = parent.frame(2))
+ names(data.list) <- as.list(data)
+ write.datafile(lapply(data.list, formatC, digits = digits, format = "E"), fileName)
+ }
+ else {
+ data.list <- lapply(as.list(data), get, where = parent.frame(2))
+ names(data.list) <- unlist(data)
+ writeDatafileS4(data.list, towhere = "data.txt")
+ }
+ }
invisible(fileName)
}
+
+
+if(is.R()){
+ ## need some fake functions for codetools
+ toSingleS4 <- function(...)
+ stop("This function is not intended to be called in R!")
+ "writeDatafileS4" <- toSingleS4
+} else {
+
+### The rest of this file is for S-PLUS only...
+
+
+"writeDatafileS4" <-
+#
+# Writes to file "towhere" text defining a list containing "DATA" in a form compatable with WinBUGS.
+# Required arguments:
+# DATA - either a data frame or else a list consisting of any combination of scalars, vectors, arrays or data frames (but not lists).
+# If a list, all list elements that are not data.frames must be named. Names of data.frames in DATA are ignored.
+# Optional arguments:
+# towhere - file to receive output. Is clipboard by default, which is convenient for pasting into a WinBUTS ODC file.
+# fill - If numeric, number of columns for output. If FALSE, output will be on one line. If TRUE (default), number of
+# columns is given by .Options$width.
+# Value:
+# Text defining a list is output to file "towhere".
+# Details:
+# The function performs considerable checking of DATA argument. Since WinBUGS requires numeric input, no factors or character vectors
+# are allowed. All data must be named, either as named elements of DATA (if it is a list) or else using the names given in data frames.
+# Data frames may contain matrices.
+# Arrays of any dimension are rearranged to be in row-major order, as required by WinBUGS. Scientific notation is also handled properly.
+# In particular, the number will consist of a mantissa _containing a decimal point_ followed by "E", then either "+" or "-", and finally
+# a _two-digit_ number. S-Plus does not always provide a decimal point in the mantissa, uses "e" instead of "E", followed by
+# either a "+" or "-" and then _three_ digits.
+# Written by Terry Elrod. Disclaimer: This function is used at the user's own risk.
+# Please send comments to Ter...@UA....
+# Revision history: 2002-11-19. Fixed to handle missing values properly.
+function(DATA, towhere = "clipboard", fill = TRUE)
+{
+ formatDataS4 =
+ #
+ # Prepared DATA for input to WinBUGS.
+ function(DATA)
+ {
+ if(!is.list(DATA))
+ stop("DATA must be a named list or data frame.")
+ dlnames <- names(DATA)
+ if(is.data.frame(DATA))
+ DATA <- as.list(DATA)
+ #
+ # Checking for lists in DATA....
+ lind <- sapply(DATA, is.list)
+ # Checking for data frames in DATA....
+ dfind <- sapply(DATA, is.data.frame)
+ # Any lists that are not data frames?...
+ if(any(lind & !dfind)) stop("DATA may not contain lists.")
+ # Checking for unnamed elements of list that are not data frames....
+ if(any(dlnames[!dfind] == "")) stop(
+ "When DATA is a list, all its elements that are not data frames must be named."
+ )
+ # Checking for duplicate names....
+ dupnames <- unique(dlnames[duplicated(dlnames)])
+ if(length(dupnames) > 0)
+ stop(paste(
+ "The following names are used more than once in DATA:",
+ paste(dupnames, collapse = ", ")))
+ if(any(dfind)) {
+ dataold <- DATA
+ DATA <- vector("list", 0)
+ for(i in seq(along = dataold)) {
+ if(dfind[i])
+ DATA <- c(DATA, as.list(dataold[[i]]))
+ else DATA <- c(DATA, dataold[i])
+ }
+ dataold <- NULL
+ }
+ dlnames <- names(DATA)
+ dupnames <- unique(dlnames[duplicated(dlnames)])
+ # Checking for duplicated names again (now that columns of data frames are included)....
+ if(length(dupnames) > 0) stop(paste(
+ "The following names are used more than once in DATA (at least once within a data frame):",
+ paste(dupnames, collapse = ", ")))
+ # Checking for factors....
+ factorind <- sapply(DATA, is.factor)
+ if(any(factorind))
+ stop(paste(
+ "DATA may not include factors. One or more factor variables were detected:",
+ paste(dlnames[factorind], collapse = ", ")))
+ # Checking for character vectors....
+ charind <- sapply(DATA, is.character)
+ if(any(charind))
+ stop(paste(
+ "WinBUGS does not handle character data. One or more character variables were detected:",
+ paste(dlnames[charind], collapse = ", ")))
+ # Checking for complex vectors....
+ complexind <- sapply(DATA, is.complex)
+ if(any(complexind))
+ stop(paste(
+ "WinBUGS does not handle complex data. One or more complex variables were detected:",
+ paste(dlnames[complexind], collapse = ", ")))
+ # Checking for values farther from zero than 1E+38 (which is limit of single precision)....
+ toobigind <- sapply(DATA, function(x)
+ {
+ y <- abs(x[!is.na(x)])
+ any(y[y > 0] > 9.9999999999999998e+37)
+ }
+ )
+ if(any(toobigind))
+ stop(paste(
+ "WinBUGS works in single precision. The following variables contain data outside the range +/-1.0E+38: ",
+ paste(dlnames[toobigind], collapse = ", "),
+ ".\n", sep = ""))
+ # Checking for values in range +/-1.0E-38 (which is limit of single precision)....
+ toosmallind <- sapply(DATA, function(x)
+ {
+ y <- abs(x[!is.na(x)])
+ any(y[y > 0] < 9.9999999999999996e-39)
+ }
+ )
+ n <- length(dlnames)
+ data.string <- as.list(rep(NA, n))
+ for(i in 1:n) {
+ if(length(DATA[[i]]) == 1) {
+ ac <- toSingleS4(DATA[[i]])
+ data.string[[i]] <- paste(names(DATA)[i], "=",
+ ac, sep = "")
+ next
+ }
+ if(is.vector(DATA[[i]]) & length(DATA[[i]]) > 1) {
+ ac <- toSingleS4(DATA[[i]])
+ data.string[[i]] <- paste(names(DATA)[i], "=c(",
+ paste(ac, collapse = ", "), ")", sep =
+ "")
+ next
+ }
+ if(is.array(DATA[[i]])) {
+ ac <- toSingleS4(aperm(DATA[[i]]))
+ data.string[[i]] <- paste(names(DATA)[i],
+ "= structure(.Data= c(", paste(ac,
+ collapse = ", "), "), \n .Dim=c(",
+ paste(as.character(dim(DATA[[i]])),
+ collapse = ", "), "))", sep = "")
+ }
+ }
+ data.tofile <- paste("list(", paste(unlist(data.string),
+ collapse = ", "), ")", sep = "")
+ if(any(toosmallind))
+ warning(paste(
+ "WinBUGS works in single precision. The following variables contained nonzero data",
+ "\ninside the range +/-1.0E-38 that were set to zero: ",
+ paste(dlnames[toosmallind], collapse = ", "),
+ ".\n", sep = ""))
+ return(data.tofile)
+ }
+ rslt <- formatDataS4(DATA)
+ cat(rslt, file = towhere, fill = fill)
+ invisible(0)
+}
+
+
+toSingleS4 <-
+#
+# Takes numeric vector and removes digit of exponent in scientific notation (if any)
+#
+# Written by Terry Elrod. Disclaimer: This function is used at the user's own risk.
+# Please send comments to Ter...@UA....
+# Revision history: 2002-11-19. Fixed to handle missing values properly.
+function(x)
+{
+ xdim <- dim(x)
+ x <- as.character(as.single(x))
+
+ # First to look for positives:
+ pplus <- regMatchPos(x, "e\\+0")
+ pplusind <- apply(pplus, 1, function(y)
+ (!any(is.na(y))))
+ if(any(pplusind)) {
+ # Making sure that periods are in mantissa...
+ init <- substring(x[pplusind], 1, pplus[
+ pplusind, 1] - 1)
+ #...preceeding exponent
+ pper <- regMatchPos(init, "\\.")
+ pperind <- apply(pper, 1, function(y)
+ (all(is.na(y))))
+ if(any(pperind))
+ init[pperind] <- paste(init[pperind],
+ ".0", sep = "")
+ # Changing the format of the exponent...
+ x[pplusind] <- paste(init, "E+", substring(
+ x[pplusind], pplus[pplusind, 2] + 1),
+ sep = "")
+ }
+ # Then to look for negatives:
+ pminus <- regMatchPos(x, "e\\-0")
+ pminusind <- apply(pminus, 1, function(y)
+ (!any(is.na(y))))
+ if(any(pminusind)) {
+ # Making sure that periods are in mantissa...
+ init <- substring(x[pminusind], 1, pminus[
+ pminusind, 1] - 1)
+ #...preceeding exponent
+ pper <- regMatchPos(init, "\\.")
+ pperind <- apply(pper, 1, function(y)
+ (all(is.na(y))))
+ if(any(pperind))
+ init[pperind] <- paste(init[pperind],
+ ".0", sep = "")
+ # Changing the format of the exponent...
+ x[pminusind] <- paste(init, "E-", substring(
+ x[pminusind], pminus[pminusind, 2] +
+ 1), sep = "")
+ }
+ x
+}
+
+}
Modified: trunk/BRugs/R/bugs.inits.R
===================================================================
--- trunk/BRugs/R/bugs.inits.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/bugs.inits.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -7,9 +7,15 @@
if(!is.null(inits)){
for (i in 1:numChains){
if (is.function(inits))
- write.datafile(lapply(inits(), formatC, digits = digits, format = "E"), fileName[i])
+ if (is.R())
+ write.datafile(lapply(inits(), formatC, digits = digits, format = "E"), fileName[i])
+ else
+ writeDatafileS4(inits(), towhere = fileName[i])
else
- write.datafile(lapply(inits[[i]], formatC, digits = digits, format = "E"), fileName[i])
+ if (is.R())
+ write.datafile(lapply(inits[[i]], formatC, digits = digits, format = "E"), fileName[i])
+ else
+ writeDatafileS4(inits[[i]], towhere = fileName[i])
}
}
invisible(fileName)
Modified: trunk/BRugs/R/buildMCMC.R
===================================================================
--- trunk/BRugs/R/buildMCMC.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/buildMCMC.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -1,7 +1,11 @@
buildMCMC <- function(node, beg = samplesGetBeg(), end = samplesGetEnd(),
firstChain = samplesGetFirstChain(), lastChain = samplesGetLastChain(),
thin = samplesGetThin()){
+
+ if(!is.R() && !require("coda"))
+ stop("package 'coda' is required to use this function")
+
oldBeg <- samplesGetBeg()
oldEnd <- samplesGetEnd()
oldFirstChain <- samplesGetFirstChain()
@@ -34,8 +38,12 @@
sampleSize <- as.integer(.C("Integer", command, nchar(command),
integer(1), integer(1), PACKAGE = "BRugs")[[3]])
command <- "SamplesEmbed.Sample"
- sample <- .C("RealArray", command, nchar(command), real(sampleSize),
+ if (is.R())
+ sample <- .C("RealArray", command, nchar(command), real(sampleSize),
sampleSize, integer(1), PACKAGE = "BRugs")[[3]]
+ else
+ sample <- .C("RealArray", command, nchar(command), double(sampleSize),
+ sampleSize, integer(1), PACKAGE = "BRugs")[[3]]
numChains <- samplesGetLastChain() - samplesGetFirstChain() + 1
matrix(sample, ncol = numChains)
}
@@ -59,7 +67,10 @@
samplesChain <- vector(mode="list", length=numChains)
for(i in 1:numChains){
- temp <- sapply(samples, function(x) x[,i])
+ 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
@@ -71,13 +82,7 @@
# }
}
- require(coda)
mcmcobj <- lapply(samplesChain, mcmc, start = beg, end = end, thin = thin)
class(mcmcobj) <- "mcmc.list"
mcmcobj
}
-
-
-
-
-
Modified: trunk/BRugs/R/dic.stats.R
===================================================================
--- trunk/BRugs/R/dic.stats.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/dic.stats.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -7,8 +7,14 @@
buffer <- file.path(tempdir(), "buffer.txt")
rlb <- readLines(buffer)
len <- length(rlb)
- if (len > 1)
+ if (len > 1) {
+ # Remove the extra lines in the buffer that contain the minimum deviance information
+ minDeviancePos <- regexpr(pattern = "Minimum deviance", text = rlb)
+ lineToRemove <- which(minDeviancePos != -1)
+ rlb <- rlb [1:(lineToRemove-1)]
+ writeLines(rlb, buffer)
read.table(buffer)
- else
+ } else {
message(rlb)
+ }
}
Modified: trunk/BRugs/R/model.check.R
===================================================================
--- trunk/BRugs/R/model.check.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/model.check.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -11,7 +11,11 @@
stop(fileName, " is a directory, but a file is required")
command <- paste("BugsEmbed.SetFilePath(", sQuote(fileName),
");BugsEmbed.ParseGuard;BugsEmbed.Parse", sep = "")
- .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
+ if (!is.R()) {
+ command <- gsub ("\\\\", "/", command)
+ command <- gsub ("//", "/", command)
+ }
+ .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE = "BRugs")
if(getOption("BRugsVerbose"))
buffer()
}
Modified: trunk/BRugs/R/model.data.R
===================================================================
--- trunk/BRugs/R/model.data.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/model.data.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -12,6 +12,10 @@
stop(fileNm, " is a directory, but a file is required")
command <- paste("BugsEmbed.SetFilePath(", sQuote(fileNm),
");BugsEmbed.LoadDataGuard;BugsEmbed.LoadData", sep = "")
+ if (!is.R()){
+ command <- gsub ("\\\\", "/", command)
+ command <- gsub ("//", "/", command)
+ }
.C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
if(getOption("BRugsVerbose"))
buffer()
Modified: trunk/BRugs/R/model.factory.R
===================================================================
--- trunk/BRugs/R/model.factory.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/model.factory.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -1,6 +1,6 @@
modelDisable <- function(factory){
command <- paste("UpdaterMethods.SetFactory('", factory,"');UpdaterMethods.Disable", sep = "")
- invisible(.C("CmdInterpreter", comand, nchar(command), integer(1)))
+ invisible(.C("CmdInterpreter", command, nchar(command), integer(1)))
}
Modified: trunk/BRugs/R/model.inits.R
===================================================================
--- trunk/BRugs/R/model.inits.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/model.inits.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -22,6 +22,10 @@
command <- paste("BugsEmbed.SetFilePath(", filename,
"); BugsEmbed.LoadInitsGuard; BugsEmbed.chain := ",
as.character(chainNum[i]), "; BugsEmbed.LoadInits")
+ if (!is.R()){
+ command <- gsub ("\\\\", "/", command)
+ command <- gsub ("//", "/", command)
+ }
.C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
if(getOption("BRugsVerbose")){
cat("Initializing chain ", chainNum[i], ": ", sep="")
Modified: trunk/BRugs/R/plot.autoC.R
===================================================================
--- trunk/BRugs/R/plot.autoC.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/plot.autoC.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -10,11 +10,19 @@
command <- paste("SamplesEmbed.SetVariable(", nodeName, ")")
.C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
command <- "SamplesEmbed.SampleSize"
- sampleSize <- as.integer(.C("Integer", command, nchar(command),
- integer(1), integer(1), PACKAGE="BRugs")[3])
+ if (is.R())
+ sampleSize <- as.integer(.C("Integer", command, nchar(command),
+ integer(1), integer(1), PACKAGE="BRugs")[3])
+ else
+ sampleSize <- as.integer(.C("Integer", command, nchar(command),
+ integer(1), integer(1), PACKAGE="BRugs")[[3]])
command <- "SamplesEmbed.Sample"
- sample <- .C("RealArray", command, nchar(command), real(sampleSize),
- as.integer(sampleSize), integer(1), PACKAGE="BRugs")[[3]]
+ if (is.R())
+ sample <- .C("RealArray", command, nchar(command), real(sampleSize),
+ as.integer(sampleSize), integer(1), PACKAGE="BRugs")[[3]]
+ else
+ sample <- .C("RealArray", command, nchar(command), double(sampleSize),
+ as.integer(sampleSize), integer(1), PACKAGE="BRugs")[[3]]
chain <- samplesGetFirstChain()
if (sd(sample) > 1.0E-10)
acfresult <- acf(sample, col = colour[chain], main = if(is.null(main)) nodeName else main,
Modified: trunk/BRugs/R/plot.density.R
===================================================================
--- trunk/BRugs/R/plot.density.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/plot.density.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -12,14 +12,22 @@
sampleSize <- as.integer(.C("Integer", command, nchar(command),
integer(1), integer(1), PACKAGE="BRugs")[[3]])
command <- "SamplesEmbed.Sample"
- sample <- .C("RealArray", command, nchar(command), real(sampleSize),
- as.integer(sampleSize), integer(1), PACKAGE="BRugs")[[3]]
+ if (is.R())
+ sample <- .C("RealArray", command, nchar(command), real(sampleSize),
+ as.integer(sampleSize), integer(1), PACKAGE="BRugs")[[3]]
+ else
+ sample <- .C("RealArray", command, nchar(command), double(sampleSize),
+ as.integer(sampleSize), integer(1), PACKAGE="BRugs")[[3]]
+
absSample <- abs(sample)
intSample <- as.integer(absSample + 1.0E-10)
zero <- absSample - intSample
intSample <- as.integer(sample)
if (sum(zero) > 0){
- d <- density(sample, adjust = 1.25)
+ if (is.R())
+ d <- density(sample, adjust = 1.25)
+ else
+ d <- density(sample)
plot(d$x, d$y, type = "l", main = if(is.null(main)) nodeName else main,
xlab = xlab , ylab = ylab, col = col, ...)
}
Modified: trunk/BRugs/R/plot.history.R
===================================================================
--- trunk/BRugs/R/plot.history.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/plot.history.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -10,11 +10,20 @@
command <- paste("SamplesEmbed.SetVariable(", nodeName, ")")
.C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
command <- "SamplesEmbed.SampleSize"
- sampleSize <- as.integer(.C("Integer", command, nchar(command),
+ if (is.R()){
+ sampleSize <- as.integer(.C("Integer", command, nchar(command),
integer(1), integer(1), PACKAGE="BRugs")[3])
+ } else {
+ sampleSize <- as.integer(.C("Integer", command, nchar(command),
+ integer(1), integer(1), PACKAGE="BRugs")[3][[1]])
+ }
command <- "SamplesEmbed.Sample"
- sample <- .C("RealArray", command, nchar(command), real(sampleSize),
- sampleSize, integer(1), PACKAGE="BRugs")[[3]]
+ if (is.R())
+ sample <- .C("RealArray", command, nchar(command), real(sampleSize),
+ sampleSize, integer(1), PACKAGE="BRugs")[[3]]
+ else
+ sample <- .C("RealArray", command, nchar(command), double(sampleSize),
+ sampleSize, integer(1), PACKAGE="BRugs")[[3]]
end <- min(c(modelIteration(), samplesGetEnd()))
thin <- samplesGetThin()
numChains <- samplesGetLastChain() - samplesGetFirstChain() + 1
Modified: trunk/BRugs/R/samples.autoC.R
===================================================================
--- trunk/BRugs/R/samples.autoC.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/samples.autoC.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -3,8 +3,12 @@
thin = samplesGetThin(), plot = TRUE, mfrow = c(3, 2), ask = NULL, ann = TRUE, ...)
# Plot auto correlation function
{
- if(is.null(ask))
+ if(is.null(ask)) {
+ if (is.R())
ask <- !((dev.cur() > 1) && !dev.interactive())
+ else
+ ask <- !((dev.cur() > 1) && !interactive())
+ }
oldBeg <- samplesGetBeg()
oldEnd <- samplesGetEnd()
oldFirstChain <- samplesGetFirstChain()
@@ -27,7 +31,10 @@
thin <- max(c(thin, 1))
samplesSetThin(thin)
mons <- samplesMonitors(node)
- par(mfrow = mfrow, ask = ask, ann = ann)
+ if (is.R())
+ par(mfrow = mfrow, ask = ask, ann = ann)
+ else
+ par(mfrow = mfrow, ask = ask)
result <- lapply(mons, plotAutoC, plot = plot, ...)
names(result) <- mons
if(plot) invisible(result)
Modified: trunk/BRugs/R/samples.bgr.R
===================================================================
--- trunk/BRugs/R/samples.bgr.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/samples.bgr.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -5,8 +5,12 @@
ask = NULL, ann = TRUE, ...)
# Plot bgr statistic
{
- if(is.null(ask))
+ if(is.null(ask)) {
+ if (is.R())
ask <- !((dev.cur() > 1) && !dev.interactive())
+ else
+ ask <- !((dev.cur() > 1) && !interactive())
+ }
oldBeg <- samplesGetBeg()
oldEnd <- samplesGetEnd()
oldFirstChain <- samplesGetFirstChain()
@@ -27,7 +31,10 @@
thin <- max(c(thin, 1))
samplesSetThin(thin)
mons <- samplesMonitors(node)
- par(mfrow = mfrow, ask = ask, ann = ann)
+ if (is.R())
+ par(mfrow = mfrow, ask = ask, ann = ann)
+ else
+ par(mfrow = mfrow, ask = ask)
result <- lapply(mons, plotBgr, bins = bins, plot = plot, ...)
names(result) <- mons
if(plot) invisible(result)
Modified: trunk/BRugs/R/samples.density.R
===================================================================
--- trunk/BRugs/R/samples.density.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/samples.density.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -4,8 +4,12 @@
thin = samplesGetThin(), mfrow = c(3, 2), ask = NULL, ann = TRUE, ...)
# Plot posterior density
{
- if(is.null(ask))
+ if(is.null(ask)) {
+ if (is.R())
ask <- !((dev.cur() > 1) && !dev.interactive())
+ else
+ ask <- !((dev.cur() > 1) && !interactive())
+ }
oldBeg <- samplesGetBeg()
oldEnd <- samplesGetEnd()
oldFirstChain <- samplesGetFirstChain()
@@ -26,6 +30,11 @@
thin <- max(c(thin, 1))
samplesSetThin(thin)
mons <- samplesMonitors(node)
- par(mfrow = mfrow, ask = ask, ann = ann)
+ if (is.R())
+ par(mfrow = mfrow, ask = ask, ann = ann)
+ else
+ par(mfrow = mfrow, ask = ask)
junk <- sapply(mons, plotDensity, ...)
+ if (!is.R())
+ invisible()
}
Modified: trunk/BRugs/R/samples.history.R
===================================================================
--- trunk/BRugs/R/samples.history.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/samples.history.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -4,8 +4,12 @@
thin = samplesGetThin(), plot = TRUE, mfrow = c(3, 1), ask = NULL, ann = TRUE, ...)
# Plot history
{
- if(is.null(ask))
+ if(is.null(ask)) {
+ if (is.R())
ask <- !((dev.cur() > 1) && !dev.interactive())
+ else
+ ask <- !((dev.cur() > 1) && !interactive())
+ }
oldBeg <- samplesGetBeg()
oldEnd <- samplesGetEnd()
oldFirstChain <- samplesGetFirstChain()
@@ -25,7 +29,10 @@
thin <- max(c(thin, 1))
samplesSetThin(thin)
mons <- samplesMonitors(node)
- par(mfrow = mfrow, ask = ask, ann = ann)
+ if (is.R())
+ par(mfrow = mfrow, ask = ask, ann = ann)
+ else
+ par(mfrow = mfrow, ask = ask)
result <- lapply(mons, plotHistory, plot = plot, ...)
names(result) <- mons
if(plot) invisible(result)
Modified: trunk/BRugs/R/samples.monitors.R
===================================================================
--- trunk/BRugs/R/samples.monitors.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/samples.monitors.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -15,7 +15,11 @@
message("model has probably not yet been updated")
invisible("model has probably not yet been updated")
}
- else
+ else {
+ if (is.R())
scan(buffer, what = "character", quiet = TRUE, sep="\n")
+ else
+ scan(buffer, what = "character", sep="\n")
+ }
}
}
Modified: trunk/BRugs/R/samples.sample.R
===================================================================
--- trunk/BRugs/R/samples.sample.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/samples.sample.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -10,6 +10,10 @@
sampleSize <- as.integer(.C("Integer", command, nchar(command),
integer(1), integer(1), PACKAGE="BRugs")[[3]])
command <- "SamplesEmbed.Sample"
- .C("RealArray", command, nchar(command),
- real(sampleSize), sampleSize, integer(1), PACKAGE="BRugs")[[3]]
+ if (is.R())
+ .C("RealArray", command, nchar(command),
+ real(sampleSize), sampleSize, integer(1), PACKAGE="BRugs")[[3]]
+ else
+ .C("RealArray", command, nchar(command),
+ double(sampleSize), sampleSize, integer(1), PACKAGE="BRugs")[[3]]
}
Modified: trunk/BRugs/R/samples.stats.R
===================================================================
--- trunk/BRugs/R/samples.stats.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/samples.stats.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -23,10 +23,16 @@
thin <- max(c(thin, 1))
samplesSetThin(thin)
nodeName <- sQuote(node)
+
+ if (is.R()){
+ result <- data.frame(mean=NULL, sd=NULL, MC_error = NULL, val2.5pc=NULL,
+ median=NULL, val97.5pc=NULL, start = NULL, sample=NULL)
+ } else {
+ result <- data.frame(mean=numeric(), sd=numeric(), MC.error = numeric(),
+ val2.5pc=numeric(), median=numeric(), val97.5pc=numeric(),
+ start = numeric(), sample=numeric())
+ }
-
- result <- data.frame(mean=NULL, sd=NULL, MC_error = NULL, val2.5pc=NULL,
- median=NULL, val97.5pc=NULL, start = NULL, sample=NULL)
for(i in seq(along=nodeName)){
command <- paste("SamplesEmbed.SetVariable(", nodeName[i],
");SamplesEmbed.StatsGuard;SamplesEmbed.Stats")
Modified: trunk/BRugs/R/summary.stats.R
===================================================================
--- trunk/BRugs/R/summary.stats.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/summary.stats.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -3,8 +3,12 @@
# Calculates statistics for summary monitor associated with node in OpenBUGS model
{
nodeName <- sQuote(node)
- result <- data.frame(mean=NULL, sd=NULL, val2.5pc=NULL,
- median=NULL, val97.5pc=NULL, sample=NULL)
+ if (is.R())
+ result <- data.frame(mean=NULL, sd=NULL, val2.5pc=NULL,
+ median=NULL, val97.5pc=NULL, sample=NULL)
+ else
+ result <- data.frame(mean=numeric(), sd=numeric(), val2.5pc=numeric(),
+ median=numeric(), val97.5pc=numeric(), sample=numeric())
for(i in seq(along=nodeName)){
command <- paste("SummaryEmbed.SetVariable(", nodeName[i], "); SummaryEmbed.StatsGuard;",
"SummaryEmbed.Stats")
Modified: trunk/BRugs/R/unix/help.R
===================================================================
--- trunk/BRugs/R/unix/help.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/unix/help.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -1,15 +1,17 @@
help.BRugs <- function(browser = getOption("browser"))
{
- # stolen from help.start()
- if(is.null(browser))
- stop("Invalid browser name, check options(\"browser\").")
- writeLines(strwrap(paste("If", browser, "is already running,",
- "it is *not* restarted, and you must",
- "switch to its window."),
- exdent = 4))
- writeLines("Otherwise, be patient ...")
- browseURL(system.file("OpenBUGS", "docu", "BRugs Manual.html", package="BRugs"))
- invisible("")
+ ## stolen from help.start()
+ # if(is.null(browser))
+ # stop("Invalid browser name, check options(\"browser\").")
+ # writeLines(strwrap(paste("If", browser, "is already running,",
+ # "it is *not* restarted, and you must",
+ # "switch to its window."),
+ # exdent = 4))
+ # writeLines("Otherwise, be patient ...")
+ # browseURL(system.file("OpenBUGS", "docu", "BRugs Manual.html", package="BRugs"))
+ # invisible("")
+ ## Andrew now omits the BRugs introduction, hence just pointing to help.WinBUGS these days:
+ help.WinBUGS(browser = browser)
}
help.WinBUGS <- function(browser = getOption("browser"))
Modified: trunk/BRugs/R/windows/help.R
===================================================================
--- trunk/BRugs/R/windows/help.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/windows/help.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -1,22 +1,27 @@
help.BRugs <- function(browser = getOption("browser"))
{
- # stolen from help.start()
- a <- system.file("OpenBUGS", "docu", "BRugs Manual.html", package="BRugs")
- if (!file.exists(a))
- stop("I can't find the html help")
- a <- chartr("/", "\\", a)
- message("If nothing happens, you should open `", a, "' yourself")
- browseURL(a, browser = browser)
- invisible("")
+ ## stolen from help.start()
+ # a <- system.file("OpenBUGS", "Manuals", "WinBUGS Manual.html", package="BRugs")
+ # if (!file.exists(a))
+ # stop("I can't find the html help")
+ # a <- chartr("/", "\\", a)
+ # message("If nothing happens, you should open `", a, "' yourself")
+ # browseURL(a, browser = browser)
+ # invisible("")
+ ## Andrew now omits the BRugs introduction, hence just pointing to help.WinBUGS these days:
+ help.WinBUGS(browser = browser)
}
help.WinBUGS <- function(browser = getOption("browser"))
{
# stolen from help.start()
- a <- system.file("OpenBUGS", "docu", "WinBUGS Manual.html", package="BRugs")
+ a <- system.file("OpenBUGS", "Manuals", "WinBUGS Manual.html", package="BRugs")
if (!file.exists(a))
stop("I can't find the html help")
- a <- chartr("/", "\\", a)
+ if (is.R())
+ a <- chartr("/", "\\", a)
+ else
+ a <- gsub ("/", "\\\\", a)
message("If nothing happens, you should open `", a, "' yourself")
browseURL(a, browser = browser)
invisible("")
Modified: trunk/BRugs/R/write.model.R
===================================================================
--- trunk/BRugs/R/write.model.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/write.model.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -1,7 +1,54 @@
writeModel <- function(model, con = "model.txt")
{
- model.text <- attr(model, "source")
- model.text <- sub("^\\s*function\\s*\\(\\s*\\)", "model", model.text)
+ if (is.R()){
+ model.text <- attr(model, "source")
+ model.text <- sub("^\\s*function\\s*\\(\\s*\\)", "model", model.text)
+ } else {
+ ## In S-PLUS the source code of a function can be obtained with
+ ## as.character(function_name). This omits the "function_name <- function()" piece
+ model.text <- as.character(model)
+ model.text <- paste("model", model.text)
+ }
model.text <- sub("%_%", "", model.text)
+ if (!is.R()){
+ ## In S-PLUS, scientific notation is different than it is in WinBUGS.
+ ## Change the format of any numbers in scientific notation.
+ model.text <- replaceScientificNotation(model.text)
+
+ ## remove the "invisible()" line.
+ model.text <- gsub("invisible[ ]*\\([ ]*\\)", "", model.text)
+ }
writeLines(model.text, con = con)
}
+
+replaceScientificNotation <- function(text){
+## Change the format of any numbers in "text" that are in S-PLUS
+## scientific notation to WinBUGS scientific notation
+
+ ## First, handle the positive exponents
+ ## Find the first instance
+ ## Note that the number may or may not have a decimal point.
+ sciNoteLoc <- regexpr("[0-9]*\\.{0,1}[0-9]*e\\+0[0-9]{2}", text)
+
+ ## For every instance, replace the number
+ while(sciNoteLoc > -1){
+ sciNoteEnd <- sciNoteLoc + attr(sciNoteLoc, "match.length")-1
+ sciNote <- substring(text, sciNoteLoc, sciNoteEnd)
+ text <- gsub(sciNote, toSingleS4(sciNote), text)
+ sciNoteLoc <- regexpr("[0-9]*\\.{0,1}[0-9]*e\\+0[0-9]{2}", text)
+ }
+
+ ## Then, handle the negative exponents
+ ## Find the first instance
+ sciNoteLoc <- regexpr("[0-9]*\\.{0,1}[0-9]*e\\-0[0-9]{2}", text)
+
+ ## For every instance, replace the number
+ while(sciNoteLoc > -1){
+ sciNoteEnd <- sciNoteLoc + attr(sciNoteLoc, "match.length")-1
+ sciNote <- substring(text, sciNoteLoc, sciNoteEnd)
+ text <- gsub(sciNote, toSingleS4(sciNote), text)
+ sciNoteLoc <- regexpr("[0-9]*\\.{0,1}[0-9]*e\\-0[0-9]{2}", text)
+ }
+
+ text
+}
Modified: trunk/BRugs/R/zzz.R
===================================================================
--- trunk/BRugs/R/zzz.R 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/R/zzz.R 2007-07-25 09:25:49 UTC (rev 31)
@@ -1,3 +1,5 @@
+if (is.R()){
+
".onLoad" <- function(lib, pkg){
## Don't know whether we have to do this before useDynLib()???
#Sys.putenv("LD_ASSUME_KERNEL"="2.4.1")
@@ -6,16 +8,44 @@
## we do have a NAMESPACE now: library.dynam("BRugs", pkg, lib)
len <- nchar(root)
tempDir <- gsub("\\\\", "/", tempdir())
- .C("Initialize", as.character(root), as.character(tempDir),
- as.integer(len), nchar(tempDir), PACKAGE="BRugs")
+ .C("SetRoot", as.character(root), len, PACKAGE="BRugs")
+ .C("SetTempDir", as.character(tempDir), nchar(tempDir), PACKAGE="BRugs")
+ command <- "BugsMappers.SetDest(2)"
+ .C("CmdInterpreter", as.character(command), nchar(command), integer(1), PACKAGE="BRugs")
+ #.C("Initialize", as.character(root), as.character(tempDir),
+ # as.integer(len), nchar(tempDir), PACKAGE="BRugs")
if(is.null(getOption("BRugsVerbose")))
options("BRugsVerbose" = TRUE)
}
".onAttach" <- function(lib, pkg){
- message("Welcome to BRugs running on OpenBUGS version 2.2.0 beta")
+ message("Welcome to BRugs running on OpenBUGS version 3.0.1")
}
".onUnload" <- function(libpath){
library.dynam.unload("BRugs", libpath)
}
+
+} else { # ends if (is.R())
+
+".First.lib" <- function(lib.loc, section)
+{
+ dyn.open(system.file("OpenBUGS", "brugs.dll", package="BRugs"))
+ ## sets path / file variables and initializes subsystems
+ root <- file.path(system.file("OpenBUGS", package="BRugs"))
+ len <- nchar(root)
+ tempDir <- gsub("\\\\", "/", tempdir())
+ .C("SetRoot", as.character(root), len)
+ .C("SetTempDir", as.character(tempDir), nchar(tempDir))
+ command <- "BugsMappers.SetDest(2)"
+ .C("CmdInterpreter", as.character(command), nchar(command), integer(1))
+ if(is.null(getOption("BRugsVerbose")))
+ options("BRugsVerbose" = TRUE)
+ invisible()
+}
+
+.tempDir <- getwd()
+
+tempdir <- function(){ .tempDir }
+
+} # ends else
Modified: trunk/BRugs/configure
===================================================================
--- trunk/BRugs/configure 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/configure 2007-07-25 09:25:49 UTC (rev 31)
@@ -1,2 +1,3 @@
-echo "Package 'BRugs' currently only works under Windows.\nIt is supposed to work under Linux in future releases."
-exit 1
+echo "Package 'BRugs' currently only works under Windows.\nIt is supposed to work under Linux in future releases."
+exit 1
+
Added: trunk/BRugs/inst/README-inst_OpenBUGS
===================================================================
--- trunk/BRugs/inst/README-inst_OpenBUGS (rev 0)
+++ trunk/BRugs/inst/README-inst_OpenBUGS 2007-07-25 09:25:49 UTC (rev 31)
@@ -0,0 +1,11 @@
+Here goes from the current OpenBUGS distribution:
+
+OpenBUGS
+OpenBUGS/brugs.dll
+OpenBUGS/brugs.so
+OpenBUGS/libtaucs.dll
+OpenBUGS/Examples/*.bmp
+OpenBUGS/Examples/*.html
+OpenBUGS/Examples/*.txt
+OpenBUGS/Manuals/*.bmp
+OpenBUGS/Manuals/*.html
Modified: trunk/BRugs/man/BRugs.Rd
===================================================================
--- trunk/BRugs/man/BRugs.Rd 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/man/BRugs.Rd 2007-07-25 09:25:49 UTC (rev 31)
@@ -37,7 +37,7 @@
of any successes or failures.
}
%\references{}
-\seealso{\code{\link{help.WinBUGS}} and the meta function \code{\link{BRugsFit}}}
+\seealso{\code{\link{help.WinBUGS}} (which currently is called from \code{help.BRugs}) and the meta function \code{\link{BRugsFit}}}
\examples{
### Step by step example: ###
library(BRugs) # loading BRugs
@@ -67,7 +67,8 @@
setwd(oldwd)
\dontrun{
# Getting more (online-)help:
-help.BRugs()
+if (is.R())
+ help.BRugs()
}
}
\keyword{interface}
Modified: trunk/BRugs/man/samples.autoC.Rd
===================================================================
--- trunk/BRugs/man/samples.autoC.Rd 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/man/samples.autoC.Rd 2007-07-25 09:25:49 UTC (rev 31)
@@ -14,7 +14,8 @@
\item{thin}{To only use every \code{thin}-th value of the stored sample for statistics.}
\item{plot}{Logical, whether to plot the ACF or only return the values. If \code{TRUE}, values are returned invisibly.}
\item{mfrow, ask, ann}{Graphical parameters, see \code{\link{par}} for details.
- \code{ask} defaults to \code{TRUE} unless it is plotting into an already opened non-interactive device.}
+ \code{ask} defaults to \code{TRUE} unless it is plotting into an already opened non-interactive device.
+ The \code{ann} parameter is not available in S-PLUS, and will be ignored if it is set.}
\item{...}{Further graphical parameters as in \code{\link{par}} may also be passed as arguments
to \code{\link{plotAutoC}}.}
}
Modified: trunk/BRugs/man/samples.bgr.Rd
===================================================================
--- trunk/BRugs/man/samples.bgr.Rd 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/man/samples.bgr.Rd 2007-07-25 09:25:49 UTC (rev 31)
@@ -20,7 +20,8 @@
\item{plot}{Logical, whether to plot the BGR statistics or only return the values.
If \code{TRUE}, values are returned invisibly.}
\item{mfrow, ask, ann}{Graphical parameters, see \code{\link{par}} for details.
- \code{ask} defaults to \code{TRUE} unless it is plotting into an already opened non-interactive device.}
+ \code{ask} defaults to \code{TRUE} unless it is plotting into an already opened non-interactive device.
+ The \code{ann} parameter is not available in S-PLUS, and will be ignored if it is set.}
\item{...}{Further graphical parameters as in \code{\link{par}} may also be passed as arguments
to \code{\link{plotBgr}}.}
}
Modified: trunk/BRugs/man/samples.density.Rd
===================================================================
--- trunk/BRugs/man/samples.density.Rd 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/man/samples.density.Rd 2007-07-25 09:25:49 UTC (rev 31)
@@ -15,7 +15,8 @@
\item{firstChain, lastChain}{Arguments to select a sub group of chains to plot density estimate or histogram for.}
\item{thin}{to only use every \code{thin}-th value of the stored sample for statistics.}
\item{mfrow, ask, ann}{Graphical parameters, see \code{\link{par}} for details.
- \code{ask} defaults to \code{TRUE} unless it is plotting into an already opened non-interactive device.}
+ \code{ask} defaults to \code{TRUE} unless it is plotting into an already opened non-interactive device.
+ The \code{ann} parameter is not available in S-PLUS, and will be ignored if it is set.}
\item{...}{Further graphical parameters as in \code{\link{par}} may also be passed as arguments
to \code{\link{plotDensity}}.}
}
Modified: trunk/BRugs/man/samples.history.Rd
===================================================================
--- trunk/BRugs/man/samples.history.Rd 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/man/samples.history.Rd 2007-07-25 09:25:49 UTC (rev 31)
@@ -16,7 +16,8 @@
\item{plot}{Logical, whether to plot the trace or only return the values.
If \code{TRUE}, values are returned invisibly.}
\item{mfrow, ask, ann}{Graphical parameters, see \code{\link{par}} for details.
- \code{ask} defaults to \code{TRUE} unless it is plotting into an already opened non-interactive device.}
+ \code{ask} defaults to \code{TRUE} unless it is plotting into an already opened non-interactive device.
+ The \code{ann} parameter is not available in S-PLUS, and will be ignored if it is set.}
\item{...}{Further graphical parameters as in \code{\link{par}} may also be passed as arguments
to \code{\link{plotHistory}}.}
}
Modified: trunk/BRugs/tests/BRugs.Rout.save
===================================================================
--- trunk/BRugs/tests/BRugs.Rout.save 2007-06-13 00:59:08 UTC (rev 30)
+++ trunk/BRugs/tests/BRugs.Rout.save 2007-07-25 09:25:49 UTC (rev 31)
@@ -1,6 +1,7 @@
-R : Copyright 2005, The R Foundation for Statistical Computing
-Version 2.1.0 Patched (2005-05-11), ISBN 3-900051-07-0
+R version 2.5.1 (2007-06-27)
+Copyright (C) 2007 The R Foundation for Statistical Computing
+ISBN 3-900051-07-0
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
@@ -11,144 +12,146 @@
'citation()' on how to cite R or R packages in publications.
Type 'demo()' for some demos, 'help()' for on-line help, or
-'help.start()' for a HTML browser interface to help.
+'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
> library(BRugs)
-Welcome to BRugs running on OpenBUGS version 2.2.0 beta
+Loading required package: coda
+Loading required package: lattice
+Welcome to BRugs running on OpenBUGS version 3.0.1
>
> BRugsFit(data = "ratsdata.txt", inits = "ratsinits.txt",
+ para = c("alpha", "beta"), modelFile = "ratsmodel.txt",
+ numChains = 1,
+ working.directory = system.file("OpenBUGS", "Examples",
+ package = "BRugs"))
-model is syntactically correct
-data loaded
-model compiled
+model is syntactically correct
+data loaded
+model compiled
[1] "ratsinits.txt"
-Initializing chain 1: model is initialized
-1000 updates took 0 s
-deviance set
-monitor set for variable 'alpha'
-monitor set for variable 'beta'
-1000 updates took 0 s
+Initializing chain 1: model is initialized
+1000 updates took 0 s
+deviance set
+monitor set for variable 'alpha'
+monitor set for variable 'beta'
+1000 updates took 0 s
$Stats
mean sd MC_error val2.5pc median val97.5pc start sample
-alpha[1] 239.800 2.4710 0.081260 234.500 239.800 244.300 1001 1000
-alpha[2] 247.900 2.6820 0.065740 242.300 248.000 253.300 1001 1000
-alpha[3] 252.400 2.8660 0.083620 246.800 252.600 257.900 1001 1000
-alpha[4] 232.700 2.7010 0.074410 227.000 232.800 238.100 1001 1000
-alpha[5] 231.600 2.7430 0.090660 226.200 231.600 236.800 1001 1000
-alpha[6] 249.600 2.6090 0.074790 244.400 249.700 254.600 1001 1000
-alpha[7] 228.800 2.5900 0.086230 224.100 228.600 234.000 1001 1000
-alpha[8] 248.400 2.6310 0.079340 243.000 248.500 253.300 1001 1000
-alpha[9] 283.100 2.7810 0.093740 277.700 283.200 288.400 1001 1000
-alpha[10] 219.200 2.6770 0.072100 214.000 219.200 224.500 1001 1000
-alpha[11] 258.200 2.7820 0.082720 252.900 258.300 263.400 1001 1000
-alpha[12] 228.100 2.5830 0.089030 222.900 228.100 233.100 1001 1000
-alpha[13] 242.300 2.6500 0.081100 237.100 242.300 247.500 1001 1000
-alpha[14] 268.200 2.7510 0.082220 262.800 268.200 273.500 1001 1000
-alpha[15] 242.800 2.6530 0.093230 237.800 242.800 247.900 1001 1000
-alpha[16] 245.300 2.7780 0.080010 239.800 245.400 250.800 1001 1000
-alpha[17] 232.000 2.6820 0.067020 226.800 232.000 237.300 1001 1000
-alpha[18] 240.300 2.7140 0.105800 234.900 240.400 245.600 1001 1000
-alpha[19] 253.700 2.7090 0.073890 248.200 253.600 258.700 1001 1000
-alpha[20] 241.700 2.6860 0.097940 236.600 241.700 246.900 1001 1000
-alpha[21] 248.500 2.7710 0.081320 243.100 248.500 253.900 1001 1000
-alpha[22] 225.300 2.6960 0.087560 220.200 225.300 230.800 1001 1000
-alpha[23] 228.600 2.5970 0.087210 223.400 228.600 233.800 1001 1000
-alpha[24] 245.200 2.7210 0.089540 239.600 245.200 250.600 1001 1000
-alpha[25] 234.500 2.7300 0.073650 229.100 234.500 239.900 1001 1000
-alpha[26] 254.000 2.6520 0.087640 249.000 254.100 259.200 1001 1000
-alpha[27] 254.400 2.7170 0.080260 249.200 254.400 259.600 1001 1000
-alpha[28] 243.000 2.6980 0.065220 237.700 243.100 248.200 1001 1000
-alpha[29] 217.800 2.7660 0.094850 212.200 217.800 223.000 1001 1000
-alpha[30] 241.300 2.7330 0.080940 236.000 241.300 246.500 1001 1000
-beta[1] 6.074 0.2424 0.009256 5.616 6.073 6.565 1001 1000
-beta[2] 7.042 0.2472 0.008130 6.571 7.038 7.530 1001 1000
-beta[3] 6.482 0.2505 0.007121 6.007 6.480 6.969 1001 1000
-beta[4] 5.348 0.2429 0.009942 4.874 5.345 5.812 1001 1000
-beta[5] 6.589 0.2475 0.009652 6.116 6.574 7.089 1001 1000
-beta[6] 6.174 0.2372 0.007914 5.698 6.176 6.635 1001 1000
-beta[7] 5.982 0.2511 0.009924 5.512 5.977 6.482 1001 1000
-beta[8] 6.407 0.2379 0.006988 5.959 6.406 6.871 1001 1000
-beta[9] 7.066 0.2543 0.007695 6.567 7.073 7.590 1001 1000
-beta[10] 5.846 0.2474 0.006672 5.366 5.847 6.328 1001 1000
-beta[11] 6.802 0.2418 0.007856 6.308 6.806 7.274 1001 1000
-beta[12] 6.129 0.2398 0.009423 5.669 6.123 6.623 1001 1000
-beta[13] 6.159 0.2400 0.008713 5.709 6.162 6.650 1001 1000
-beta[14] 6.696 0.2393 0.007849 6.217 6.696 7.158 1001 1000
-beta[15] 5.429 0.2562 0.009106 4.919 5.444 5.896 1001 1000
-beta[16] 5.916 0.2353 0.007259 5.448 5.915 6.382 1001 1000
-beta[17] 6.280 0.2475 0.007826 5.764 6.266 6.765 1001 1000
-beta[18] 5.849 0.2437 0.007895 5.379 5.854 6.331 1001 1000
-beta[19] 6.413 0.2448 0.008416 5.954 6.400 6.903 1001 1000
-beta[20] 6.062 0.2366 0.008115 5.626 6.053 6.538 1001 1000
-beta[21] 6.406 0.2419 0.006763 5.923 6.405 6.875 1001 1000
-beta[22] 5.868 0.2450 0.006494 5.404 5.877 6.346 1001 1000
-beta[23] 5.748 0.2438 0.008933 5.258 5.749 6.224 1001 1000
-beta[24] 5.911 0.2402 0.006082 5.426 5.914 6.381 1001 1000
-beta[25] 6.904 0.2489 0.007867 6.416 6.904 7.410 1001 1000
-beta[26] 6.543 0.2413 0.008710 6.082 6.545 7.011 1001 1000
-beta[27] 5.903 0.2480 0.008511 5.452 5.899 6.409 1001 1000
-beta[28] 5.840 0.2470 0.007768 5.358 5.847 6.341 1001 1000
-beta[29] 5.674 0.2452 0.007864 5.202 5.673 6.173 1001 1000
-beta[30] 6.121 0.2308 0.006812 5.668 6.127 6.582 1001 1000
+alpha[1] 239.900 2.7070 0.076220 234.400 239.900 245.000 1001 1000
+alpha[2] 247.700 2.6960 0.089790 242.200 247.800 253.000 1001 1000
+alpha[3] 252.600 2.6770 0.081210 247.200 252.700 257.800 1001 1000
+alpha[4] 232.600 2.6430 0.089860 227.700 232.700 238.100 1001 1000
+alpha[5] 231.600 2.6680 0.081590 226.500 231.600 236.700 1001 1000
+alpha[6] 249.700 2.7320 0.084880 244.600 249.600 255.300 1001 1000
+alpha[7] 228.700 2.7620 0.099880 223.200 228.700 234.200 1001 1000
+alpha[8] 248.400 2.7140 0.080630 243.300 248.400 254.000 1001 1000
+alpha[9] 283.400 2.7480 0.061700 277.700 283.400 288.800 1001 1000
+alpha[10] 219.400 2.6790 0.074340 214.100 219.200 225.000 1001 1000
+alpha[11] 258.200 2.7220 0.094600 253.100 258.100 264.100 1001 1000
+alpha[12] 228.100 2.7470 0.092450 222.800 228.100 233.200 1001 1000
+alpha[13] 242.600 2.4970 0.069930 237.700 242.500 247.400 1001 1000
+alpha[14] 268.200 2.6500 0.076140 263.000 268.200 273.400 1001 1000
+alpha[15] 242.700 2.6800 0.074650 237.500 242.800 248.200 1001 1000
+alpha[16] 245.400 2.7440 0.090230 239.800 245.400 250.900 1001 1000
+alpha[17] 232.100 2.6820 0.076820 226.900 232.100 237.700 1001 1000
+alpha[18] 240.600 2.5760 0.083010 235.600 240.600 245.700 1001 1000
+alpha[19] 253.800 2.6350 0.084970 248.700 253.900 258.900 1001 1000
+alpha[20] 241.600 2.7230 0.073110 236.500 241.500 247.100 1001 1000
+alpha[21] 248.700 2.5980 0.085770 243.500 248.800 253.700 1001 1000
+alpha[22] 225.200 2.7820 0.077450 219.800 225.200 230.500 1001 1000
+alpha[23] 228.300 2.7290 0.069540 222.300 228.400 233.400 1001 1000
+alpha[24] 245.000 2.7410 0.071480 239.700 245.100 250.400 1001 1000
+alpha[25] 234.500 2.6630 0.092080 229.000 234.500 239.500 1001 1000
+alpha[26] 254.000 2.6180 0.089310 249.000 254.000 259.200 1001 1000
+alpha[27] 254.300 2.7780 0.102600 248.900 254.500 259.900 1001 1000
+alpha[28] 242.900 2.6100 0.078810 237.900 242.900 247.900 1001 1000
+alpha[29] 217.800 2.5840 0.084150 212.600 217.800 222.900 1001 1000
+alpha[30] 241.500 2.6040 0.085820 236.500 241.600 246.800 1001 1000
+beta[1] 6.068 0.2464 0.008693 5.584 6.064 6.544 1001 1000
+beta[2] 7.054 0.2581 0.009510 6.529 7.063 7.565 1001 1000
+beta[3] 6.473 0.2417 0.008479 5.994 6.475 6.947 1001 1000
+beta[4] 5.327 0.2531 0.010990 4.835 5.328 5.820 1001 1000
+beta[5] 6.564 0.2498 0.007435 6.084 6.563 7.088 1001 1000
+beta[6] 6.179 0.2462 0.009767 5.682 6.182 6.663 1001 1000
+beta[7] 5.976 0.2508 0.005942 5.491 5.979 6.477 1001 1000
+beta[8] 6.406 0.2414 0.007365 5.928 6.408 6.892 1001 1000
+beta[9] 7.073 0.2465 0.008848 6.604 7.073 7.539 1001 1000
+beta[10] 5.830 0.2545 0.007829 5.324 5.828 6.321 1001 1000
+beta[11] 6.790 0.2445 0.008118 6.304 6.787 7.259 1001 1000
+beta[12] 6.115 0.2383 0.007260 5.643 6.118 6.558 1001 1000
+beta[13] 6.143 0.2388 0.006842 5.698 6.134 6.607 1001 1000
+beta[14] 6.684 0.2476 0.007014 6.229 6.689 7.169 1001 1000
+beta[15] 5.420 0.2668 0.011640 4.867 5.421 5.941 1001 1000
+beta[16] 5.926 0.2417 0.006787 5.453 5.932 6.407 1001 1000
+beta[17] 6.257 0.2359 0.006193 5.776 6.263 6.725 1001 1000
+beta[18] 5.833 0.2397 0.007924 5.375 5.838 6.304 1001 1000
+beta[19] 6.401 0.2556 0.008447 5.916 6.386 6.898 1001 1000
+beta[20] 6.066 0.2341 0.006553 5.589 6.061 6.530 1001 1000
+beta[21] 6.394 0.2447 0.007466 5.871 6.400 6.889 1001 1000
+beta[22] 5.865 0.2453 0.006486 5.395 5.865 6.352 1001 1000
+beta[23] 5.739 0.2450 0.008503 5.262 5.733 6.217 1001 1000
+beta[24] 5.883 0.2491 0.006714 5.400 5.875 6.395 1001 1000
+beta[25] 6.903 0.2516 0.006540 6.407 6.894 7.403 1001 1000
+beta[26] 6.553 0.2360 0.006531 6.096 6.548 7.030 1001 1000
+beta[27] 5.898 0.2525 0.008045 5.420 5.896 6.399 1001 1000
+beta[28] 5.850 0.2506 0.008446 5.363 5.855 6.343 1001 1000
+beta[29] 5.666 0.2380 0.007562 5.189 5.679 6.139 1001 1000
+beta[30] 6.125 0.2443 0.007231 5.661 6.129 6.613 1001 1000
$DIC
- Dbar Dhat DIC pD
-Y 967 913 1021 54
-total 967 913 1021 54
+ Dbar Dhat DIC pD
+Y 966.7 912.5 1021 54.27
+total 966.7 912.5 1021 54.27
>
> setwd(system.file("OpenBUGS", "Examples", package="BRugs"))
> modelCheck("ratsmodel.txt")
-model is syntactically correct
+model is syntactically correct
> modelData("ratsdata.txt")
-data loaded
+data loaded
> modelCompile(numChains=2)
-model compiled
+model compiled
> modelInits(rep("ratsinits.txt", 2))
-Initializing chain 1: initial values loaded but this or another chain contain uninitialized variables
-Initializing chain 2: model is initialized
+Initializing chain 1: initial values loaded but this or another chain contain uninitialized variables
+Initializing chain 2: model is initialized
> modelUpdate(1000)
-1000 updates took 0 s
+1000 updates took 0 s
> samplesSet(c("alpha0", "alpha"))
-monitor set for variable 'alpha0'
-monitor set for variable 'alpha'
+monitor set for variable 'alpha0'
+monitor set for variable 'alpha'
> modelUpdate(1000)
-1000 updates took 0 s
+1000 updates took 0 s
> samplesStats("*")
mean sd MC_error val2.5pc median val97.5pc start sample
-alpha[1] 239.9 2.684 0.06498 234.80 240.0 245.1 1001 2000
-alpha[2] 247.8 2.733 0.05468 242.50 247.9 253.1 1001 2000
-alpha[3] 252.4 2.653 0.05837 247.10 252.4 257.4 1001 2000
-alpha[4] 232.6 2.641 0.06602 227.40 232.6 237.7 1001 2000
-alpha[5] 231.5 2.696 0.05603 226.30 231.5 236.9 1001 2000
-alpha[6] 249.7 2.689 0.05530 244.40 249.7 254.8 1001 2000
-alpha[7] 228.6 2.703 0.05136 223.50 228.6 234.0 1001 2000
-alpha[8] 248.4 2.653 0.06213 243.20 248.4 253.6 1001 2000
-alpha[9] 283.3 2.740 0.05856 278.10 283.3 288.7 1...
[truncated message content] |
|
From: <li...@us...> - 2007-08-08 11:31:44
|
Revision: 36
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=36&view=rev
Author: ligges
Date: 2007-08-08 04:31:43 -0700 (Wed, 08 Aug 2007)
Log Message:
-----------
minor tweaks: ignoree the ReadMe when building, comment that we might need to ship sources (GPL!), documentiung that bugsData might drop significant digits for integers
Modified Paths:
--------------
trunk/BRugs/inst/README-inst_OpenBUGS
trunk/BRugs/man/bugs.data.Rd
Added Paths:
-----------
trunk/BRugs/.Rbuildignore
Added: trunk/BRugs/.Rbuildignore
===================================================================
--- trunk/BRugs/.Rbuildignore (rev 0)
+++ trunk/BRugs/.Rbuildignore 2007-08-08 11:31:43 UTC (rev 36)
@@ -0,0 +1 @@
+inst/README-inst_OpenBUGS
Modified: trunk/BRugs/inst/README-inst_OpenBUGS
===================================================================
--- trunk/BRugs/inst/README-inst_OpenBUGS 2007-08-08 09:48:36 UTC (rev 35)
+++ trunk/BRugs/inst/README-inst_OpenBUGS 2007-08-08 11:31:43 UTC (rev 36)
@@ -9,3 +9,7 @@
OpenBUGS/Examples/*.txt
OpenBUGS/Manuals/*.bmp
OpenBUGS/Manuals/*.html
+
+
+Hmmm, but we maybe should ship all OpenBUGS,
+because we may need to ship sources according to GPL.
Modified: trunk/BRugs/man/bugs.data.Rd
===================================================================
--- trunk/BRugs/man/bugs.data.Rd 2007-08-08 09:48:36 UTC (rev 35)
+++ trunk/BRugs/man/bugs.data.Rd 2007-08-08 11:31:43 UTC (rev 36)
@@ -15,6 +15,8 @@
\value{
Invisibly returns the \code{fileName}.
}
+\note{\code{bugsData} uses \code{format="E"} internally, i.e. you need to
+ pay attention when writing integers containg many significant digits to the data file.}
\seealso{\code{\link{BRugs}}}
\keyword{file}
\concept{data}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: Ben B. <bo...@zo...> - 2007-08-08 13:58:50
|
I have taken a *fairly* recent svn copy of R2WinBUGS (missed the
last couple of updates reported this morning, but I hope you can
still use the patch) and made the changes required for me to
run the example in ?bugs out of the box, without specifying
a different command line than I would under Windows.
Specifically, the changes are:
bugs.R: change WINEPATH=NULL to WINEPATH=Sys.getenv("WINEPATH")
bugs.run.R: take out a newWINE flag and pass WINEPATH through in
call to win2native()
wineutils.R: update win2native()
These changes will require at least one tweak to the .Rd files, which I'm
happy to make, but I'd like some other Linux users to check these mods
out and make sure they don't break anything ...
These changes have slipped through the cracks a couple of times, I'd
love it they could get in this time so I can get up to date with
R2WinBUGS --
for what it's worth, I can't run R CMD check on R2WinBUGS on my system
because BRugs is now a required dependency, and it won't install under
Linux ...
cheers
Ben Bolker
diff -c -r R2WinBUGS.new/R/bugs.R bugs-r/trunk/R2WinBUGS/R/bugs.R
*** R2WinBUGS.new/R/bugs.R 2007-08-07 16:53:47.000000000 -0400
--- bugs-r/trunk/R2WinBUGS/R/bugs.R 2007-06-14 09:37:13.000000000 -0400
***************
*** 8,14 ****
program=c("WinBUGS", "OpenBUGS", "winbugs", "openbugs"),
working.directory=NULL,
clearWD=FALSE, useWINE=.Platform$OS.type != "windows",
WINE=Sys.getenv("WINE"),
! newWINE=FALSE, WINEPATH=Sys.getenv("WINEPATH"))
{
program <- match.arg(program)
if(program %in% c("openbugs", "OpenBUGS", "OpenBugs")) {
--- 8,14 ----
program=c("WinBUGS", "OpenBUGS", "winbugs", "openbugs"),
working.directory=NULL,
clearWD=FALSE, useWINE=.Platform$OS.type != "windows",
WINE=Sys.getenv("WINE"),
! newWINE=FALSE, WINEPATH=NULL)
{
program <- match.arg(program)
if(program %in% c("openbugs", "OpenBUGS", "OpenBugs")) {
diff -c -r R2WinBUGS.new/R/bugs.run.R bugs-r/trunk/R2WinBUGS/R/bugs.run.R
*** R2WinBUGS.new/R/bugs.run.R 2007-08-07 17:17:41.000000000 -0400
--- bugs-r/trunk/R2WinBUGS/R/bugs.run.R 2007-06-14 09:37:13.000000000 -0400
***************
*** 4,13 ****
newWINE = TRUE, WINEPATH = NULL){
if(useWINE && !is.R())
! stop ("Non-Windows platforms not yet supported in R2WinBUGS for
S-PLUS")
!
! ## BB: took out !newWINE (?), added WINEPATH
! if(useWINE) bugs.directory <- win2native(bugs.directory,WINEPATH=WINEPATH)
## Update the lengths of the adaptive phases in the Bugs updaters
try(bugs.update.settings(n.burnin, bugs.directory))
--- 4,11 ----
newWINE = TRUE, WINEPATH = NULL){
if(useWINE && !is.R())
! stop ("Non-Windows platforms not yet supported in R2WinBUGS for
S-PLUS")
! if(useWINE && !newWINE) bugs.directory <- win2native(bugs.directory)
## Update the lengths of the adaptive phases in the Bugs updaters
try(bugs.update.settings(n.burnin, bugs.directory))
diff -c -r R2WinBUGS.new/R/wineutils.R bugs-r/trunk/R2WinBUGS/R/wineutils.R
*** R2WinBUGS.new/R/wineutils.R 2007-08-08 09:34:32.000000000 -0400
--- bugs-r/trunk/R2WinBUGS/R/wineutils.R 2007-06-14
09:37:13.000000000 -0400
***************
*** 45,61 ****
}
! win2native <- function(x, useWINE=.Platform$OS.type != "windows",
! newWINE=TRUE,
! WINEPATH=Sys.getenv("WINEPATH")) {
! ## win -> native
! if (useWINE) {
! if (!newWINE) {
! winedriveTr(x)
! } else {
! system(paste(WINEPATH, " \"", x, "\"", sep = ""), intern = TRUE)
! }
! }
else x
}
--- 45,52 ----
}
! win2native <- function(x, useWINE=.Platform$OS.type != "windows") { #
win -> native
! if (useWINE) winedriveTr(x)
else x
}
|
|
From: Gregor G. <gre...@bf...> - 2007-08-09 05:33:29
|
Thanks Ben! I will look at this in the evening (CET).
Ben Bolker wrote:
> I have taken a *fairly* recent svn copy of R2WinBUGS (missed the
> last couple of updates reported this morning, but I hope you can
> still use the patch) and made the changes required for me to
> run the example in ?bugs out of the box, without specifying
> a different command line than I would under Windows.
>
> Specifically, the changes are:
>
> bugs.R: change WINEPATH=NULL to WINEPATH=Sys.getenv("WINEPATH")
> bugs.run.R: take out a newWINE flag and pass WINEPATH through in
> call to win2native()
> wineutils.R: update win2native()
>
> These changes will require at least one tweak to the .Rd files, which I'm
> happy to make, but I'd like some other Linux users to check these mods
> out and make sure they don't break anything ...
>
> These changes have slipped through the cracks a couple of times, I'd
> love it they could get in this time so I can get up to date with
> R2WinBUGS --
>
> for what it's worth, I can't run R CMD check on R2WinBUGS on my system
> because BRugs is now a required dependency, and it won't install under
> Linux ...
>
> cheers
> Ben Bolker
>
>
> diff -c -r R2WinBUGS.new/R/bugs.R bugs-r/trunk/R2WinBUGS/R/bugs.R
> *** R2WinBUGS.new/R/bugs.R 2007-08-07 16:53:47.000000000 -0400
> --- bugs-r/trunk/R2WinBUGS/R/bugs.R 2007-06-14 09:37:13.000000000 -0400
> ***************
> *** 8,14 ****
> program=c("WinBUGS", "OpenBUGS", "winbugs", "openbugs"),
> working.directory=NULL,
> clearWD=FALSE, useWINE=.Platform$OS.type != "windows",
> WINE=Sys.getenv("WINE"),
> ! newWINE=FALSE, WINEPATH=Sys.getenv("WINEPATH"))
> {
> program <- match.arg(program)
> if(program %in% c("openbugs", "OpenBUGS", "OpenBugs")) {
> --- 8,14 ----
> program=c("WinBUGS", "OpenBUGS", "winbugs", "openbugs"),
> working.directory=NULL,
> clearWD=FALSE, useWINE=.Platform$OS.type != "windows",
> WINE=Sys.getenv("WINE"),
> ! newWINE=FALSE, WINEPATH=NULL)
> {
> program <- match.arg(program)
> if(program %in% c("openbugs", "OpenBUGS", "OpenBugs")) {
> diff -c -r R2WinBUGS.new/R/bugs.run.R bugs-r/trunk/R2WinBUGS/R/bugs.run.R
> *** R2WinBUGS.new/R/bugs.run.R 2007-08-07 17:17:41.000000000 -0400
> --- bugs-r/trunk/R2WinBUGS/R/bugs.run.R 2007-06-14 09:37:13.000000000 -0400
> ***************
> *** 4,13 ****
> newWINE = TRUE, WINEPATH = NULL){
>
> if(useWINE && !is.R())
> ! stop ("Non-Windows platforms not yet supported in R2WinBUGS for
> S-PLUS")
> !
> ! ## BB: took out !newWINE (?), added WINEPATH
> ! if(useWINE) bugs.directory <- win2native(bugs.directory,WINEPATH=WINEPATH)
>
> ## Update the lengths of the adaptive phases in the Bugs updaters
> try(bugs.update.settings(n.burnin, bugs.directory))
> --- 4,11 ----
> newWINE = TRUE, WINEPATH = NULL){
>
> if(useWINE && !is.R())
> ! stop ("Non-Windows platforms not yet supported in R2WinBUGS for
> S-PLUS")
> ! if(useWINE && !newWINE) bugs.directory <- win2native(bugs.directory)
>
> ## Update the lengths of the adaptive phases in the Bugs updaters
> try(bugs.update.settings(n.burnin, bugs.directory))
> diff -c -r R2WinBUGS.new/R/wineutils.R bugs-r/trunk/R2WinBUGS/R/wineutils.R
> *** R2WinBUGS.new/R/wineutils.R 2007-08-08 09:34:32.000000000 -0400
> --- bugs-r/trunk/R2WinBUGS/R/wineutils.R 2007-06-14
> 09:37:13.000000000 -0400
> ***************
> *** 45,61 ****
> }
>
>
> ! win2native <- function(x, useWINE=.Platform$OS.type != "windows",
> ! newWINE=TRUE,
> ! WINEPATH=Sys.getenv("WINEPATH")) {
> ! ## win -> native
> ! if (useWINE) {
> ! if (!newWINE) {
> ! winedriveTr(x)
> ! } else {
> ! system(paste(WINEPATH, " \"", x, "\"", sep = ""), intern = TRUE)
> ! }
> ! }
> else x
> }
>
> --- 45,52 ----
> }
>
>
> ! win2native <- function(x, useWINE=.Platform$OS.type != "windows") { #
> win -> native
> ! if (useWINE) winedriveTr(x)
> else x
> }
>
>
>
--
Lep pozdrav / With regards,
Gregor Gorjanc
----------------------------------------------------------------------
University of Ljubljana PhD student
Biotechnical Faculty www: http://www.bfro.uni-lj.si/MR/ggorjan
Zootechnical Department blog: http://ggorjan.blogspot.com
Groblje 3 mail: gregor.gorjanc <at> bfro.uni-lj.si
SI-1230 Domzale fax: +386 (0)1 72 17 888
Slovenia, Europe tel: +386 (0)1 72 17 861
----------------------------------------------------------------------
|
|
From: <li...@us...> - 2007-09-14 08:07:05
|
Revision: 49
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=49&view=rev
Author: ligges
Date: 2007-09-14 01:07:09 -0700 (Fri, 14 Sep 2007)
Log Message:
-----------
switching to OpenBUGS 3.0.2
Modified Paths:
--------------
trunk/BRugs/DESCRIPTION
trunk/BRugs/R/zzz.R
Modified: trunk/BRugs/DESCRIPTION
===================================================================
--- trunk/BRugs/DESCRIPTION 2007-09-13 16:53:03 UTC (rev 48)
+++ trunk/BRugs/DESCRIPTION 2007-09-14 08:07:09 UTC (rev 49)
@@ -1,7 +1,7 @@
Package: BRugs
Title: OpenBUGS and its R / S-PLUS interface BRugs
-Version: 0.4-0
-Date: 2007-07-24
+Version: 0.4-1
+Date: 2007-09-14
Author: The Chief Software Bug is Andrew Thomas, with web assistance from Real Bug Bob O'Hara. Other members of the BUGS team are statisticians David Spiegelhalter, Nicky Best, Dave Lunn and Ken Rice. Dave Lunn has also made major contributions to the software development. R Code modified, extended and packaged for R by Uwe Ligges and Sibylle Sturtz. Some ideas taken from the R2WinBUGS package based on code by Andrew Gelman.
Description: An R / S-PLUS package containing OpenBUGS and its R / S-PLUS interface BRugs.
Maintainer: Uwe Ligges <li...@st...>
Modified: trunk/BRugs/R/zzz.R
===================================================================
--- trunk/BRugs/R/zzz.R 2007-09-13 16:53:03 UTC (rev 48)
+++ trunk/BRugs/R/zzz.R 2007-09-14 08:07:09 UTC (rev 49)
@@ -19,7 +19,7 @@
}
".onAttach" <- function(lib, pkg){
- message("Welcome to BRugs running on OpenBUGS version 3.0.1")
+ message("Welcome to BRugs running on OpenBUGS version 3.0.2")
}
".onUnload" <- function(libpath){
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <li...@us...> - 2007-09-14 10:13:33
|
Revision: 54
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=54&view=rev
Author: ligges
Date: 2007-09-14 03:13:36 -0700 (Fri, 14 Sep 2007)
Log Message:
-----------
load module no longer in OpenBUGS API...
Removed Paths:
-------------
trunk/BRugs/R/loadModule.R
trunk/BRugs/man/loadModule.Rd
Deleted: trunk/BRugs/R/loadModule.R
===================================================================
--- trunk/BRugs/R/loadModule.R 2007-09-14 10:12:29 UTC (rev 53)
+++ trunk/BRugs/R/loadModule.R 2007-09-14 10:13:36 UTC (rev 54)
@@ -1,9 +0,0 @@
-"loadModule" <-
-function(module)
-# Load module
-{
- command <- as.character(module)
- .C("Load", command, nchar(command), integer(1), PACKAGE="BRugs")
- if(getOption("BRugsVerbose"))
- buffer()
-}
Deleted: trunk/BRugs/man/loadModule.Rd
===================================================================
--- trunk/BRugs/man/loadModule.Rd 2007-09-14 10:12:29 UTC (rev 53)
+++ trunk/BRugs/man/loadModule.Rd 2007-09-14 10:13:36 UTC (rev 54)
@@ -1,12 +0,0 @@
-\name{loadModule}
-\alias{loadModule}
-\title{Load a module}
-\description{This function loads a module.}
-\usage{
-loadModule(module)
-}
-\arguments{
- \item{module}{character, name of the module.}
-}
-\seealso{See \code{\link{modelModules}} for currently loaded modules. \code{\link{BRugs}}, \code{\link{help.WinBUGS}}}
-\keyword{interface}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <li...@us...> - 2007-09-17 08:57:57
|
Revision: 63
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=63&view=rev
Author: ligges
Date: 2007-09-17 01:57:59 -0700 (Mon, 17 Sep 2007)
Log Message:
-----------
allow argument modelFile to be a function that contains a BUGS model
Modified Paths:
--------------
trunk/BRugs/R/BRugsFit.R
trunk/BRugs/man/BRugsFit.Rd
Modified: trunk/BRugs/R/BRugsFit.R
===================================================================
--- trunk/BRugs/R/BRugsFit.R 2007-09-16 17:33:18 UTC (rev 62)
+++ trunk/BRugs/R/BRugsFit.R 2007-09-17 08:57:59 UTC (rev 63)
@@ -13,6 +13,8 @@
setwd(working.directory)
on.exit(setwd(savedWD), add = TRUE)
}
+ if(is.function(modelFile))
+ writeModel(modelFile, con = (modelFile <- tempfile("model")))
if(!file.exists(modelFile)) stop(modelFile, " does not exist")
if(file.info(modelFile)$isdir) stop(modelFile, " is a directory, but a file is required")
modelCheck(modelFile)
Modified: trunk/BRugs/man/BRugsFit.Rd
===================================================================
--- trunk/BRugs/man/BRugsFit.Rd 2007-09-16 17:33:18 UTC (rev 62)
+++ trunk/BRugs/man/BRugsFit.Rd 2007-09-17 08:57:59 UTC (rev 63)
@@ -9,7 +9,8 @@
BRugsVerbose = getOption("BRugsVerbose"))
}
\arguments{
-\item{modelFile}{File containing the model written in OpenBUGS code.}
+\item{modelFile}{File containing the model written in OpenBUGS code,
+ an R function that contains a BUGS model that is written to a temporary model file (see \code{\link{tempfile}}) using \code{\link{writeModel}}.}
\item{data}{Either a named list (names corresponding to variable names in the \code{modelFile})
of the data for the OpenBUGS model, \emph{or}
a vector or list of the names of the data objects used by the model.
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <li...@us...> - 2007-09-20 14:42:34
|
Revision: 71
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=71&view=rev
Author: ligges
Date: 2007-09-20 07:41:52 -0700 (Thu, 20 Sep 2007)
Log Message:
-----------
increase version number for next release cycle
add manuals in PDF format
Modified Paths:
--------------
trunk/BRugs/DESCRIPTION
Added Paths:
-----------
trunk/BRugs/inst/docs/
trunk/BRugs/inst/docs/DevMan.pdf
trunk/BRugs/inst/docs/UserMan.pdf
Modified: trunk/BRugs/DESCRIPTION
===================================================================
--- trunk/BRugs/DESCRIPTION 2007-09-18 14:18:45 UTC (rev 70)
+++ trunk/BRugs/DESCRIPTION 2007-09-20 14:41:52 UTC (rev 71)
@@ -1,7 +1,7 @@
Package: BRugs
Title: OpenBUGS and its R / S-PLUS interface BRugs
-Version: 0.4-1
-Date: 2007-09-18
+Version: 0.4-2
+Date: 2007-09-20
Author: The Chief Software Bug is Andrew Thomas, with web assistance from Real Bug Bob O'Hara. Other members of the BUGS team are statisticians David Spiegelhalter, Nicky Best, Dave Lunn and Ken Rice. Dave Lunn has also made major contributions to the software development. R Code modified, extended and packaged for R by Uwe Ligges and Sibylle Sturtz. Some ideas taken from the R2WinBUGS package based on code by Andrew Gelman.
Description: An R / S-PLUS package containing OpenBUGS and its R / S-PLUS interface BRugs.
Maintainer: Uwe Ligges <li...@st...>
Added: trunk/BRugs/inst/docs/DevMan.pdf
===================================================================
(Binary files differ)
Property changes on: trunk/BRugs/inst/docs/DevMan.pdf
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
Added: trunk/BRugs/inst/docs/UserMan.pdf
===================================================================
(Binary files differ)
Property changes on: trunk/BRugs/inst/docs/UserMan.pdf
___________________________________________________________________
Name: svn:mime-type
+ application/octet-stream
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
×
Want the latest updates on software, tech news, and AI?
Get latest updates about software, tech news, and AI from SourceForge directly in your inbox once a month.
Thanks for helping keep SourceForge clean.
X