Menu
▾
▴
bugs-r-devel
|
From: <li...@us...> - 2009-01-20 17:15:45
|
Revision: 97
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=97&view=rev
Author: ligges
Date: 2009-01-20 17:15:40 +0000 (Tue, 20 Jan 2009)
Log Message:
-----------
bugfix release:
- a device has been opened even if plot=FALSE in samples*()
- tests incorrect (OpenBUGS version)
Modified Paths:
--------------
trunk/BRugs/DESCRIPTION
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/tests/BRugs.Rout.save
Modified: trunk/BRugs/DESCRIPTION
===================================================================
--- trunk/BRugs/DESCRIPTION 2009-01-20 15:28:01 UTC (rev 96)
+++ trunk/BRugs/DESCRIPTION 2009-01-20 17:15:40 UTC (rev 97)
@@ -1,7 +1,7 @@
Package: BRugs
Title: OpenBUGS and its R / S-PLUS interface BRugs
-Version: 0.4-2
-Date: 2007-09-20
+Version: 0.4-3
+Date: 2009-01-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...>
Modified: trunk/BRugs/R/samples.autoC.R
===================================================================
--- trunk/BRugs/R/samples.autoC.R 2009-01-20 15:28:01 UTC (rev 96)
+++ trunk/BRugs/R/samples.autoC.R 2009-01-20 17:15:40 UTC (rev 97)
@@ -3,7 +3,7 @@
thin = samplesGetThin(), plot = TRUE, mfrow = c(3, 2), ask = NULL, ann = TRUE, ...)
# Plot auto correlation function
{
- if(is.null(ask)) {
+ if(plot && is.null(ask)) {
if (is.R())
ask <- !((dev.cur() > 1) && !dev.interactive())
else
@@ -31,10 +31,12 @@
thin <- max(c(thin, 1))
samplesSetThin(thin)
mons <- samplesMonitors(node)
- if (is.R())
- par(mfrow = mfrow, ask = ask, ann = ann)
- else
- par(mfrow = mfrow, ask = ask)
+ if(plot){
+ 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 2009-01-20 15:28:01 UTC (rev 96)
+++ trunk/BRugs/R/samples.bgr.R 2009-01-20 17:15:40 UTC (rev 97)
@@ -5,7 +5,7 @@
ask = NULL, ann = TRUE, ...)
# Plot bgr statistic
{
- if(is.null(ask)) {
+ if(plot && is.null(ask)) {
if (is.R())
ask <- !((dev.cur() > 1) && !dev.interactive())
else
@@ -31,10 +31,12 @@
thin <- max(c(thin, 1))
samplesSetThin(thin)
mons <- samplesMonitors(node)
- if (is.R())
- par(mfrow = mfrow, ask = ask, ann = ann)
- else
- par(mfrow = mfrow, ask = ask)
+ if(plot){
+ 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 2009-01-20 15:28:01 UTC (rev 96)
+++ trunk/BRugs/R/samples.density.R 2009-01-20 17:15:40 UTC (rev 97)
@@ -30,11 +30,11 @@
thin <- max(c(thin, 1))
samplesSetThin(thin)
mons <- samplesMonitors(node)
- if (is.R())
- par(mfrow = mfrow, ask = ask, ann = ann)
+ if (is.R())
+ par(mfrow = mfrow, ask = ask, ann = ann)
else
- par(mfrow = mfrow, ask = ask)
+ par(mfrow = mfrow, ask = ask)
junk <- sapply(mons, plotDensity, ...)
if (!is.R())
- invisible()
+ invisible()
}
Modified: trunk/BRugs/R/samples.history.R
===================================================================
--- trunk/BRugs/R/samples.history.R 2009-01-20 15:28:01 UTC (rev 96)
+++ trunk/BRugs/R/samples.history.R 2009-01-20 17:15:40 UTC (rev 97)
@@ -4,7 +4,7 @@
thin = samplesGetThin(), plot = TRUE, mfrow = c(3, 1), ask = NULL, ann = TRUE, ...)
# Plot history
{
- if(is.null(ask)) {
+ if(plot && is.null(ask)) {
if (is.R())
ask <- !((dev.cur() > 1) && !dev.interactive())
else
@@ -29,10 +29,12 @@
thin <- max(c(thin, 1))
samplesSetThin(thin)
mons <- samplesMonitors(node)
- if (is.R())
- par(mfrow = mfrow, ask = ask, ann = ann)
- else
- par(mfrow = mfrow, ask = ask)
+ if(plot){
+ 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/tests/BRugs.Rout.save
===================================================================
--- trunk/BRugs/tests/BRugs.Rout.save 2009-01-20 15:28:01 UTC (rev 96)
+++ trunk/BRugs/tests/BRugs.Rout.save 2009-01-20 17:15:40 UTC (rev 97)
@@ -18,7 +18,7 @@
> library(BRugs)
Loading required package: coda
Loading required package: lattice
-Welcome to BRugs running on OpenBUGS version 3.0.1
+Welcome to BRugs running on OpenBUGS version 3.0.3
>
> BRugsFit(data = "ratsdata.txt", inits = "ratsinits.txt",
+ para = c("alpha", "beta"), modelFile = "ratsmodel.txt",
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <li...@us...> - 2009-02-15 18:56:33
|
Revision: 105
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=105&view=rev
Author: ligges
Date: 2009-02-15 18:56:29 +0000 (Sun, 15 Feb 2009)
Log Message:
-----------
move to tempdir() usage in BRugs
Modified Paths:
--------------
trunk/BRugs/DESCRIPTION
trunk/BRugs/NAMESPACE
trunk/BRugs/R/BRugsFit.R
trunk/BRugs/R/bugs.data.R
trunk/BRugs/R/bugs.inits.R
trunk/BRugs/man/BRugsFit.Rd
trunk/BRugs/man/bugs.data.Rd
trunk/BRugs/man/bugs.inits.Rd
Modified: trunk/BRugs/DESCRIPTION
===================================================================
--- trunk/BRugs/DESCRIPTION 2009-02-13 11:19:57 UTC (rev 104)
+++ trunk/BRugs/DESCRIPTION 2009-02-15 18:56:29 UTC (rev 105)
@@ -1,7 +1,7 @@
Package: BRugs
Title: OpenBUGS and its R / S-PLUS interface BRugs
-Version: 0.4-3
-Date: 2009-01-20
+Version: 0.5-0
+Date: 2009-02-15
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/NAMESPACE
===================================================================
--- trunk/BRugs/NAMESPACE 2009-02-13 11:19:57 UTC (rev 104)
+++ trunk/BRugs/NAMESPACE 2009-02-15 18:56:29 UTC (rev 105)
@@ -1,5 +1,5 @@
useDynLib(BRugs)
-importFrom(coda, mcmc)
+importFrom(coda, mcmc, mcmc.list)
export(BRugsFit, bugsData, bugsInits, buildMCMC, currentValues,
dicClear, dicSet, dicStats,
getNumChains, help.BRugs, help.WinBUGS,
Modified: trunk/BRugs/R/BRugsFit.R
===================================================================
--- trunk/BRugs/R/BRugsFit.R 2009-02-13 11:19:57 UTC (rev 104)
+++ trunk/BRugs/R/BRugsFit.R 2009-02-15 18:56:29 UTC (rev 105)
@@ -1,6 +1,6 @@
BRugsFit <-
function(modelFile, data, inits, numChains = 3, parametersToSave,
- nBurnin = 1000, nIter = 1000, nThin = 1,
+ nBurnin = 1000, nIter = 1000, nThin = 1, coda = FALSE,
DIC = TRUE, working.directory = NULL, digits = 5,
BRugsVerbose = getOption("BRugsVerbose")){
@@ -43,5 +43,8 @@
modelUpdate(nIter)
sims <- samplesStats("*")
# class(sims) <- "BRugsFit"
- return(list(Stats = sims, DIC = if(DIC) dicStats()))
+ if(coda)
+ return(buildMCMC("*"))
+ else
+ return(list(Stats = sims, DIC = if(DIC) dicStats()))
}
Modified: trunk/BRugs/R/bugs.data.R
===================================================================
--- trunk/BRugs/R/bugs.data.R 2009-02-13 11:19:57 UTC (rev 104)
+++ trunk/BRugs/R/bugs.data.R 2009-02-15 18:56:29 UTC (rev 105)
@@ -1,5 +1,5 @@
"bugsData" <-
-function(data, fileName = file.path(getwd(), "data.txt"), digits = 5){
+function(data, fileName = file.path(tempdir(), "data.txt"), digits = 5){
if(is.numeric(unlist(data)))
if(is.R()) {
write.datafile(lapply(data, formatC, digits = digits, format = "E"), fileName)
Modified: trunk/BRugs/R/bugs.inits.R
===================================================================
--- trunk/BRugs/R/bugs.inits.R 2009-02-13 11:19:57 UTC (rev 104)
+++ trunk/BRugs/R/bugs.inits.R 2009-02-15 18:56:29 UTC (rev 105)
@@ -1,7 +1,7 @@
"bugsInits" <-
function (inits, numChains = 1, fileName, digits = 5){
if(missing(fileName))
- fileName <- file.path(getwd(), paste("inits", 1:numChains, ".txt", sep = ""))
+ fileName <- file.path(tempdir(), paste("inits", 1:numChains, ".txt", sep = ""))
if(length(fileName) != numChains)
stop("numChains = ", numChains, " filenames must be specified")
if(!is.null(inits)){
Modified: trunk/BRugs/man/BRugsFit.Rd
===================================================================
--- trunk/BRugs/man/BRugsFit.Rd 2009-02-13 11:19:57 UTC (rev 104)
+++ trunk/BRugs/man/BRugsFit.Rd 2009-02-15 18:56:29 UTC (rev 105)
@@ -4,7 +4,7 @@
\description{This function takes model, data and starting values as input and automatically runs a simulation in BRugs.}
\usage{
BRugsFit(modelFile, data, inits, numChains = 3, parametersToSave,
- nBurnin = 1000, nIter = 1000, nThin = 1,
+ nBurnin = 1000, nIter = 1000, nThin = 1, coda = FALSE,
DIC = TRUE, working.directory = NULL, digits = 5,
BRugsVerbose = getOption("BRugsVerbose"))
}
@@ -14,13 +14,13 @@
\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.
- In these cases data are written into a file \file{data.txt} into the working directory.
+ In these cases data are written into a file \file{data.txt} into the temporary directory of the current R session.
If a filename of an existing file is given, data are read from that file.}
\item{inits}{A list with \code{numChains} elements; each element of the list is
itself a list of starting values for the OpenBUGS model, \emph{or}
a function creating (possibly random) initial values.
- In these cases inits are written into files \file{inits1.txt}, \dots, \file{initsN.txt} into the working directory.
+ In these cases inits are written into files \file{inits1.txt}, \dots, \file{initsN.txt} into the temporary directory of the current R session.
If a vector of filenames of existing files is given, inits are read from those files.
Alternatively, if \code{inits} is not specified, initial values are generated by OpenBUGS.}
@@ -29,6 +29,8 @@
\item{nBurnin}{Length of burn in (before \code{nIter} iterations start).}
\item{nIter}{Number of iterations (without burn in).}
\item{nThin}{Every \code{nThin}-th iteration of each chain is stored.}
+\item{coda}{Determines the output format: if \code{FALSE} (default), a list containing sample and DIC statistics is returned.
+ If \code{TRUE}, an \code{\link[coda]{mcmc.list}} object as known from the \pkg{coda} package is returned.}
\item{DIC}{Logical, whether to calculate and return the DIC.}
\item{working.directory}{Sets working directory during execution of this function;
\code{data}, \code{inits} and other files are written to / read from this directory if no other directory
@@ -39,7 +41,8 @@
This can be controlled for the whole BRugs package by by the option \sQuote{BRugsVerbose} (see \code{\link{options}})
which is set to \code{TRUE} by default.}
}
-\value{A list containg components
+\value{If \code{coda} is set to \kbd{TRUE}, an \code{\link[coda]{mcmc.list}} object as known from the \pkg{coda} package is returned,
+otherwise a list containg components
\item{Stats}{A data frame containing sample statistics. See \code{\link{samplesStats}}.}
\item{DIC}{The DIC statistics, if \code{DIC=TRUE}, else \code{NULL}. See \code{\link{dicStats}}.}
}
Modified: trunk/BRugs/man/bugs.data.Rd
===================================================================
--- trunk/BRugs/man/bugs.data.Rd 2009-02-13 11:19:57 UTC (rev 104)
+++ trunk/BRugs/man/bugs.data.Rd 2009-02-15 18:56:29 UTC (rev 105)
@@ -3,13 +3,13 @@
\title{Writing input for OpenBUGS}
\description{Write data file for OpenBUGS.}
\usage{
-bugsData(data, fileName = file.path(getwd(), "data.txt"), digits = 5)
+bugsData(data, fileName = file.path(tempdir(), "data.txt"), digits = 5)
}
\arguments{
\item{data}{either a named list (names corresponding to variable names in the model file)
of the data for the OpenBUGS model, \emph{or}
a vector or list of the names of the data objects used by the model}
- \item{fileName}{the filename, defaults to \file{data.txt} in the current working directory}
+ \item{fileName}{the filename, defaults to \file{data.txt} in the temporary directory of the current R session}
\item{digits}{number of significant digits used for OpenBUGS input, see \code{\link{formatC}}}
}
\value{
Modified: trunk/BRugs/man/bugs.inits.Rd
===================================================================
--- trunk/BRugs/man/bugs.inits.Rd 2009-02-13 11:19:57 UTC (rev 104)
+++ trunk/BRugs/man/bugs.inits.Rd 2009-02-15 18:56:29 UTC (rev 105)
@@ -11,7 +11,7 @@
a function creating (possibly random) initial values}
\item{numChains}{number of Markov chains}
\item{fileName}{the filename(s), one for each chain.
- Defaults to \file{inits1.txt}, ..., \file{initsN.txt} in the current working directory.}
+ Defaults to \file{inits1.txt}, ..., \file{initsN.txt} in the temporary directory of the current R session.}
\item{digits}{number of significant digits used for OpenBUGS input, see \code{\link{formatC}}}
}
\value{
@@ -20,4 +20,3 @@
\seealso{\code{\link{BRugs}}}
\keyword{file}
\concept{init}
-
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <li...@us...> - 2009-04-05 17:37:09
|
Revision: 111
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=111&view=rev
Author: ligges
Date: 2009-04-05 17:37:08 +0000 (Sun, 05 Apr 2009)
Log Message:
-----------
bugfix in order to protect users from misuses of samplesSample that yield in crashes
Modified Paths:
--------------
trunk/BRugs/DESCRIPTION
trunk/BRugs/R/samples.sample.R
Modified: trunk/BRugs/DESCRIPTION
===================================================================
--- trunk/BRugs/DESCRIPTION 2009-04-05 17:36:01 UTC (rev 110)
+++ trunk/BRugs/DESCRIPTION 2009-04-05 17:37:08 UTC (rev 111)
@@ -1,7 +1,7 @@
Package: BRugs
Title: OpenBUGS and its R / S-PLUS interface BRugs
-Version: 0.5-0
-Date: 2009-02-15
+Version: 0.5-1
+Date: 2009-04-05
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/samples.sample.R
===================================================================
--- trunk/BRugs/R/samples.sample.R 2009-04-05 17:36:01 UTC (rev 110)
+++ trunk/BRugs/R/samples.sample.R 2009-04-05 17:37:08 UTC (rev 111)
@@ -4,6 +4,19 @@
{
if(samplesGetFirstChain() > samplesGetLastChain())
stop("Number of first chain is larger than last chain!")
+ if(length(node) != 1)
+ stop("Exactly one scalar node must be given.")
+ sM <- samplesMonitors(node)[1]
+ if(sM == "model must be initialized before monitors used")
+ stop("model must be initialized / updated / monitored before samplesSample is used")
+
+ command <- "BugsRobjects.SetVariable"
+ .C("CharArray", command, nchar(command), node, nchar(node), integer(1), PACKAGE="BRugs")
+ command <- "BugsRobjects.GetSize"
+ nodeSize <- .C("Integer", command, nchar(command), integer(1), integer(1), PACKAGE="BRugs")[3]
+ if(nodeSize > 1)
+ stop("Only scalar nodes such as ", node, "[1] are allowed.")
+
command <- paste("SamplesEmbed.SetVariable(", sQuote(node), ")")
.C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE="BRugs")
command <- "SamplesEmbed.SampleSize"
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <gg...@us...> - 2009-07-13 13:03:23
|
Revision: 117
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=117&view=rev
Author: ggorjan
Date: 2009-07-13 13:02:56 +0000 (Mon, 13 Jul 2009)
Log Message:
-----------
Added seed to BRugsFit().
Added NEWS file and some notes for easier copying of BUGS files.
Modified Paths:
--------------
trunk/BRugs/R/BRugsFit.R
trunk/BRugs/inst/README-inst_OpenBUGS
trunk/BRugs/man/BRugsFit.Rd
Added Paths:
-----------
trunk/BRugs/NEWS
Added: trunk/BRugs/NEWS
===================================================================
--- trunk/BRugs/NEWS (rev 0)
+++ trunk/BRugs/NEWS 2009-07-13 13:02:56 UTC (rev 117)
@@ -0,0 +1,5 @@
+Changes to BRugs:
+=====================
+
+Update 0.5-2
+- added seed argument to BRugsFit()
\ No newline at end of file
Modified: trunk/BRugs/R/BRugsFit.R
===================================================================
--- trunk/BRugs/R/BRugsFit.R 2009-07-13 11:14:17 UTC (rev 116)
+++ trunk/BRugs/R/BRugsFit.R 2009-07-13 13:02:56 UTC (rev 117)
@@ -1,7 +1,7 @@
BRugsFit <-
function(modelFile, data, inits, numChains = 3, parametersToSave,
nBurnin = 1000, nIter = 1000, nThin = 1, coda = FALSE,
- DIC = TRUE, working.directory = NULL, digits = 5,
+ DIC = TRUE, working.directory = NULL, digits = 5, seed=NULL,
BRugsVerbose = getOption("BRugsVerbose")){
if(is.null(BRugsVerbose))
@@ -24,10 +24,10 @@
data <- bugsData(data, digits = digits)
modelData(data)
modelCompile(numChains)
+ if(!is.null(seed)) modelSetSeed(newSeed=seed)
if(missing(inits)){
modelGenInits()
- }
- else{
+ } 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)
Modified: trunk/BRugs/inst/README-inst_OpenBUGS
===================================================================
--- trunk/BRugs/inst/README-inst_OpenBUGS 2009-07-13 11:14:17 UTC (rev 116)
+++ trunk/BRugs/inst/README-inst_OpenBUGS 2009-07-13 13:02:56 UTC (rev 117)
@@ -11,3 +11,16 @@
OpenBUGS/Developer/*.html
OpenBUGS/Manuals/*.bmp
OpenBUGS/Manuals/*.html
+
+This can help to automate the copying:
+
+set OpenBUGS=C:/Programs/BUGS/OpenBUGS_3.0.3
+
+mkdir OpenBUGS
+cd OpenBUGS
+mkdir Examples Developer Manuals
+
+cp -f %OpenBUGS%/{brugs.dll,brugs.so,libtaucs.dll} .
+cp -f %OpenBUGS%/Examples/{*.bmp,*.html,*.txt} Examples/.
+cp -f %OpenBUGS%/Developer/{*.bmp,*.html} Developer/.
+cp -f %OpenBUGS%/Manuals/{*.bmp,*.html} Manuals/.
\ No newline at end of file
Modified: trunk/BRugs/man/BRugsFit.Rd
===================================================================
--- trunk/BRugs/man/BRugsFit.Rd 2009-07-13 11:14:17 UTC (rev 116)
+++ trunk/BRugs/man/BRugsFit.Rd 2009-07-13 13:02:56 UTC (rev 117)
@@ -5,7 +5,7 @@
\usage{
BRugsFit(modelFile, data, inits, numChains = 3, parametersToSave,
nBurnin = 1000, nIter = 1000, nThin = 1, coda = FALSE,
- DIC = TRUE, working.directory = NULL, digits = 5,
+ DIC = TRUE, working.directory = NULL, digits = 5, seed=NULL,
BRugsVerbose = getOption("BRugsVerbose"))
}
\arguments{
@@ -37,6 +37,8 @@
is explicitly given in those arguments.
If \code{NULL}, the current working directory is chosen.}
\item{digits}{Number of significant digits used for OpenBUGS input, see \code{\link{formatC}}.}
+\item{seed}{Positive non-zero integer value(s) to set seed for random number
+ generator - default is no seed (see \code{\link{modelSetSeed}}).}
\item{BRugsVerbose}{Logical, whether BRugs is supposed to be verbose.
This can be controlled for the whole BRugs package by by the option \sQuote{BRugsVerbose} (see \code{\link{options}})
which is set to \code{TRUE} by default.}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <gg...@us...> - 2009-10-20 13:52:10
|
Revision: 121
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=121&view=rev
Author: ggorjan
Date: 2009-10-20 13:52:03 +0000 (Tue, 20 Oct 2009)
Log Message:
-----------
- BRugsFit now saves model, data, and inits in working.directory, if
the later is not NULL
- bugsData and bugsInits gain dir argument
Modified Paths:
--------------
trunk/BRugs/DESCRIPTION
trunk/BRugs/NEWS
trunk/BRugs/R/BRugsFit.R
trunk/BRugs/R/bugs.data.R
trunk/BRugs/R/bugs.inits.R
trunk/BRugs/man/bugs.data.Rd
trunk/BRugs/man/bugs.inits.Rd
Modified: trunk/BRugs/DESCRIPTION
===================================================================
--- trunk/BRugs/DESCRIPTION 2009-10-20 13:50:20 UTC (rev 120)
+++ trunk/BRugs/DESCRIPTION 2009-10-20 13:52:03 UTC (rev 121)
@@ -1,6 +1,6 @@
Package: BRugs
Title: OpenBUGS and its R / S-PLUS interface BRugs
-Version: 0.5-1
+Version: 0.5-2
Date: 2009-04-05
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.
Modified: trunk/BRugs/NEWS
===================================================================
--- trunk/BRugs/NEWS 2009-10-20 13:50:20 UTC (rev 120)
+++ trunk/BRugs/NEWS 2009-10-20 13:52:03 UTC (rev 121)
@@ -2,4 +2,7 @@
=====================
Update 0.5-2
+- BRugsFit now saves model, data, and inits in working.directory, if
+ the later is not NULL
+- bugsData and bugsInits gain dir argument
- added seed argument to BRugsFit()
\ No newline at end of file
Modified: trunk/BRugs/R/BRugsFit.R
===================================================================
--- trunk/BRugs/R/BRugsFit.R 2009-10-20 13:50:20 UTC (rev 120)
+++ trunk/BRugs/R/BRugsFit.R 2009-10-20 13:52:03 UTC (rev 121)
@@ -9,27 +9,35 @@
op <- options("BRugsVerbose" = BRugsVerbose)
on.exit(options(op))
if(!is.null(working.directory)){
+ working.directory <- path.expand(working.directory)
savedWD <- getwd()
setwd(working.directory)
on.exit(setwd(savedWD), add = TRUE)
}
if(is.function(modelFile)){
- writeModel(modelFile, con = (modelFile <- tempfile("model")))
- if(!is.R()) on.exit(file.remove(modelFile), add = TRUE)
+ if(!is.null(working.directory)) {
+ temp <- file.path(working.directory, "model.txt")
+ } else {
+ temp <- tempfile("model")
+ on.exit(file.remove(temp), add=TRUE)
+ }
+ writeModel(modelFile, con=temp)
+ modelFile <- temp
}
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)
+ data <- bugsData(data, digits = digits, dir=working.directory)
+ modelData(data)
modelCompile(numChains)
if(!is.null(seed)) modelSetSeed(newSeed=seed)
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)
+ inits <- bugsInits(inits = inits, numChains = numChains, digits = digits,
+ dir=working.directory)
if(BRugsVerbose) print(inits)
modelInits(inits)
}
Modified: trunk/BRugs/R/bugs.data.R
===================================================================
--- trunk/BRugs/R/bugs.data.R 2009-10-20 13:50:20 UTC (rev 120)
+++ trunk/BRugs/R/bugs.data.R 2009-10-20 13:52:03 UTC (rev 121)
@@ -1,5 +1,10 @@
"bugsData" <-
-function(data, fileName = file.path(tempdir(), "data.txt"), digits = 5){
+function(data, fileName, digits = 5, dir)
+{
+ if(missing(fileName)) {
+ fileName <- file.path(ifelse(missing(dir), tempdir(), dir),
+ "data.txt")
+ }
if(is.numeric(unlist(data)))
if(is.R()) {
write.datafile(lapply(data, formatC, digits = digits, format = "E"), fileName)
Modified: trunk/BRugs/R/bugs.inits.R
===================================================================
--- trunk/BRugs/R/bugs.inits.R 2009-10-20 13:50:20 UTC (rev 120)
+++ trunk/BRugs/R/bugs.inits.R 2009-10-20 13:52:03 UTC (rev 121)
@@ -1,7 +1,10 @@
"bugsInits" <-
-function (inits, numChains = 1, fileName, digits = 5){
- if(missing(fileName))
- fileName <- file.path(tempdir(), paste("inits", 1:numChains, ".txt", sep = ""))
+function (inits, numChains = 1, fileName, digits = 5, dir)
+{
+ if(missing(fileName)) {
+ fileName <- file.path(ifelse(missing(dir), tempdir(), dir),
+ paste("inits", 1:numChains, ".txt", sep=""))
+ }
if(length(fileName) != numChains)
stop("numChains = ", numChains, " filenames must be specified")
if(!is.null(inits)){
Modified: trunk/BRugs/man/bugs.data.Rd
===================================================================
--- trunk/BRugs/man/bugs.data.Rd 2009-10-20 13:50:20 UTC (rev 120)
+++ trunk/BRugs/man/bugs.data.Rd 2009-10-20 13:52:03 UTC (rev 121)
@@ -3,7 +3,7 @@
\title{Writing input for OpenBUGS}
\description{Write data file for OpenBUGS.}
\usage{
-bugsData(data, fileName = file.path(tempdir(), "data.txt"), digits = 5)
+bugsData(data, fileName, digits = 5, dir)
}
\arguments{
\item{data}{either a named list (names corresponding to variable names in the model file)
@@ -11,6 +11,7 @@
a vector or list of the names of the data objects used by the model}
\item{fileName}{the filename, defaults to \file{data.txt} in the temporary directory of the current R session}
\item{digits}{number of significant digits used for OpenBUGS input, see \code{\link{formatC}}}
+ \item{dir}{character, where to save data, defaults to temporary directory}
}
\value{
Invisibly returns the \code{fileName}.
Modified: trunk/BRugs/man/bugs.inits.Rd
===================================================================
--- trunk/BRugs/man/bugs.inits.Rd 2009-10-20 13:50:20 UTC (rev 120)
+++ trunk/BRugs/man/bugs.inits.Rd 2009-10-20 13:52:03 UTC (rev 121)
@@ -3,7 +3,7 @@
\title{Writing input for OpenBUGS}
\description{Write files containing inits.}
\usage{
-bugsInits(inits, numChains = 1, fileName, digits = 5)
+bugsInits(inits, numChains = 1, fileName, digits = 5, dir)
}
\arguments{
\item{inits}{a list with \code{n.chains} elements; each element of the list is
@@ -13,6 +13,7 @@
\item{fileName}{the filename(s), one for each chain.
Defaults to \file{inits1.txt}, ..., \file{initsN.txt} in the temporary directory of the current R session.}
\item{digits}{number of significant digits used for OpenBUGS input, see \code{\link{formatC}}}
+ \item{dir}{character, where to save data, defaults to temporary directory}
}
\value{
Invisibly returns the \code{fileName}(s).
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <li...@us...> - 2009-11-08 19:36:05
|
Revision: 133
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=133&view=rev
Author: ligges
Date: 2009-11-08 19:35:59 +0000 (Sun, 08 Nov 2009)
Log Message:
-----------
fix buildMCMC() to report right thinning parameters and keep all samples
Modified Paths:
--------------
trunk/BRugs/NEWS
trunk/BRugs/R/buildMCMC.R
Modified: trunk/BRugs/NEWS
===================================================================
--- trunk/BRugs/NEWS 2009-11-07 19:17:34 UTC (rev 132)
+++ trunk/BRugs/NEWS 2009-11-08 19:35:59 UTC (rev 133)
@@ -3,6 +3,7 @@
Update 0.5-3
- fix writeModel() again by going through parse tree now
+- fix buildMCMC() to report right thinning parameters and keep all samples
Update 0.5-2
Modified: trunk/BRugs/R/buildMCMC.R
===================================================================
--- trunk/BRugs/R/buildMCMC.R 2009-11-07 19:17:34 UTC (rev 132)
+++ trunk/BRugs/R/buildMCMC.R 2009-11-08 19:35:59 UTC (rev 133)
@@ -40,10 +40,7 @@
thin <- samplesGetThin()
numChains <- samplesGetLastChain() - samplesGetFirstChain() + 1
sampleSize <- sampleSize %/% numChains
- beg <- end - (sampleSize - 1) * thin
- beg <- beg %/% thin
- end <- end %/% thin
-
+ beg <- end - sampleSize * thin + 1
samples <- lapply(mons, subBuildMCMC)
samplesChain <- vector(mode="list", length=numChains)
@@ -62,7 +59,6 @@
colnames(samplesChain[[i]]) <- mons
# }
}
-
mcmcobj <- lapply(samplesChain, mcmc, start = beg, end = end, thin = thin)
if(is.R())
class(mcmcobj) <- "mcmc.list"
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <li...@us...> - 2010-04-30 19:59:37
|
Revision: 136
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=136&view=rev
Author: ligges
Date: 2010-04-30 19:59:31 +0000 (Fri, 30 Apr 2010)
Log Message:
-----------
first changes for OpenBUGS 3.0.8
Modified Paths:
--------------
trunk/BRugs/DESCRIPTION
trunk/BRugs/NEWS
trunk/BRugs/R/zzz.R
Modified: trunk/BRugs/DESCRIPTION
===================================================================
--- trunk/BRugs/DESCRIPTION 2010-04-30 19:21:43 UTC (rev 135)
+++ trunk/BRugs/DESCRIPTION 2010-04-30 19:59:31 UTC (rev 136)
@@ -1,7 +1,7 @@
Package: BRugs
Title: OpenBUGS and its R / S-PLUS interface BRugs
-Version: 0.5-3
-Date: 2009-11-06
+Version: 0.6-0
+Date: 2010-04-30
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. With considerable contributions by Gregor Gorjanc <gre...@bf...>.
Description: An R / S-PLUS package containing OpenBUGS and its R / S-PLUS interface BRugs.
Maintainer: Uwe Ligges <li...@st...>
@@ -9,4 +9,4 @@
Archs: i386
OS_type: windows
License: GPL-2
-URL: http://mathstat.helsinki.fi/openbugs/
+URL: http://www.openbugs.info/
Modified: trunk/BRugs/NEWS
===================================================================
--- trunk/BRugs/NEWS 2010-04-30 19:21:43 UTC (rev 135)
+++ trunk/BRugs/NEWS 2010-04-30 19:59:31 UTC (rev 136)
@@ -1,6 +1,10 @@
Changes to BRugs:
=====================
+Update 0.6-0
+- Switch to new OpenBUGS (currently 3.0.8)
+- 32-bit versions only
+
Update 0.5-3
- fix writeModel() again by going through parse tree now
- fix buildMCMC() to report right thinning parameters and keep all samples
Modified: trunk/BRugs/R/zzz.R
===================================================================
--- trunk/BRugs/R/zzz.R 2010-04-30 19:21:43 UTC (rev 135)
+++ trunk/BRugs/R/zzz.R 2010-04-30 19:59:31 UTC (rev 136)
@@ -6,7 +6,7 @@
## we do have a NAMESPACE now: library.dynam("BRugs", pkg, lib)
len <- nchar(root)
tempDir <- gsub("\\\\", "/", tempdir())
- .C("SetRoot", as.character(root), len, PACKAGE="BRugs")
+ .C("SetWorkingDir", as.character(root), len, PACKAGE="BRugs")
.C("SetTempDir", as.character(tempDir), nchar(tempDir), PACKAGE="BRugs")
command <- "BugsMappers.SetDest(2)"
.CmdInterpreter(command)
@@ -15,7 +15,7 @@
}
".onAttach" <- function(lib, pkg){
- message("Welcome to BRugs running on OpenBUGS version 3.0.3")
+ message("Welcome to BRugs running on OpenBUGS version 3.0.8")
}
".onUnload" <- function(libpath){
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <li...@us...> - 2010-05-02 14:10:00
|
Revision: 137
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=137&view=rev
Author: ligges
Date: 2010-05-02 14:09:53 +0000 (Sun, 02 May 2010)
Log Message:
-----------
copy dll via Makevars for future R > 2.12.0 compatibility (with multiple architectures available such as 32 vs 64 bit)
Modified Paths:
--------------
trunk/BRugs/configure.win
trunk/BRugs/inst/README-inst_OpenBUGS
Added Paths:
-----------
trunk/BRugs/src/
trunk/BRugs/src/Makevars
trunk/BRugs/src/Makevars.win
Modified: trunk/BRugs/configure.win
===================================================================
--- trunk/BRugs/configure.win 2010-04-30 19:59:31 UTC (rev 136)
+++ trunk/BRugs/configure.win 2010-05-02 14:09:53 UTC (rev 137)
@@ -1,8 +0,0 @@
-#!/bin/sh
-
-if test -z "$R_PACKAGE_DIR" ; then
- R_PACKAGE_DIR=${DPKG}
-fi
-mkdir ${R_PACKAGE_DIR}/libs
-cp ./inst/OpenBUGS/brugs.dll ${R_PACKAGE_DIR}/libs/BRugs.dll
-
Modified: trunk/BRugs/inst/README-inst_OpenBUGS
===================================================================
--- trunk/BRugs/inst/README-inst_OpenBUGS 2010-04-30 19:59:31 UTC (rev 136)
+++ trunk/BRugs/inst/README-inst_OpenBUGS 2010-05-02 14:09:53 UTC (rev 137)
@@ -2,8 +2,8 @@
REM for BRugs from the current OpenBUGS distribution:
REM
REM OpenBUGS
-REM OpenBUGS/brugs.dll
-REM OpenBUGS/brugs.so
+REM OpenBUGS/libOpenBUGS.dll
+REM OpenBUGS/libOpenBUGS.sop
REM OpenBUGS/libtaucs.dll
REM OpenBUGS/Examples/*.bmp
REM OpenBUGS/Examples/*.html
@@ -23,8 +23,8 @@
mkdir Examples Developer Manuals
REM Copy the files
-cp -f %OpenBUGS%/libOpenBUGS.dll BRugs.dll
-cp -f %OpenBUGS%/libOpenBUGS.so BRugs.so
+cp -f %OpenBUGS%/libOpenBUGS.dll .
+cp -f %OpenBUGS%/libOpenBUGS.so .
cp -f %OpenBUGS%/libtaucs.dll .
cp -f %OpenBUGS%/Examples/{*.bmp,*.html,*.txt} Examples/.
cp -f %OpenBUGS%/Developer/{*.bmp,*.html} Developer/.
Added: trunk/BRugs/src/Makevars
===================================================================
--- trunk/BRugs/src/Makevars (rev 0)
+++ trunk/BRugs/src/Makevars 2010-05-02 14:09:53 UTC (rev 137)
@@ -0,0 +1,2 @@
+copylib:
+ $(CP) ../inst/OpenBUGS/libOpenBUGS.so ./BRugs.so
Added: trunk/BRugs/src/Makevars.win
===================================================================
--- trunk/BRugs/src/Makevars.win (rev 0)
+++ trunk/BRugs/src/Makevars.win 2010-05-02 14:09:53 UTC (rev 137)
@@ -0,0 +1,2 @@
+copylib:
+ $(CP) ../inst/OpenBUGS/libOpenBUGS.dll ./BRugs.dll
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <li...@us...> - 2010-05-02 14:40:25
|
Revision: 139
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=139&view=rev
Author: ligges
Date: 2010-05-02 14:40:19 +0000 (Sun, 02 May 2010)
Log Message:
-----------
make R CMD build and R CMD check happy
Modified Paths:
--------------
trunk/BRugs/man/model.precision.Rd
trunk/BRugs/src/Makevars
Modified: trunk/BRugs/man/model.precision.Rd
===================================================================
--- trunk/BRugs/man/model.precision.Rd 2010-05-02 14:21:32 UTC (rev 138)
+++ trunk/BRugs/man/model.precision.Rd 2010-05-02 14:40:19 UTC (rev 139)
@@ -6,7 +6,7 @@
modelPrecision(prec)
}
\arguments{
- \item{prec}{}
+ \item{prec}{precision used in the figures}
}
\details{It does not affect the precision of any calculations!}
\seealso{\code{\link{BRugs}}, \code{\link{help.WinBUGS}}}
Modified: trunk/BRugs/src/Makevars
===================================================================
--- trunk/BRugs/src/Makevars 2010-05-02 14:21:32 UTC (rev 138)
+++ trunk/BRugs/src/Makevars 2010-05-02 14:40:19 UTC (rev 139)
@@ -1,2 +1,2 @@
-copylib:
+copylib:
$(CP) ../inst/OpenBUGS/libOpenBUGS.so ./BRugs.so
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <li...@us...> - 2010-05-10 09:46:16
|
Revision: 146
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=146&view=rev
Author: ligges
Date: 2010-05-10 09:46:10 +0000 (Mon, 10 May 2010)
Log Message:
-----------
OpenBUGS 3.1.0 is there ....
Modified Paths:
--------------
trunk/BRugs/NEWS
trunk/BRugs/R/zzz.R
Modified: trunk/BRugs/NEWS
===================================================================
--- trunk/BRugs/NEWS 2010-05-07 13:13:10 UTC (rev 145)
+++ trunk/BRugs/NEWS 2010-05-10 09:46:10 UTC (rev 146)
@@ -2,7 +2,7 @@
=====================
Update 0.6-0
-- Switch to new OpenBUGS (currently 3.0.8)
+- Switch to new OpenBUGS (currently 3.1.0)
- 32-bit versions only
Update 0.5-3
@@ -13,5 +13,5 @@
Update 0.5-2
- added seed argument to BRugsFit()
- fix writeModel() to work for separatly specified function body
-- fix writeModel() to make larger numeric (particularly integer) values
+- fix writeModel() to make larger numeric (particularly integer) values
in scientific notation work
Modified: trunk/BRugs/R/zzz.R
===================================================================
--- trunk/BRugs/R/zzz.R 2010-05-07 13:13:10 UTC (rev 145)
+++ trunk/BRugs/R/zzz.R 2010-05-10 09:46:10 UTC (rev 146)
@@ -15,7 +15,7 @@
}
".onAttach" <- function(lib, pkg){
- message("Welcome to BRugs running on OpenBUGS version 3.0.8")
+ message("Welcome to BRugs running on OpenBUGS version 3.1.0")
}
".onUnload" <- function(libpath){
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <li...@us...> - 2010-05-10 15:17:34
|
Revision: 147
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=147&view=rev
Author: ligges
Date: 2010-05-10 15:17:28 +0000 (Mon, 10 May 2010)
Log Message:
-----------
save files into the right place now and improve docs
Modified Paths:
--------------
trunk/BRugs/R/model.save.state.R
trunk/BRugs/man/model.save.state.Rd
Modified: trunk/BRugs/R/model.save.state.R
===================================================================
--- trunk/BRugs/R/model.save.state.R 2010-05-10 09:46:10 UTC (rev 146)
+++ trunk/BRugs/R/model.save.state.R 2010-05-10 15:17:28 UTC (rev 147)
@@ -1,6 +1,10 @@
"modelSaveState" <- function(stem)
{
-# Saves the sate of each chain in OpenBUGS model
+## Saves the sate of each chain in OpenBUGS model
+ if(!is.character(stem) || length(stem)!=1)
+ stop("'stem' must be character of length 1")
+ if(dirname(stem) == ".")
+ stem <- file.path(getwd(), basename(stem))
command <- paste("BugsEmbed.UpdateGuard", ";BugsEmbed.WriteChains(", sQuote(stem), ")")
.CmdInterpreter(command)
if(getOption("BRugsVerbose"))
Modified: trunk/BRugs/man/model.save.state.Rd
===================================================================
--- trunk/BRugs/man/model.save.state.Rd 2010-05-10 09:46:10 UTC (rev 146)
+++ trunk/BRugs/man/model.save.state.Rd 2010-05-10 15:17:28 UTC (rev 147)
@@ -6,15 +6,20 @@
modelSaveState(stem)
}
\arguments{
- \item{stem}{?????.}
+ \item{stem}{The filestem of the files to be generated.}
}
-\note{This function can be executed once a model has been successfully checked
- ?????
-(see \code{\link{modelCheck}}).
+\details{
+ Example for argument \code{stem}:
+ If \code{stem = "c:/myFolder/stem"}, the resulting files
+ are called \file{stem1.txt}, ..., \file{stemN.txt}.
+ They are written into the \code{tempdir()}
+ and copied to the path \file{"c:/myFolder"}.
+}
+\note{This function can be executed once a model has been successfully checked (see \code{\link{modelCheck}}).
+
If an attempt is made to execute this function in an inappropriate context the generic error message
\sQuote{command is not allowed (greyed out)} is displayed.
- ?????
}
\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: <chr...@us...> - 2010-05-17 12:48:57
|
Revision: 149
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=149&view=rev
Author: chris-jackson
Date: 2010-05-17 12:48:48 +0000 (Mon, 17 May 2010)
Log Message:
-----------
Mechanism for setting the random number seed has changed since OpenBUGS 3.0.3. Now you can only supply an integer from 1 to 14 defining the "state" of the random number generator. Copied the relevant documentation from the OpenBUGS manual,
though there's hardly any documentation on the actual algorithms used by the generator.
Modified Paths:
--------------
trunk/BRugs/R/model.get.seed.R
trunk/BRugs/R/model.set.seed.R
trunk/BRugs/man/model.seed.Rd
Modified: trunk/BRugs/R/model.get.seed.R
===================================================================
--- trunk/BRugs/R/model.get.seed.R 2010-05-17 12:45:24 UTC (rev 148)
+++ trunk/BRugs/R/model.get.seed.R 2010-05-17 12:48:48 UTC (rev 149)
@@ -1,11 +1,7 @@
"modelGetSeed" <-
-function(i = 1)
+function()
# 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 <- .CmdInterpreter(command)[[3]]
- if(res) stop("Getting seed returned with an error.")
- buffer()
+ command <- "BugsEmbed.preSet"
+ .Integer(command)
}
Modified: trunk/BRugs/R/model.set.seed.R
===================================================================
--- trunk/BRugs/R/model.set.seed.R 2010-05-17 12:45:24 UTC (rev 148)
+++ trunk/BRugs/R/model.set.seed.R 2010-05-17 12:48:48 UTC (rev 149)
@@ -1,18 +1,14 @@
-"modelSetSeed" <-
-function(newSeed)
+"modelSetSeed" <-
+function(state)
# 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.SetRNGuard; BugsEmbed.SetRNState(", newSeed[i], ")" )
- res <- .CmdInterpreter(command)[[3]]
- }
+ if(!state %in% 1:14)
+ stop("state must be an integer from 1 to 14")
+ newSeed <- as.integer(state)
+ command <- paste("BugsEmbed.SetRNGuard; BugsEmbed.SetRNState(", state, ")" )
+ res <- .CmdInterpreter(command)[[3]]
if(!res){
if(getOption("BRugsVerbose"))
- message("Seed successfully set")
- }else stop("Setting seed returned with an error.")
-
-}
+ message("Random number generator state successfully set")
+ }else stop("Setting random number generator state returned with an error.")
+}
Modified: trunk/BRugs/man/model.seed.Rd
===================================================================
--- trunk/BRugs/man/model.seed.Rd 2010-05-17 12:45:24 UTC (rev 148)
+++ trunk/BRugs/man/model.seed.Rd 2010-05-17 12:48:48 UTC (rev 149)
@@ -4,15 +4,17 @@
\title{Seed of Random Number Generator}
\description{These functions set/return the seed of the random number generator.}
\usage{
-modelSetSeed(newSeed)
-modelGetSeed(i = 1)
+modelSetSeed(state)
+modelGetSeed()
}
\arguments{
- \item{newSeed}{a positive, non zero (vector of) integer(s).
- More than one integer if the chosen random number generator requires more seed components.}
- \item{i}{indicates which component of the seed should be returned.}
+ \item{state}{An integer from 1 to 14. The internal state of the OpenBUGS random number generator can be set to one of 14 predefined states. Each predefined state is \eqn{10^12}{10^12} draws apart to avoid overlap in random number sequences.}
}
-\details{Warning: \code{modelSetSeed} must not be used before \code{\link{modelCompile}} has been executed successfully!}
+\details{Warning: \code{modelSetSeed} must not be used before
+ \code{\link{modelCompile}} has been executed successfully!
+ The state can be changed after initial values are generated
+ but before updates have been performed, however, this is not recommended.
+}
\seealso{\code{\link{BRugs}}, \code{\link{help.WinBUGS}}}
\keyword{interface}
\concept{update}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <chr...@us...> - 2010-05-17 12:52:18
|
Revision: 150
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=150&view=rev
Author: chris-jackson
Date: 2010-05-17 12:52:12 +0000 (Mon, 17 May 2010)
Log Message:
-----------
"plot=TRUE/FALSE" option added to density plots.
Modified Paths:
--------------
trunk/BRugs/R/plot.density.R
trunk/BRugs/R/samples.density.R
trunk/BRugs/man/plot.density.Rd
trunk/BRugs/man/samples.density.Rd
Modified: trunk/BRugs/R/plot.density.R
===================================================================
--- trunk/BRugs/R/plot.density.R 2010-05-17 12:48:48 UTC (rev 149)
+++ trunk/BRugs/R/plot.density.R 2010-05-17 12:52:12 UTC (rev 150)
@@ -1,5 +1,5 @@
"plotDensity" <-
-function(node, main = NULL, xlab = "" , ylab = "", col = "red", ...)
+function(node, plot=TRUE, main = NULL, xlab = "" , ylab = "", col = "red", ...)
# Plot posterior density for single component of OpenBUGS name
{
sM <- samplesMonitors(node)
@@ -8,7 +8,7 @@
nodeName <- sQuote(node)
sampleSize <- samplesSize(node)
sample <- samplesSample(node)
-
+
absSample <- abs(sample)
intSample <- as.integer(absSample + 1.0E-10)
zero <- absSample - intSample
@@ -18,15 +18,20 @@
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, ...)
+ if (plot)
+ plot(d$x, d$y, type = "l", main = if(is.null(main)) nodeName else main,
+ xlab = xlab , ylab = ylab, col = col, ...)
+ res <- d
}
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, ...)
+ if (plot)
+ plot(histogram, type = "h", xlim = xLim, ylim = c(0, 1),
+ main = if(is.null(main)) nodeName else main,
+ xlab = xlab , ylab = ylab, col = col, ...)
+ res <- histogram
}
+ if (plot) invisible(res) else return(res)
}
Modified: trunk/BRugs/R/samples.density.R
===================================================================
--- trunk/BRugs/R/samples.density.R 2010-05-17 12:48:48 UTC (rev 149)
+++ trunk/BRugs/R/samples.density.R 2010-05-17 12:52:12 UTC (rev 150)
@@ -1,8 +1,9 @@
"samplesDensity" <-
-function(node, beg = samplesGetBeg(), end = samplesGetEnd(),
-firstChain = samplesGetFirstChain(), lastChain = samplesGetLastChain(),
-thin = samplesGetThin(), mfrow = c(3, 2), ask = NULL, ann = TRUE, ...)
-# Plot posterior density
+function(node, beg = samplesGetBeg(), end = samplesGetEnd(),
+firstChain = samplesGetFirstChain(), lastChain = samplesGetLastChain(),
+thin = samplesGetThin(), plot = TRUE, mfrow = c(3, 2), ask = NULL,
+ann = TRUE, ...)
+# Plot posterior density
{
if(is.null(ask)) {
if (is.R())
@@ -15,7 +16,7 @@
oldFirstChain <- samplesGetFirstChain()
oldLastChain <- samplesGetLastChain()
oldThin <- samplesGetThin()
- on.exit({
+ on.exit({
samplesSetBeg(oldBeg)
samplesSetEnd(oldEnd)
samplesSetFirstChain(oldFirstChain)
@@ -34,7 +35,11 @@
par(mfrow = mfrow, ask = ask, ann = ann)
else
par(mfrow = mfrow, ask = ask)
- junk <- sapply(mons, plotDensity, ...)
+ result <- sapply(mons, plotDensity, plot=plot, ...)
if (!is.R())
invisible()
+ else {
+ if(plot) invisible(result)
+ else return(result)
+ }
}
Modified: trunk/BRugs/man/plot.density.Rd
===================================================================
--- trunk/BRugs/man/plot.density.Rd 2010-05-17 12:48:48 UTC (rev 149)
+++ trunk/BRugs/man/plot.density.Rd 2010-05-17 12:52:12 UTC (rev 150)
@@ -1,15 +1,18 @@
\name{plotDensity}
\alias{plotDensity}
\title{Plot density estimate or histogram of a scalar variable}
-\description{This function plots a smoothed kernel density estimate for a scalar variable if it is continuous
+\description{This function plots a smoothed kernel density estimate for a scalar variable if it is continuous
or a histogram if it is discrete.}
\usage{
-plotDensity(node, main = NULL, xlab = "" , ylab = "", col = "red", ...)
+plotDensity(node, plot=TRUE, main = NULL, xlab = "" , ylab = "", col = "red",
+ ...)
}
\arguments{
\item{node}{Character, name of a scalar variable in the model.}
- \item{main, xlab, ylab, col}{graphical parameters, see \code{\link{plot.default}}}
- \item{...}{Further graphical parameters as in \code{\link{par}}.}
+ \item{plot}{Logical, whether to plot the trace or only return density estimates.
+ If \code{TRUE}, density estimates are returned invisibly.}
+ \item{main, xlab, ylab, col}{graphical parameters, see \code{\link{plot.default}}}
+ \item{...}{Further graphical parameters as in \code{\link{par}}.}
}
\details{Acts on a scalar variable. See the wrapper function \code{\link{samplesDensity}} for more details.}
\seealso{\code{\link{samplesDensity}}, \code{\link{BRugs}}, \code{\link{help.WinBUGS}}}
Modified: trunk/BRugs/man/samples.density.Rd
===================================================================
--- trunk/BRugs/man/samples.density.Rd 2010-05-17 12:48:48 UTC (rev 149)
+++ trunk/BRugs/man/samples.density.Rd 2010-05-17 12:52:12 UTC (rev 150)
@@ -1,31 +1,33 @@
\name{samplesDensity}
\alias{samplesDensity}
\title{Plot density estimate or histogram}
-\description{This function plots a smoothed kernel density estimate for a variable if it is continuous
+\description{This function plots a smoothed kernel density estimate for a variable if it is continuous
or a histogram if it is discrete.}
\usage{
-samplesDensity(node, beg = samplesGetBeg(), end = samplesGetEnd(),
- firstChain = samplesGetFirstChain(),
+samplesDensity(node, beg = samplesGetBeg(), end = samplesGetEnd(),
+ firstChain = samplesGetFirstChain(),
lastChain = samplesGetLastChain(), thin = samplesGetThin(),
- mfrow = c(3, 2), ask = NULL, ann = TRUE, ...)
+ plot = TRUE, mfrow = c(3, 2), ask = NULL, ann = TRUE, ...)
}
\arguments{
\item{node}{Character vector of length 1, name of a variable in the model.}
\item{beg, end}{Arguments to select a slice of monitored values corresponding to iterations \code{beg:end}.}
\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{plot}{Logical, whether to plot the trace or only return density estimates.
+ If \code{TRUE}, density estimates 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.
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}}.}
}
-\details{If the variable of interest is an array, slices of the array can be selected using the notation
- \code{variable[lower0:upper0, lower1:upper1, ...]}.
+\details{If the variable of interest is an array, slices of the array can be selected using the notation
+ \code{variable[lower0:upper0, lower1:upper1, ...]}.
A star \sQuote{\code{*}} can be entered as shorthand for all the stored samples.
-
+
If the arguments are left at their defaults the whole sample for all chains will be used for calculation.}
-\note{If the MCMC simulation has an adaptive phase it will not be possible to make inference using values
+\note{If the MCMC simulation has an adaptive phase it will not be possible to make inference using values
sampled before the end of this phase.}
\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: <chr...@us...> - 2010-05-17 13:20:15
|
Revision: 153
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=153&view=rev
Author: chris-jackson
Date: 2010-05-17 13:20:09 +0000 (Mon, 17 May 2010)
Log Message:
-----------
Removed modelEnableDynamic and modelDisableDynamic which implemented an OpenBUGS procedure which doesn't exist any more. Note that a "compile logicals" facility exists now, but this only works in the OpenBUGS GUI.
Removed Paths:
-------------
trunk/BRugs/R/model.dynamic.R
trunk/BRugs/man/model.dynamic.Rd
Deleted: trunk/BRugs/R/model.dynamic.R
===================================================================
--- trunk/BRugs/R/model.dynamic.R 2010-05-17 12:58:16 UTC (rev 152)
+++ trunk/BRugs/R/model.dynamic.R 2010-05-17 13:20:09 UTC (rev 153)
@@ -1,15 +0,0 @@
-"modelEnableDynamic" <-
-function()
-# Enable Dynamic Compilation
-{
- command <- "BugsEmbed.CompiledGuard; BugsEmbed.EnableDynamic"
- invisible(.CmdInterpreter(command)[[3]])
-}
-
-"modelDisableDynamic" <-
-function()
-# Disable Dynamic Compilation
-{
- command <- "BugsEmbed.CompiledGuard; BugsEmbed.DisableDynamic"
- invisible(.CmdInterpreter(command)[[3]])
-}
Deleted: trunk/BRugs/man/model.dynamic.Rd
===================================================================
--- trunk/BRugs/man/model.dynamic.Rd 2010-05-17 12:58:16 UTC (rev 152)
+++ trunk/BRugs/man/model.dynamic.Rd 2010-05-17 13:20:09 UTC (rev 153)
@@ -1,12 +0,0 @@
-\name{modelDynamic}
-\alias{modelEnableDynamic}
-\alias{modelDisableDynamic}
-\title{Controlling Dynamic Compilation}
-\description{These functions are used to enable and disable the feature for dynamic compilation.}
-\usage{
-modelEnableDynamic()
-modelDisableDynamic()
-}
-\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: <chr...@us...> - 2010-05-17 13:28:44
|
Revision: 154
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=154&view=rev
Author: chris-jackson
Date: 2010-05-17 13:28:37 +0000 (Mon, 17 May 2010)
Log Message:
-----------
New facility to show memory allocated to OpenBUGS
Added Paths:
-----------
trunk/BRugs/R/model.allocatedMemory.R
trunk/BRugs/man/model.allocatedMemory.Rd
Added: trunk/BRugs/R/model.allocatedMemory.R
===================================================================
--- trunk/BRugs/R/model.allocatedMemory.R (rev 0)
+++ trunk/BRugs/R/model.allocatedMemory.R 2010-05-17 13:28:37 UTC (rev 154)
@@ -0,0 +1,9 @@
+"modelAllocatedMemory" <-
+ function(){
+ command <- "BugsEmbed.AllocatedMemory"
+ res <- .CmdInterpreter(command)
+ buffer <- file.path(tempdir(), "buffer.txt")
+ res <- readLines(buffer)
+ mem <- as.numeric(gsub("^([0-9]+).+", "\\1", res))
+ mem
+ }
Added: trunk/BRugs/man/model.allocatedMemory.Rd
===================================================================
--- trunk/BRugs/man/model.allocatedMemory.Rd (rev 0)
+++ trunk/BRugs/man/model.allocatedMemory.Rd 2010-05-17 13:28:37 UTC (rev 154)
@@ -0,0 +1,13 @@
+\name{modelAllocatedMemory}
+\alias{modelAllocatedMemory}
+\title{Show memory usage}
+\description{Shows the amount of memory allocated to OpenBUGS}
+\usage{
+modelAllocatedMemory()
+}
+\value{
+ Amount of memory allocated to OpenBUGS, in bytes.
+}
+\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: <chr...@us...> - 2010-05-17 20:04:36
|
Revision: 158
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=158&view=rev
Author: chris-jackson
Date: 2010-05-17 20:04:29 +0000 (Mon, 17 May 2010)
Log Message:
-----------
Changed modelSet/GetSeed, currentValues, modelModules, modelAllocatedMemory to modelSet/GetRN, infoNodeValues, infoModules, infoMemory to be consistent with latest OpenBUGS GUI scripting commands. Assume these functions aren't important enough to worry about deprecating them for a while before removing them.
Added new functions infoNodeMethods, infoNodeTypes, infoUpdatersbyName, infoUpdatersbyDepth.
Modified Paths:
--------------
trunk/BRugs/NAMESPACE
trunk/BRugs/R/BRugsFit.R
trunk/BRugs/man/BRugsFit.Rd
trunk/BRugs/man/set.values.Rd
Added Paths:
-----------
trunk/BRugs/R/info.memory.R
trunk/BRugs/R/info.modules.R
trunk/BRugs/R/info.node.R
trunk/BRugs/R/info.updaters.R
trunk/BRugs/R/model.getRN.R
trunk/BRugs/R/model.setRN.R
trunk/BRugs/man/info.memory.Rd
trunk/BRugs/man/info.modules.Rd
trunk/BRugs/man/info.node.Rd
trunk/BRugs/man/info.updaters.Rd
trunk/BRugs/man/model.RN.Rd
Removed Paths:
-------------
trunk/BRugs/R/current.values.R
trunk/BRugs/R/model.allocatedMemory.R
trunk/BRugs/R/model.get.seed.R
trunk/BRugs/R/model.modules.R
trunk/BRugs/R/model.set.seed.R
trunk/BRugs/man/current.values.Rd
trunk/BRugs/man/model.allocatedMemory.Rd
trunk/BRugs/man/model.modules.Rd
trunk/BRugs/man/model.seed.Rd
Modified: trunk/BRugs/NAMESPACE
===================================================================
--- trunk/BRugs/NAMESPACE 2010-05-17 19:57:28 UTC (rev 157)
+++ trunk/BRugs/NAMESPACE 2010-05-17 20:04:29 UTC (rev 158)
@@ -1,14 +1,15 @@
useDynLib(BRugs)
importFrom(coda, mcmc, mcmc.list)
-export(BRugsFit, bugsData, bugsInits, buildMCMC, currentValues,
+export(BRugsFit, bugsData, bugsInits, buildMCMC,
dicClear, dicSet, dicStats,
getNumChains, help.BRugs, help.WinBUGS,
+infoMemory,infoModules,infoNodeValues,infoNodeMethods,infoNodeTypes,
+infoUpdatersbyName,infoUpdatersbyDepth,
modelAdaptivePhase, modelCheck, modelCompile, modelData,
-modelGenInits, modelGetSeed, modelInits, modelIteration,
-modelModules, modelNames, modelPrecision, modelSaveState,
-modelSetAP, modelSetIts, modelSetOR, modelSetSeed,
+modelGenInits, modelGetRN, modelInits, modelIteration,
+modelNames, modelPrecision, modelSaveState,
+modelSetAP, modelSetIts, modelSetOR, modelSetRN,
modelUpdate, modelEnable, modelDisable,
-modelEnableDynamic, modelDisableDynamic,
plotAutoC, plotBgr, plotDensity,
plotHistory, ranksClear, ranksSet, ranksStats,
samplesAutoC, samplesBgr, samplesClear, samplesCoda,
Modified: trunk/BRugs/R/BRugsFit.R
===================================================================
--- trunk/BRugs/R/BRugsFit.R 2010-05-17 19:57:28 UTC (rev 157)
+++ trunk/BRugs/R/BRugsFit.R 2010-05-17 20:04:29 UTC (rev 158)
@@ -25,7 +25,7 @@
data <- bugsData(data, digits = digits)
modelData(data)
modelCompile(numChains)
- if(!is.null(seed)) modelSetSeed(seed)
+ if(!is.null(seed)) modelSetRN(seed)
if(!missing(inits)){
if(is.list(inits) || is.function(inits))
inits <- bugsInits(inits = inits, numChains = numChains, digits = digits)
Deleted: trunk/BRugs/R/current.values.R
===================================================================
--- trunk/BRugs/R/current.values.R 2010-05-17 19:57:28 UTC (rev 157)
+++ trunk/BRugs/R/current.values.R 2010-05-17 20:04:29 UTC (rev 158)
@@ -1,16 +0,0 @@
-"currentValues" <-
-function(nodeLabel)
-# Get current value of node
-{
- nodeLabel <- as.character(nodeLabel)
- command <- "BugsRobjects.SetVariable"
- len <- nchar(command)
- .C("CharArray", command, as.integer(len), nodeLabel, nchar(nodeLabel), integer(1), PACKAGE="BRugs")
- command <- "BugsRobjects.GetSize"
- nodeSize <- .Integer(command)
- if(nodeSize == -1)
- stop(nodeLabel, " is not a node in BUGS model")
- command <- "BugsRobjects.GetValues"
- .C("RealArray", command, nchar(command), as.double(rep(NA, nodeSize)),
- as.integer(nodeSize), integer(1), NAOK = TRUE, PACKAGE="BRugs")[[3]]
-}
Added: trunk/BRugs/R/info.memory.R
===================================================================
--- trunk/BRugs/R/info.memory.R (rev 0)
+++ trunk/BRugs/R/info.memory.R 2010-05-17 20:04:29 UTC (rev 158)
@@ -0,0 +1,9 @@
+"infoMemory" <-
+ function(){
+ command <- "BugsEmbed.AllocatedMemory"
+ res <- .CmdInterpreter(command)
+ buffer <- file.path(tempdir(), "buffer.txt")
+ res <- readLines(buffer)
+ mem <- as.numeric(gsub("^([0-9]+).+", "\\1", res))
+ mem
+ }
Added: trunk/BRugs/R/info.modules.R
===================================================================
--- trunk/BRugs/R/info.modules.R (rev 0)
+++ trunk/BRugs/R/info.modules.R 2010-05-17 20:04:29 UTC (rev 158)
@@ -0,0 +1,13 @@
+"infoModules" <-
+ function()
+ # List loaded OpenBUGS components
+{
+ command <- "BugsEmbed.Modules"
+ .CmdInterpreter(command)
+ buffer <- file.path(tempdir(), "buffer.txt")
+ result <- read.fwf(buffer, c(50, 12, 12, 12, 12, 10), skip = 1, as.is=TRUE)
+ for(i in c(1,4,5,6))
+ result[,i] <- gsub(" ", "", result[,i])
+ names(result) <- c("Module", "Clients", "Version", "Maintainer", "Compiled", "Loaded")
+ return(result)
+}
Added: trunk/BRugs/R/info.node.R
===================================================================
--- trunk/BRugs/R/info.node.R (rev 0)
+++ trunk/BRugs/R/info.node.R 2010-05-17 20:04:29 UTC (rev 158)
@@ -0,0 +1,40 @@
+"infoNodeValues" <-
+function(nodeLabel)
+# Get current value of node
+{
+ nodeLabel <- as.character(nodeLabel)
+ command <- "BugsRobjects.SetVariable"
+ len <- nchar(command)
+ .C("CharArray", command, as.integer(len), nodeLabel, nchar(nodeLabel), integer(1), PACKAGE="BRugs")
+ command <- "BugsRobjects.GetSize"
+ nodeSize <- .Integer(command)
+ if(nodeSize == -1)
+ stop(nodeLabel, " is not a node in BUGS model")
+ command <- "BugsRobjects.GetValues"
+ .C("RealArray", command, nchar(command), as.double(rep(NA, nodeSize)),
+ as.integer(nodeSize), integer(1), NAOK = TRUE, PACKAGE="BRugs")[[3]]
+}
+
+infoNodeMethods <- function(nodeLabel)
+{
+ nodeName <- sQuote(nodeLabel)
+ command <- paste("BugsEmbed.SetNode(",nodeName,"); BugsEmbed.Methods");
+ .CmdInterpreter(command)
+ buffer <- file.path(tempdir(), "buffer.txt")
+ result <- read.fwf(buffer, c(25, 25, 25, 25), skip = 1, as.is=TRUE, col.names=c("Node","Type", "Size", "Depth"))
+ for (i in 1:2)
+ result[,i] <- gsub(" ", "", result[,i])
+ result
+}
+
+infoNodeTypes <- function(nodeLabel)
+{
+ nodeName <- sQuote(nodeLabel)
+ command <- paste("BugsEmbed.SetNode(",nodeName,"); BugsEmbed.Types");
+ .CmdInterpreter(command)
+ buffer <- file.path(tempdir(), "buffer.txt")
+ result <- read.fwf(buffer, c(25, 25), skip = 1, as.is=TRUE, col.names=c("Node","Type"))
+ for (i in 1:2)
+ result[,i] <- gsub(" ", "", result[,i])
+ result
+}
Added: trunk/BRugs/R/info.updaters.R
===================================================================
--- trunk/BRugs/R/info.updaters.R (rev 0)
+++ trunk/BRugs/R/info.updaters.R 2010-05-17 20:04:29 UTC (rev 158)
@@ -0,0 +1,28 @@
+
+## display updaters sorted by node name
+infoUpdatersbyName <- function()
+{
+ command <- "BugsEmbed.NotCompiledGuard; BugsEmbed.UpdatersByName"
+ .CmdInterpreter(command)
+ buffer <- file.path(tempdir(), "Updater types.txt")
+ result <- read.fwf(buffer, c(25, 50, 10, 10), skip = 1, as.is=TRUE,
+ row.names=1, col.names=c("Node","Type", "Size","Depth"))
+ for (i in 1:2)
+ result[,i] <- gsub(" ", "", result[,i])
+ rownames(result) <- gsub(" ", "", rownames(result))
+ result
+}
+
+## display updaters sorted by node depth in graph
+infoUpdatersbyDepth <- function()
+{
+ command <- "BugsEmbed.NotCompiledGuard; BugsEmbed.UpdatersByDepth"
+ .CmdInterpreter(command)
+ buffer <- file.path(tempdir(), "Updater types.txt")
+ result <- read.fwf(buffer, c(25, 50, 10, 10), skip = 1, as.is=TRUE,
+ row.names=1, col.names=c("Node","Type", "Size","Depth"))
+ for (i in 1:2)
+ result[,i] <- gsub(" ", "", result[,i])
+ rownames(result) <- gsub(" ", "", rownames(result))
+ result
+}
Deleted: trunk/BRugs/R/model.allocatedMemory.R
===================================================================
--- trunk/BRugs/R/model.allocatedMemory.R 2010-05-17 19:57:28 UTC (rev 157)
+++ trunk/BRugs/R/model.allocatedMemory.R 2010-05-17 20:04:29 UTC (rev 158)
@@ -1,9 +0,0 @@
-"modelAllocatedMemory" <-
- function(){
- command <- "BugsEmbed.AllocatedMemory"
- res <- .CmdInterpreter(command)
- buffer <- file.path(tempdir(), "buffer.txt")
- res <- readLines(buffer)
- mem <- as.numeric(gsub("^([0-9]+).+", "\\1", res))
- mem
- }
Deleted: trunk/BRugs/R/model.get.seed.R
===================================================================
--- trunk/BRugs/R/model.get.seed.R 2010-05-17 19:57:28 UTC (rev 157)
+++ trunk/BRugs/R/model.get.seed.R 2010-05-17 20:04:29 UTC (rev 158)
@@ -1,7 +0,0 @@
-"modelGetSeed" <-
-function()
-# Get the seed of random number generator
-{
- command <- "BugsEmbed.preSet"
- .Integer(command)
-}
Added: trunk/BRugs/R/model.getRN.R
===================================================================
--- trunk/BRugs/R/model.getRN.R (rev 0)
+++ trunk/BRugs/R/model.getRN.R 2010-05-17 20:04:29 UTC (rev 158)
@@ -0,0 +1,7 @@
+"modelGetRN" <-
+function()
+# Get the seed of random number generator
+{
+ command <- "BugsEmbed.preSet"
+ .Integer(command)
+}
Deleted: trunk/BRugs/R/model.modules.R
===================================================================
--- trunk/BRugs/R/model.modules.R 2010-05-17 19:57:28 UTC (rev 157)
+++ trunk/BRugs/R/model.modules.R 2010-05-17 20:04:29 UTC (rev 158)
@@ -1,13 +0,0 @@
-"modelModules" <-
-function()
-# List loaded OpenBUGS components
-{
- command <- "BugsEmbed.Modules"
- .CmdInterpreter(command)
- buffer <- file.path(tempdir(), "buffer.txt")
- result <- read.fwf(buffer, c(50, 12, 12, 12, 12, 10), skip = 1, as.is=TRUE)
- for(i in c(1,4,5,6))
- result[,i] <- gsub(" ", "", result[,i])
- names(result) <- c("Module", "Clients", "Version", "Maintainer", "Compiled", "Loaded")
- return(result)
-}
Deleted: trunk/BRugs/R/model.set.seed.R
===================================================================
--- trunk/BRugs/R/model.set.seed.R 2010-05-17 19:57:28 UTC (rev 157)
+++ trunk/BRugs/R/model.set.seed.R 2010-05-17 20:04:29 UTC (rev 158)
@@ -1,14 +0,0 @@
-"modelSetSeed" <-
-function(state)
-# Set the seed of random number generator
-{
- if(!state %in% 1:14)
- stop("state must be an integer from 1 to 14")
- newSeed <- as.integer(state)
- command <- paste("BugsEmbed.SetRNGuard; BugsEmbed.SetRNState(", state, ")" )
- res <- .CmdInterpreter(command)[[3]]
- if(!res){
- if(getOption("BRugsVerbose"))
- message("Random number generator state successfully set")
- }else stop("Setting random number generator state returned with an error.")
-}
Added: trunk/BRugs/R/model.setRN.R
===================================================================
--- trunk/BRugs/R/model.setRN.R (rev 0)
+++ trunk/BRugs/R/model.setRN.R 2010-05-17 20:04:29 UTC (rev 158)
@@ -0,0 +1,14 @@
+"modelSetRN" <-
+function(state)
+# Set the seed of random number generator
+{
+ if(!state %in% 1:14)
+ stop("state must be an integer from 1 to 14")
+ state <- as.integer(state)
+ command <- paste("BugsEmbed.SetRNGuard; BugsEmbed.SetRNState(", state, ")" )
+ res <- .CmdInterpreter(command)[[3]]
+ if(!res){
+ if(getOption("BRugsVerbose"))
+ message("Random number generator state successfully set")
+ }else stop("Setting random number generator state returned with an error.")
+}
Modified: trunk/BRugs/man/BRugsFit.Rd
===================================================================
--- trunk/BRugs/man/BRugsFit.Rd 2010-05-17 19:57:28 UTC (rev 157)
+++ trunk/BRugs/man/BRugsFit.Rd 2010-05-17 20:04:29 UTC (rev 158)
@@ -1,4 +1,4 @@
-\name{BRugsFit}
+\name{BRugsFit}
\alias{BRugsFit}
\title{BRugs' meta function}
\description{This function takes model, data and starting values as input and automatically runs a simulation in BRugs.}
@@ -9,13 +9,13 @@
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})
+\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.
In these cases data are written into a file \file{data.txt} into the temporary directory of the current R session.
-
+
If a filename of an existing file is given, data are read from that file.}
\item{inits}{A list with \code{numChains} elements; each element of the list is
itself a list of starting values for the OpenBUGS model, \emph{or}
@@ -33,29 +33,29 @@
If \code{TRUE}, an \code{\link[coda]{mcmc.list}} object as known from the \pkg{coda} package is returned.}
\item{DIC}{Logical, whether to calculate and return the DIC.}
\item{working.directory}{Sets working directory during execution of this function;
- \code{data}, \code{inits} and other files are written to / read from this directory if no other directory
+ \code{data}, \code{inits} and other files are written to / read from this directory if no other directory
is explicitly given in those arguments.
If \code{NULL}, the current working directory is chosen.}
\item{digits}{Number of significant digits used for OpenBUGS input, see \code{\link{formatC}}.}
-\item{seed}{Positive non-zero integer value(s) to set seed for random number
- generator - default is no seed (see \code{\link{modelSetSeed}}).}
-\item{BRugsVerbose}{Logical, whether BRugs is supposed to be verbose.
+\item{seed}{Integer value from 1 to 14 defining the state of the random number
+ generator - default is to not specify the state (see \code{\link{modelSetRN}}).}
+\item{BRugsVerbose}{Logical, whether BRugs is supposed to be verbose.
This can be controlled for the whole BRugs package by by the option \sQuote{BRugsVerbose} (see \code{\link{options}})
which is set to \code{TRUE} by default.}
}
-\value{If \code{coda} is set to \kbd{TRUE}, an \code{\link[coda]{mcmc.list}} object as known from the \pkg{coda} package is returned,
+\value{If \code{coda} is set to \kbd{TRUE}, an \code{\link[coda]{mcmc.list}} object as known from the \pkg{coda} package is returned,
otherwise a list containg components
\item{Stats}{A data frame containing sample statistics. See \code{\link{samplesStats}}.}
\item{DIC}{The DIC statistics, if \code{DIC=TRUE}, else \code{NULL}. See \code{\link{dicStats}}.}
}
-\seealso{\code{\link{BRugs}}, \code{\link{help.WinBUGS}}.
- Andrew Gelman proposes some \code{print} and \code{plot} methods that can be accessed by the
+\seealso{\code{\link{BRugs}}, \code{\link{help.WinBUGS}}.
+ Andrew Gelman proposes some \code{print} and \code{plot} methods that can be accessed by the
\code{openbugs} (and \code{bugs}) and \code{as.bugs.array} functions in the CRAN package \pkg{R2WinBUGS}.}
\examples{
-BRugsFit(data = "ratsdata.txt", inits = "ratsinits.txt",
- para = c("alpha", "beta"), modelFile = "ratsmodel.txt",
- numChains = 1,
- working.directory = system.file("OpenBUGS", "Examples",
+BRugsFit(data = "ratsdata.txt", inits = "ratsinits.txt",
+ para = c("alpha", "beta"), modelFile = "ratsmodel.txt",
+ numChains = 1,
+ working.directory = system.file("OpenBUGS", "Examples",
package = "BRugs"))
}
\keyword{interface}
Deleted: trunk/BRugs/man/current.values.Rd
===================================================================
--- trunk/BRugs/man/current.values.Rd 2010-05-17 19:57:28 UTC (rev 157)
+++ trunk/BRugs/man/current.values.Rd 2010-05-17 20:04:29 UTC (rev 158)
@@ -1,16 +0,0 @@
-\name{currentValues}
-\alias{currentValues}
-\title{Last sampled values}
-\description{This function returns the current (last sampled) values of a variable.}
-\usage{
-currentValues(nodeLabel)
-}
-\arguments{
- \item{nodeLabel}{Character vector of length 1, name of a variable in the model.}
-}
-\value{
-Vector of the current (last sampled) values of a variable.
-}
-\seealso{\code{\link{setValues}}, \code{\link{BRugs}}, \code{\link{help.WinBUGS}}}
-\keyword{interface}
-
Added: trunk/BRugs/man/info.memory.Rd
===================================================================
--- trunk/BRugs/man/info.memory.Rd (rev 0)
+++ trunk/BRugs/man/info.memory.Rd 2010-05-17 20:04:29 UTC (rev 158)
@@ -0,0 +1,12 @@
+\name{infoMemory}
+\alias{infoMemory}
+\title{Show memory usage}
+\description{Shows the amount of memory allocated to OpenBUGS}
+\usage{
+infoMemory()
+}
+\value{
+ Amount of memory allocated to OpenBUGS, in bytes.
+}
+\seealso{\code{\link{BRugs}}, \code{\link{help.WinBUGS}}}
+\keyword{interface}
Added: trunk/BRugs/man/info.modules.Rd
===================================================================
--- trunk/BRugs/man/info.modules.Rd (rev 0)
+++ trunk/BRugs/man/info.modules.Rd 2010-05-17 20:04:29 UTC (rev 158)
@@ -0,0 +1,11 @@
+\name{infoModules}
+\alias{infoModules}
+\title{Loaded modules}
+\description{Displays all the modules (dynamic link libraries) in use.}
+\usage{
+infoModules()
+}
+\value{Dataframe containing information on all the modules (dynamic link libraries) in use.}
+\seealso{\code{\link{BRugs}}, \code{\link{help.WinBUGS}}}
+\keyword{interface}
+
Added: trunk/BRugs/man/info.node.Rd
===================================================================
--- trunk/BRugs/man/info.node.Rd (rev 0)
+++ trunk/BRugs/man/info.node.Rd 2010-05-17 20:04:29 UTC (rev 158)
@@ -0,0 +1,28 @@
+\name{infoNode}
+\alias{infoNodeValues}
+\alias{infoNodeMethods}
+\alias{infoNodeTypes}
+\title{Node information}
+\description{List current values, data types and samplers corresponding to a variable.}
+\usage{
+infoNodeValues(nodeLabel)
+infoNodeMethods(nodeLabel)
+infoNodeTypes(nodeLabel)
+}
+\arguments{
+ \item{nodeLabel}{Character vector of length 1, name of a variable in the model.}
+}
+\value{
+ \code{infoNodeValues} returns a vector of the current (last sampled)
+ values of a variable.
+
+ \code{infoNodeMethods} returns a data frame listing the method used
+ internally by OpenBUGS to sample values from the full conditional
+ distribution of the node.
+
+ \code{infoNodeTypes} returns a data frame listing the OpenBUGS data
+ type which represents each node internally. For example, stochastic
+ nodes with normal priors are of type \code{GraphNormal.StdNode}.
+}
+\seealso{\code{\link{setValues}}, \code{\link{BRugs}}, \code{\link{help.WinBUGS}}}
+\keyword{interface}
Added: trunk/BRugs/man/info.updaters.Rd
===================================================================
--- trunk/BRugs/man/info.updaters.Rd (rev 0)
+++ trunk/BRugs/man/info.updaters.Rd 2010-05-17 20:04:29 UTC (rev 158)
@@ -0,0 +1,25 @@
+\name{infoUpdaters}
+\alias{infoUpdatersbyName}
+\alias{infoUpdatersbyDepth}
+\title{Information on MCMC updaters}
+\description{List the MCMC sampling algorithms in use by the current model.}
+\usage{
+infoUpdatersbyName()
+infoUpdatersbyDepth()
+}
+\value{
+ A data frame listing the MCMC updating algorithms used for each
+ stochastic node in the model.
+
+ For block updating algorithms, the first component in the block is
+ shown followed by the other components of the block in angle brackets.
+ For vector nodes, only the first element is shown.
+
+ \code{infoUpdatersbyName} sorts the nodes alphabetically.
+
+ \code{infoUpdatersbyDepth} sorts the nodes in their reverse topological
+ order in the graphical model. Nodes which are forward sampled have a
+ negative depth.
+}
+\seealso{\code{\link{infoNodeMethods}},\code{\link{BRugs}},
+\code{\link{help.WinBUGS}}} \keyword{interface}
Added: trunk/BRugs/man/model.RN.Rd
===================================================================
--- trunk/BRugs/man/model.RN.Rd (rev 0)
+++ trunk/BRugs/man/model.RN.Rd 2010-05-17 20:04:29 UTC (rev 158)
@@ -0,0 +1,23 @@
+\name{modelRN}
+\alias{modelSetRN}
+\alias{modelGetRN}
+\title{State of Random Number Generator}
+\description{These functions set/return the starting state of the random number generator.}
+\usage{
+modelSetRN(state)
+modelGetRN()
+}
+\arguments{
+ \item{state}{An integer from 1 to 14. The internal state of the OpenBUGS random number generator can be set to one of 14 predefined states. Each predefined state is \eqn{10^12}{10^12} draws apart to avoid overlap in random number sequences.}
+}
+\details{Warning: \code{modelSetRN} must not be used before
+ \code{\link{modelCompile}} has been executed successfully!
+ The state can be changed after initial values are generated
+ but before updates have been performed, however, this is not recommended.
+}
+\seealso{\code{\link{BRugs}}, \code{\link{help.WinBUGS}}}
+\keyword{interface}
+\concept{update}
+\concept{iteration}
+\concept{seed}
+\concept{random}
Deleted: trunk/BRugs/man/model.allocatedMemory.Rd
===================================================================
--- trunk/BRugs/man/model.allocatedMemory.Rd 2010-05-17 19:57:28 UTC (rev 157)
+++ trunk/BRugs/man/model.allocatedMemory.Rd 2010-05-17 20:04:29 UTC (rev 158)
@@ -1,13 +0,0 @@
-\name{modelAllocatedMemory}
-\alias{modelAllocatedMemory}
-\title{Show memory usage}
-\description{Shows the amount of memory allocated to OpenBUGS}
-\usage{
-modelAllocatedMemory()
-}
-\value{
- Amount of memory allocated to OpenBUGS, in bytes.
-}
-\seealso{\code{\link{BRugs}}, \code{\link{help.WinBUGS}}}
-\keyword{interface}
-
Deleted: trunk/BRugs/man/model.modules.Rd
===================================================================
--- trunk/BRugs/man/model.modules.Rd 2010-05-17 19:57:28 UTC (rev 157)
+++ trunk/BRugs/man/model.modules.Rd 2010-05-17 20:04:29 UTC (rev 158)
@@ -1,11 +0,0 @@
-\name{modelModules}
-\alias{modelModules}
-\title{Loaded modules}
-\description{Displays all the modules (dynamic link libraries) in use.}
-\usage{
-modelModules()
-}
-\value{Dataframe containing information on all the modules (dynamic link libraries) in use.}
-\seealso{\code{\link{BRugs}}, \code{\link{help.WinBUGS}}}
-\keyword{interface}
-
Deleted: trunk/BRugs/man/model.seed.Rd
===================================================================
--- trunk/BRugs/man/model.seed.Rd 2010-05-17 19:57:28 UTC (rev 157)
+++ trunk/BRugs/man/model.seed.Rd 2010-05-17 20:04:29 UTC (rev 158)
@@ -1,23 +0,0 @@
-\name{modelSeed}
-\alias{modelSetSeed}
-\alias{modelGetSeed}
-\title{Seed of Random Number Generator}
-\description{These functions set/return the seed of the random number generator.}
-\usage{
-modelSetSeed(state)
-modelGetSeed()
-}
-\arguments{
- \item{state}{An integer from 1 to 14. The internal state of the OpenBUGS random number generator can be set to one of 14 predefined states. Each predefined state is \eqn{10^12}{10^12} draws apart to avoid overlap in random number sequences.}
-}
-\details{Warning: \code{modelSetSeed} must not be used before
- \code{\link{modelCompile}} has been executed successfully!
- The state can be changed after initial values are generated
- but before updates have been performed, however, this is not recommended.
-}
-\seealso{\code{\link{BRugs}}, \code{\link{help.WinBUGS}}}
-\keyword{interface}
-\concept{update}
-\concept{iteration}
-\concept{seed}
-\concept{random}
Modified: trunk/BRugs/man/set.values.Rd
===================================================================
--- trunk/BRugs/man/set.values.Rd 2010-05-17 19:57:28 UTC (rev 157)
+++ trunk/BRugs/man/set.values.Rd 2010-05-17 20:04:29 UTC (rev 158)
@@ -8,13 +8,13 @@
}
\arguments{
\item{nodeLabel}{Character vector of length 1, name of a vector node in the model.}
- \item{values}{The values to be set, generated, e.g., by \code{\link{currentValues}}.}
+ \item{values}{The values to be set, generated, e.g., by \code{\link{infoNodeValues}}.}
}
\details{
-\code{\link{currentValues}} of a model can be stored in order to be used as initial values.
+Current values of a node can be stored to be used later as initial values.
}
\value{The number of values set.}
-\seealso{\code{\link{currentValues}}, \code{\link{BRugs}}, \code{\link{help.WinBUGS}}}
+\seealso{\code{\link{infoNodeValues}}, \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...> - 2011-08-24 18:53:20
|
Revision: 191
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=191&view=rev
Author: ligges
Date: 2011-08-24 18:53:11 +0000 (Wed, 24 Aug 2011)
Log Message:
-----------
back-porting BRugs from www.openbugs.info
Modified Paths:
--------------
trunk/BRugs/DESCRIPTION
trunk/BRugs/NAMESPACE
trunk/BRugs/NEWS
trunk/BRugs/R/bgr.point.R
trunk/BRugs/R/bugs.data.R
trunk/BRugs/R/bugs.inits.R
trunk/BRugs/R/dimensions.R
trunk/BRugs/R/formatdata.R
trunk/BRugs/R/get.chain.R
trunk/BRugs/R/info.node.R
trunk/BRugs/R/internal.R
trunk/BRugs/R/model.check.R
trunk/BRugs/R/model.compile.R
trunk/BRugs/R/model.inits.R
trunk/BRugs/R/model.names.R
trunk/BRugs/R/model.precision.R
trunk/BRugs/R/model.setRN.R
trunk/BRugs/R/plot.bgr.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.monitors.R
trunk/BRugs/R/samples.sample.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/unix/help.R
trunk/BRugs/R/windows/help.R
trunk/BRugs/R/zzz.R
trunk/BRugs/configure
trunk/BRugs/man/BRugs.Rd
trunk/BRugs/man/BRugsFit.Rd
trunk/BRugs/man/bgr.point.Rd
trunk/BRugs/man/bugs.data.Rd
trunk/BRugs/man/bugs.inits.Rd
trunk/BRugs/man/model.RN.Rd
trunk/BRugs/man/set.values.Rd
trunk/BRugs/tests/BRugs.R
trunk/BRugs/tests/BRugs.Rout.save
trunk/BRugs/tests/examples.R
trunk/BRugs/tests/functions.R
Added Paths:
-----------
trunk/BRugs/R/unix/internal.R
trunk/BRugs/R/unix/zzz.R
trunk/BRugs/R/unix/zzz.R.in
trunk/BRugs/R/windows/internal.R
trunk/BRugs/R/windows/zzz.R
trunk/BRugs/configure.ac
trunk/BRugs/man/unix/
trunk/BRugs/man/unix/loadOpenBUGS.Rd
trunk/BRugs/man/windows/
trunk/BRugs/man/windows/loadOpenBUGS.Rd
trunk/BRugs/src/BugsHelper.c
trunk/BRugs/src/Makefile.win
trunk/BRugs/src/Makevars.in
trunk/BRugs/tests/examples.Rout.save
trunk/BRugs/tests/functions.Rout.save
trunk/BRugs/tests/local.R
trunk/BRugs/tests/test.sh
Removed Paths:
-------------
trunk/BRugs/.Rbuildignore
trunk/BRugs/R/model.getRN.R
trunk/BRugs/inst/OpenBUGS/
trunk/BRugs/inst/README-inst_OpenBUGS
trunk/BRugs/src/Makevars
trunk/BRugs/src/Makevars.win
Deleted: trunk/BRugs/.Rbuildignore
===================================================================
--- trunk/BRugs/.Rbuildignore 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/.Rbuildignore 2011-08-24 18:53:11 UTC (rev 191)
@@ -1 +0,0 @@
-inst/README-inst_OpenBUGS
Modified: trunk/BRugs/DESCRIPTION
===================================================================
--- trunk/BRugs/DESCRIPTION 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/DESCRIPTION 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,12 +1,12 @@
Package: BRugs
-Title: OpenBUGS and its R / S-PLUS interface BRugs
-Version: 0.6-0
-Date: 2010-04-30
-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. With considerable contributions by Gregor Gorjanc <gre...@bf...>.
-Description: An R / S-PLUS package containing OpenBUGS and its R / S-PLUS interface BRugs.
+Title: R interface to the OpenBUGS MCMC software
+Version: 0.7-2
+Date: 2011-08-24
+Author: OpenBUGS was developed by Andrew Thomas, Dave Lunn, David Spiegelhalter and Nicky Best. R interface developed by Uwe Ligges, Sibylle Sturtz, Andrew Gelman, Gregor Gorjanc and Chris Jackson. Linux port and most recent developments by Chris Jackson.
+Description: Fully-interactive R interface to the OpenBUGS software for Bayesian analysis using MCMC sampling
Maintainer: Uwe Ligges <li...@st...>
-Depends: R (>= 2.5.0), coda
+Depends: R (>= 2.5.0), utils, coda
+SystemRequirements: OpenBUGS (>= 3.2.1)
Archs: i386
-OS_type: windows
License: GPL-2
URL: http://www.openbugs.info/
Modified: trunk/BRugs/NAMESPACE
===================================================================
--- trunk/BRugs/NAMESPACE 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/NAMESPACE 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,12 +1,12 @@
-useDynLib(BRugs)
importFrom(coda, mcmc, mcmc.list)
export(BRugsFit, bugsData, bugsInits, buildMCMC,
dicClear, dicSet, dicStats,
getNumChains, help.BRugs, help.WinBUGS,
infoMemory,infoModules,infoNodeValues,infoNodeMethods,infoNodeTypes,
infoUpdatersbyName,infoUpdatersbyDepth,
+loadOpenBUGS,
modelAdaptivePhase, modelCheck, modelCompile, modelData,
-modelGenInits, modelGetRN, modelInits, modelIteration,
+modelGenInits, modelInits, modelIteration,
modelNames, modelPrecision, modelSaveState,
modelSetAP, modelSetIts, modelSetOR, modelSetRN,
modelUpdate, modelEnable, modelDisable,
Modified: trunk/BRugs/NEWS
===================================================================
--- trunk/BRugs/NEWS 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/NEWS 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,10 +1,140 @@
Changes to BRugs:
=====================
+Version 0.7.2 (24 August 2011)
+-------------
+Backport to the original BRugs package
-Update 0.6-0
-- Switch to new OpenBUGS (currently 3.1.0)
-- 32-bit versions only
+Version 0.7.1 (19 April 2011)
+-------------
+
+The configure script on Linux now automatically detects OpenBUGS
+installed by the RPM and DEB packages (to standards-compliant
+locations) as well as OpenBUGS installed by the source package.
+
+Bug fix - bugsData should accept data as a list of variable names.
+Thanks to Brian Ripley for these reports.
+
+handleRes() now explicitly labels internal OpenBUGS traps as bugs and
+asks the user to send a bug report to the package maintainer.
+
+On Windows, if OpenBUGS installation is not detected in the registry,
+package loading continues with a warning instead of stopping with an
+error. If OpenBUGS was actually installed, the user can then load it
+from a specified directory with loadOpenBUGS(dir).
+
+
+Version 0.7 (March 2011)
+-----------
+
+BRugs now works with an existing installation of OpenBUGS (3.2.1 or
+later) instead of being distributed with the OpenBUGS library.
+
+On Windows, the OpenBUGS location is determined by a registry key
+which is installed by the OpenBUGS for Windows installation program.
+
+On Linux, the OpenBUGS shared library and documentation are assumed to
+be installed together in a library directory. Using the new OpenBUGS
+for Linux source package OpenBUGS-3.2.1.tar.gz or later, this library
+directory is by default
+
+/usr/local/lib/OpenBUGS
+
+In most cases it should be detected automatically when installing, but
+it can be changed by running, for instance
+
+R CMD INSTALL --configure-args='--with-openbugs=/usr/lib/OpenBUGS'
+
+
+
+Version 0.61
+------------
+Fix for crash in bugsData
+
+
+Version 0.6
+-----------
+
+Forked from the version of BRugs (0.5.3) available on CRAN Extras.
+This new version supports Linux for the first time, as detailed below.
+
+
+CHANGES MADE FOR LINUX PORT OF BRugs
+
+* A C program called BugsHelper is used to call the OpenBUGS shared
+ library on Linux via a system() call. With one call of BugsHelper,
+ any number of different OpenBUGS API commands can be run. The state
+ of the model is "internalized" on entry from a file in the temporary
+ directory, and "externalized" on exit. The source is in src/ and
+ the binary is installed into exec/.
+
+* New function .OpenBUGS() to execute a sequence of OpenBUGS API
+ commands of possibly differing types (e.g. CmdInterpreter,
+ RealArray, Integer) with given arguments. On Windows, this is a
+ wrapper for the old method of calling C functions from the
+ dyn.load()-ed library. On Linux, this calls BugsHelper once. The
+ old .CmdInterpreter and related functions still have the same
+ interfaces, but work by calling .OpenBUGS().
+
+* Input and output from the OpenBUGS API on Linux is performed through
+ files input1.txt, output1.txt, input2.txt, output2.txt, ... in the
+ same /tmp/R*** directory as the buffer.txt file. The buffer.txt
+ file is used as before for messages from OpenBUGS.
+
+* A set of global variables is stored in the options() list containing
+ the begin and end iterations, first and last chains, thin interval
+ and precision to calculate sample statistics. This is required
+ because the OpenBUGS Internalize / Externalize facility used by
+ BugsHelper does not save these variables, which are normally stored
+ in the OpenBUGS internal module SamplesEmbed. They are not saved
+ because OpenBUGS considers them to be part of the GUI state
+ (equivalent to the values typed in Inference->Samples...) rather
+ than the model state. These variables are reset when a new model is
+ checked and compiled.
+
+* As a result, all functions which compute sample statistics must
+ first call an API command which is returned by
+ .SamplesGlobalsCmd(node). This command updates the values stored in
+ SamplesEmbed using the values stored in options(). This ensures
+ that OpenBUGS knows about them before calculating sample statistics.
+ (Note this is still done on Windows where it is not necessary, but
+ there should be negligible overhead). The directly affected
+ functions are samplesCoda(), samplesSize(), samplesSample(),
+ samplesStats(), samplesCorrel(), plotBgr().
+
+* .onLoad() in zzz.R initialises these global variables on Linux and
+ Windows.
+
+* The corresponding set/get functions are changed to read and write
+ these global variables instead of updating the values in
+ SamplesEmbed.
+
+* plotBGR() modified to use a single .OpenBUGS() call to return a list
+ of samples for each required iteration on the grid. bgrPoint()
+ takes a sample instead of a node and iteration. Using one
+ .OpenBUGS() call for each sample would be an order of magnitude
+ slower using the Linux helper program. Assume the extra memory
+ overhead, compared to the old method, is not a problem on Windows.
+
+* infoNodeValues() and SetValues() now read and write the values from
+ multiple chains, and work on scalars as well as vectors.
+
+* modelNames() modified to use a single .OpenBUGS call instead of
+ looping API commands over names in the model.
+
+* useDynLib(BRugs) removed from NAMESPACE. This is done in .OnLoad()
+ instead, to ensure that it is only used on Windows.
+
+* modelGetRN() removed, as the initial random number preset is not
+ saved by the Externalize facility. The random number state however
+ is saved and restored properly during the model run. There is no
+ need for the initial preset to be read by the user, as it does not
+ change as the model runs.
+
+* samplesCorrel() wasn't setting begin/end/thin etc. properly, since
+ the CorrelEmbed module doesn't use the values in SamplesEmbed.
+ These are now read from the variables in options().
+
Update 0.5-3
- fix writeModel() again by going through parse tree now
- fix buildMCMC() to report right thinning parameters and keep all samples
Modified: trunk/BRugs/R/bgr.point.R
===================================================================
--- trunk/BRugs/R/bgr.point.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/bgr.point.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,14 +1,9 @@
"bgrPoint" <-
-function(node, iteration)
-# Calculate the bgr statistic at iteration
+function(sample)
+# Calculate the bgr statistic given a sample concatenated over chains
{
- oldEnd <- samplesGetEnd()
- on.exit(samplesSetEnd(oldEnd))
- samplesSetEnd(as.integer(iteration))
numChains <- getNumChains()
- sampleSize <- samplesSize(node)
- command <- "SamplesEmbed.SampleValues"
- sample <- samplesSample(node)
+ sampleSize <- length(sample)
lenChain <- sampleSize %/% numChains
if (is.R())
dq <- quantile(sample, c(0.1, 0.9), names = FALSE)
@@ -25,5 +20,5 @@
}
n.delta <- n.delta / numChains
bgr.stat <- d.delta / n.delta
- return(c(iteration, n.delta, d.delta, bgr.stat))
+ return(c(n.delta, d.delta, bgr.stat))
}
Modified: trunk/BRugs/R/bugs.data.R
===================================================================
--- trunk/BRugs/R/bugs.data.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/bugs.data.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,26 +1,29 @@
"bugsData" <-
-function(data, fileName = file.path(tempdir(), "data.txt"), digits = 5){
- if(is.numeric(unlist(data)))
- if(is.R()) {
- write.datafile(lapply(data, formatC, digits = digits, format = "E"), fileName)
+ function(data, fileName = file.path(tempdir(), "data.txt"), format="E", digits = 5){
+ if (is.character(unlist(data))) {
+ 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 = format), fileName)
+ }
+ else {
+ data.list <- lapply(as.list(data), get, where = parent.frame(2))
+ names(data.list) <- unlist(data)
+ writeDatafileS4(data.list, towhere = "data.txt")
+ }
}
- else {
- writeDatafileS4(data, towhere = "data.txt")
+ else if(is.list(data)) {
+ data <- lapply(data, function(x){x <- if(is.character(x)||is.factor(x)) match(x, unique(x)) else x})
+ if(is.R()) {
+ write.datafile(lapply(data, formatC, digits = digits, format = format), fileName)
+ }
+ else {
+ writeDatafileS4(data, towhere = "data.txt")
+ }
}
- else {
- 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")
- }
+ else stop("Expected a list of data, a list or vector of variable names")
+ invisible(fileName)
}
- invisible(fileName)
-}
if(is.R()){
Modified: trunk/BRugs/R/bugs.inits.R
===================================================================
--- trunk/BRugs/R/bugs.inits.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/bugs.inits.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,5 +1,5 @@
"bugsInits" <-
-function (inits, numChains = 1, fileName, digits = 5){
+function (inits, numChains = 1, fileName, format="E", digits = 5){
if(missing(fileName))
fileName <- file.path(tempdir(), paste("inits", 1:numChains, ".txt", sep = ""))
if(length(fileName) != numChains)
@@ -8,12 +8,12 @@
for (i in 1:numChains){
if (is.function(inits))
if (is.R())
- write.datafile(lapply(inits(), formatC, digits = digits, format = "E"), fileName[i])
+ write.datafile(lapply(inits(), formatC, digits = digits, format = format), fileName[i])
else
writeDatafileS4(inits(), towhere = fileName[i])
else
if (is.R())
- write.datafile(lapply(inits[[i]], formatC, digits = digits, format = "E"), fileName[i])
+ write.datafile(lapply(inits[[i]], formatC, digits = digits, format = format), fileName[i])
else
writeDatafileS4(inits[[i]], towhere = fileName[i])
}
Modified: trunk/BRugs/R/dimensions.R
===================================================================
--- trunk/BRugs/R/dimensions.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/dimensions.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -5,9 +5,8 @@
nodeLabel <- as.character(node)
if(!(nodeLabel %in% modelNames()))
stop("node must be a variable name from the model")
- command <- "BugsRobjects.SetVariable"
- .C("CharArray", command, nchar(command), nodeLabel, nchar(nodeLabel), integer(1), PACKAGE="BRugs")
- command <- "BugsRobjects.GetNumDimensions"
- dimensions <- .Integer(command)
- return(dimensions)
+ dimensions <- .OpenBUGS(c("BugsRobjects.SetVariable", "BugsRobjects.GetNumDimensions"),
+ c("CharArray", "Integer"),
+ list(nodeLabel, NA))[[2]]
+ dimensions
}
Modified: trunk/BRugs/R/formatdata.R
===================================================================
--- trunk/BRugs/R/formatdata.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/formatdata.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,28 +1,31 @@
"formatdata" <-
function (datalist){
- if (!is.list(datalist) || is.data.frame(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")
datanames <- names(datalist)
for (i in 1:n) {
- datalist.string[[i]] <-
- switch(as.character(dimensions(datanames[i])),
- "0" = paste(names(datalist)[i],
- "=", as.character(datalist[[i]]), sep = ""),
- "1" = paste(names(datalist)[i],
- "=c(", paste(as.character(datalist[[i]]), collapse = ", "),
- ")", sep = ""),
- 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 = "")
- )
+ if (is.factor(datalist[[i]]))
+ datalist[[i]] <- as.integer(datalist[[i]])
+ datalist.string[[i]] <-
+ if (length(datalist[[i]]) == 1)
+ paste(names(datalist)[i],
+ "=", as.character(datalist[[i]]), sep = "")
+ else if (is.vector(datalist[[i]]) && length(datalist[[i]]) > 1)
+ paste(names(datalist)[i],
+ "=c(", paste(as.character(datalist[[i]]), collapse = ", "),
+ ")", sep = "")
+ else
+ 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 = ", "),
+ datalist.tofile <- paste("list(",
+ paste(unlist(datalist.string), collapse = ", "),
")", sep = "")
return(datalist.tofile)
}
Modified: trunk/BRugs/R/get.chain.R
===================================================================
--- trunk/BRugs/R/get.chain.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/get.chain.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -2,6 +2,5 @@
function()
# Get chain field
{
- command<- "BugsEmbed.chain"
- .Integer(command)
+ getOption("BRugsNextChain")
}
Modified: trunk/BRugs/R/info.node.R
===================================================================
--- trunk/BRugs/R/info.node.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/info.node.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -3,16 +3,18 @@
# Get current value of node
{
nodeLabel <- as.character(nodeLabel)
- command <- "BugsRobjects.SetVariable"
- len <- nchar(command)
- .C("CharArray", command, as.integer(len), nodeLabel, nchar(nodeLabel), integer(1), PACKAGE="BRugs")
- command <- "BugsRobjects.GetSize"
- nodeSize <- .Integer(command)
+ out <- .OpenBUGS(c("BugsRobjects.SetVariable", "BugsRobjects.GetSize"),
+ c("CharArray","Integer"),
+ list(nodeLabel, NA))
+ nodeSize <- out[[2]]
if(nodeSize == -1)
stop(nodeLabel, " is not a node in BUGS model")
- command <- "BugsRobjects.GetValues"
- .C("RealArray", command, nchar(command), as.double(rep(NA, nodeSize)),
- as.integer(nodeSize), integer(1), NAOK = TRUE, PACKAGE="BRugs")[[3]]
+ numChains <- getNumChains()
+ out <- .OpenBUGS(c("BugsRobjects.SetVariable", "BugsRobjects.GetValues"),
+ c("CharArray","RealArray"),
+ list(nodeLabel, double(nodeSize*numChains)))
+ values <- matrix(out[[2]], nrow=nodeSize, ncol=numChains)
+ values
}
infoNodeMethods <- function(nodeLabel)
Modified: trunk/BRugs/R/internal.R
===================================================================
--- trunk/BRugs/R/internal.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/internal.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,22 +1,58 @@
+### Functions to run a single OpenBUGS API command string
+
.CmdInterpreter <- function(command)
-{
- command <- as.character(command)
- res <- .C("CmdInterpreter", command, nchar(command), integer(1), PACKAGE = "BRugs")
- handleRes(res[[3]])
- return(res)
+{
+ unlist(.OpenBUGS(command, "CmdInterpreter"))
}
.Integer <- function(command)
{
- values <- .C("Integer", command, nchar(command), integer(1), integer(1), PACKAGE = "BRugs")
- handleRes(values[[4]])
- as.integer(values[[3]])
+ unlist(.OpenBUGS(command, "Integer"))
}
+.CharArray <- function(command, arg)
+{
+ unlist(.OpenBUGS(command, "CharArray", arg))
+}
+
+.RealArray <- function(command, arg)
+{
+ unlist(.OpenBUGS(command, "RealArray", arg))
+}
+
+
+.OpenBUGS.cmdtypes <- c("CmdInterpreter","Integer","CharArray","RealArray")
+
+.OpenBUGS <- function(cmds, cmdtypes=NULL, args=NULL) {
+ ncmds <- length(cmds)
+ if (is.null(cmdtypes)) cmdtypes <- rep("CmdInterpreter", ncmds)
+ if (is.null(args)) args <- as.list(rep(NA, ncmds))
+ stopifnot(ncmds==length(cmdtypes))
+ stopifnot(ncmds==length(args))
+ .OpenBUGS.platform(cmds, cmdtypes, args)
+}
+
handleRes <- function(res)
{
- switch(res,
- stop("An OpenBUGS module or procedure was called that did not exist."),
- stop("An OpenBUGS procedure was called with the wrong type of argument."),
- stop("An OpenBUGS procedure was called with the wrong signature."))
+ maintainer <- utils:::packageDescription("BRugs", fields="Maintainer")
+ switch(res,
+ stop("An OpenBUGS module or procedure was called that did not exist. Please report this bug to ", maintainer),
+ stop("An OpenBUGS procedure was called with the wrong type of argument. Please report this bug to ", maintainer),
+ stop("An OpenBUGS procedure was called with the wrong signature. Please report this bug to ", maintainer)
+ )
}
+
+.SamplesGlobalsCmd <- function(node){
+ options.old <- options()
+ options(scipen=20) # don't pass numbers in scientific notation to OpenBUGS
+ commands <- c(paste("SamplesEmbed.beg :=", getOption("BRugsSamplesBeg")),
+ paste("SamplesEmbed.end :=", getOption("BRugsSamplesEnd")),
+ paste("SamplesEmbed.firstChain :=", getOption("BRugsSamplesFirstChain")),
+ paste("SamplesEmbed.lastChain :=", getOption("BRugsSamplesLastChain")),
+ paste("SamplesEmbed.thin :=", getOption("BRugsSamplesThin")),
+ paste("SamplesEmbed.SetVariable(", shQuote(node), ")", sep=""),
+ paste("BugsMappers.SetPrec(", getOption("BRugsPrec"), ")", sep="")
+ )
+ options(options.old)
+ paste(commands, collapse="; ")
+}
Modified: trunk/BRugs/R/model.check.R
===================================================================
--- trunk/BRugs/R/model.check.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/model.check.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -16,6 +16,7 @@
command <- gsub ("//", "/", command)
}
.CmdInterpreter(command)
+ .initGlobals()
if(getOption("BRugsVerbose"))
buffer()
}
Modified: trunk/BRugs/R/model.compile.R
===================================================================
--- trunk/BRugs/R/model.compile.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/model.compile.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -10,6 +10,7 @@
.CmdInterpreter(command)
samplesSetFirstChain(1)
samplesSetLastChain(numChains)
+ options("BRugsNextChain" = 1)
if(getOption("BRugsVerbose"))
buffer()
}
Deleted: trunk/BRugs/R/model.getRN.R
===================================================================
--- trunk/BRugs/R/model.getRN.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/model.getRN.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,7 +0,0 @@
-"modelGetRN" <-
-function()
-# Get the seed of random number generator
-{
- command <- "BugsEmbed.preSet"
- .Integer(command)
-}
Modified: trunk/BRugs/R/model.inits.R
===================================================================
--- trunk/BRugs/R/model.inits.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/model.inits.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -28,9 +28,10 @@
}
.CmdInterpreter(command)
if(getOption("BRugsVerbose")){
- cat("Initializing chain ", chainNum[i], ": ", sep="")
+ message("Initializing chain ", chainNum[i], ": ", sep="")
buffer()
}
+ options("BRugsNextChain" = chainNum[i] + 1)
}
invisible()
}
Modified: trunk/BRugs/R/model.names.R
===================================================================
--- trunk/BRugs/R/model.names.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/model.names.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -6,15 +6,29 @@
number <- .Integer(command)
name <- character(number)
if(length(number)){
- for(i in 1:number){
- command <- paste("BugsRobjects.SetIndex(", i-1, ")", sep="")
- .CmdInterpreter(command)
- command <- "BugsRobjects.GetStringLength"
- numchar <- .Integer(command)
- command <- "BugsRobjects.GetVariable"
- char <- paste(rep(" ", numchar), collapse="")
- name[i] <- .C("CharArray", command, nchar(command), char, numchar, integer(1), PACKAGE="BRugs")[[3]]
- }
+ cmds <- character(0)
+ cmdtype <- character()
+ for(i in 1:number){
+ cmds <- c(cmds, paste("BugsRobjects.SetIndex(", i-1, ")", sep=""),
+ "BugsRobjects.GetStringLength")
+ cmdtype <- c(cmdtype, c("CmdInterpreter","Integer"))
+ }
+ res <- .OpenBUGS(cmds, cmdtype)
+ numchar <- unlist(res[seq(2, 2*number, by=2)])
+
+ cmds <- character(0)
+ cmdtype <- character()
+ args <- list()
+ for(i in 1:number){
+ char <- paste(rep(" ", numchar[i]), collapse="")
+ cmds <- c(cmds,
+ paste("BugsRobjects.SetIndex(", i-1, ")", sep=""),
+ "BugsRobjects.GetVariable")
+ cmdtype <- c(cmdtype, c("CmdInterpreter","CharArray"))
+ args <- c(args, list(NA, char))
+ }
+ res <- .OpenBUGS(cmds, cmdtype, args)
+ name <- unlist(res[seq(2, 2*number, by=2)])
}
return(name)
-}
+ }
Modified: trunk/BRugs/R/model.precision.R
===================================================================
--- trunk/BRugs/R/model.precision.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/model.precision.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -5,6 +5,7 @@
if(!is.numeric(prec))
stop("prec ", "must be numeric")
prec <- as.integer(prec)
- command <- paste("BugsMappers.SetPrec(", prec, ")")
- invisible(.CmdInterpreter(command))
+ options(BRugsPrec=prec)
+# command <- paste("BugsMappers.SetPrec(", prec, ")")
+# invisible(.CmdInterpreter(command))
}
Modified: trunk/BRugs/R/model.setRN.R
===================================================================
--- trunk/BRugs/R/model.setRN.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/model.setRN.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -6,9 +6,5 @@
stop("state must be an integer from 1 to 14")
state <- as.integer(state)
command <- paste("BugsEmbed.SetRNGuard; BugsEmbed.SetRNState(", state, ")" )
- res <- .CmdInterpreter(command)[[3]]
- if(!res){
- if(getOption("BRugsVerbose"))
- message("Random number generator state successfully set")
- }else stop("Setting random number generator state returned with an error.")
+ invisible(.CmdInterpreter(command))
}
Modified: trunk/BRugs/R/plot.bgr.R
===================================================================
--- trunk/BRugs/R/plot.bgr.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/plot.bgr.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,13 +1,42 @@
+### Plot bgr diagnostic for single component of OpenBUGS name
"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
+ function(node, plot = TRUE, main = NULL, xlab = "iteration", ylab = "bgr",
+ col = c("red", "blue", "green"), bins = 50, ...)
{
sM <- samplesMonitors(node)
if(length(sM) > 1 || sM != node)
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)
+
+ ## Use a single API call instead of looping API calls over
+ ## iterations - more efficient with the Linux helper.
+
+ ## find size of available sample at each grid point
+ res <- .OpenBUGS(cmds = c(.SamplesGlobalsCmd(node),
+ as.vector(rbind(paste("SamplesEmbed.end := ", grid, ";"), "SamplesEmbed.SampleSize;"))),
+ cmdtypes = c("CmdInterpreter", rep(c("CmdInterpreter","Integer"), bins)),
+ args=as.list(c(NA, rep(c(NA, NA), bins)))
+ )
+
+ args <- list(NA)
+ for (i in seq(length=bins)){
+ args[[2*i]] <- NA
+ args[[2*i + 1]] <- double(res[[2*i + 1]])
+ }
+
+ ## get available sample at each grid point
+ res <- .OpenBUGS(cmds =
+ c(.SamplesGlobalsCmd(node),
+ as.vector(rbind(paste("SamplesEmbed.end := ", grid, ";"), "SamplesEmbed.SampleValues;"))),
+ cmdtypes = c("CmdInterpreter", rep(c("CmdInterpreter","RealArray"), bins)),
+ args=args)
+
+ ## remove junk elements of list, leaving a list of samples for each grid point
+ res[c(1, 2*seq(length=bins))] <- NULL
+
+ ## calculate between, within and ratio statistics for each grid point
+ bgr <- rbind(grid, sapply(res, bgrPoint))
+
yRange <- range(bgr[4,])
yRange <- c(0, max(c(1.2, yRange[2])))
nRange <- range(bgr[2,])
@@ -21,7 +50,7 @@
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], ...)
+ 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], ...)
}
@@ -30,4 +59,5 @@
bgr$Iteration <- as.integer(bgr$Iteration)
if(plot) invisible(bgr)
else return(bgr)
+
}
Modified: trunk/BRugs/R/samples.coda.R
===================================================================
--- trunk/BRugs/R/samples.coda.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.coda.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -29,9 +29,8 @@
samplesSetLastChain(lastChain)
thin <- max(c(thin, 1))
samplesSetThin(thin)
- command <- paste("SamplesEmbed.SetVariable(", sQuote(node),
- ");SamplesEmbed.StatsGuard;", "SamplesEmbed.CODA(",
- sQuote(stem), ")")
+ command <- paste(.SamplesGlobalsCmd(node), ";SamplesEmbed.StatsGuard;",
+ "SamplesEmbed.CODA(", sQuote(stem), ")")
.CmdInterpreter(command)
buffer()
}
Modified: trunk/BRugs/R/samples.correl.R
===================================================================
--- trunk/BRugs/R/samples.correl.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.correl.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -22,10 +22,16 @@
samplesSetLastChain(lastChain)
thin <- max(c(thin, 1))
samplesSetThin(thin)
-
- command <- paste("CorrelEmbed.SetVariable0(", sQuote(node0),
- ");CorrelEmbed.SetVariable1(", sQuote(node1),
- ");CorrelEmbed.Guard", ";CorrelEmbed.PrintMatrix")
+
+ command <- paste("CorrelEmbed.beg :=", getOption("BRugsSamplesBeg"),
+ "; CorrelEmbed.end :=", getOption("BRugsSamplesEnd"),
+ "; CorrelEmbed.firstChain :=", getOption("BRugsSamplesFirstChain"),
+ "; CorrelEmbed.lastChain :=", getOption("BRugsSamplesLastChain"),
+ "; CorrelEmbed.thin :=", getOption("BRugsSamplesThin"),
+ "; CorrelEmbed.SetVariable0(", sQuote(node0),
+ ");CorrelEmbed.SetVariable1(", sQuote(node1),
+ ");CorrelEmbed.Guard", ";CorrelEmbed.PrintMatrix"
+ )
.CmdInterpreter(command)
buffer <- file.path(tempdir(), "buffer.txt")
rlb <- readLines(buffer)
Modified: trunk/BRugs/R/samples.density.R
===================================================================
--- trunk/BRugs/R/samples.density.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.density.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -31,10 +31,12 @@
thin <- max(c(thin, 1))
samplesSetThin(thin)
mons <- samplesMonitors(node)
- if (is.R())
- par(mfrow = mfrow, ask = ask, ann = ann)
- else
- par(mfrow = mfrow, ask = ask)
+ if (plot) {
+ if (is.R())
+ par(mfrow = mfrow, ask = ask, ann = ann)
+ else
+ par(mfrow = mfrow, ask = ask)
+ }
result <- sapply(mons, plotDensity, plot=plot, ...)
if (!is.R())
invisible()
Modified: trunk/BRugs/R/samples.get.beg.R
===================================================================
--- trunk/BRugs/R/samples.get.beg.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.get.beg.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,7 +1,6 @@
"samplesGetBeg" <-
function()
-# Get the beg field
+# Beginning iteration from which to compute sample statistics
{
- command <- "SamplesEmbed.beg"
- .Integer(command)
+ getOption("BRugsSamplesBeg")
}
Modified: trunk/BRugs/R/samples.get.end.R
===================================================================
--- trunk/BRugs/R/samples.get.end.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.get.end.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,7 +1,6 @@
"samplesGetEnd" <-
function()
-# Get the end field
+# End iteration from which to compute sample statistics
{
- command <- "SamplesEmbed.end"
- .Integer(command)
+ getOption("BRugsSamplesEnd")
}
Modified: trunk/BRugs/R/samples.get.firstChain.R
===================================================================
--- trunk/BRugs/R/samples.get.firstChain.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.get.firstChain.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,7 +1,6 @@
"samplesGetFirstChain" <-
function()
-# Get the firstChain field
+# First chain from which to compute sample statistics
{
- command <- "SamplesEmbed.firstChain"
- .Integer(command)
+ getOption("BRugsSamplesFirstChain")
}
Modified: trunk/BRugs/R/samples.get.lastChain.R
===================================================================
--- trunk/BRugs/R/samples.get.lastChain.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.get.lastChain.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,7 +1,6 @@
"samplesGetLastChain" <-
function()
-# Get the lastChain field
+# Last chain from which to compute sample statistics
{
- command <- "SamplesEmbed.lastChain"
- .Integer(command)
+ getOption("BRugsSamplesLastChain")
}
Modified: trunk/BRugs/R/samples.get.thin.R
===================================================================
--- trunk/BRugs/R/samples.get.thin.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.get.thin.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,7 +1,6 @@
"samplesGetThin" <-
function()
-# Get the thin field
+# Thinning interval to apply to sample statistics
{
- command <- "SamplesEmbed.thin"
- .Integer(command)
+ getOption("BRugsSamplesThin")
}
Modified: trunk/BRugs/R/samples.monitors.R
===================================================================
--- trunk/BRugs/R/samples.monitors.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.monitors.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -4,7 +4,7 @@
{
if (is.R()){
command <- paste("SamplesEmbed.SetVariable(", sQuote(node),
- ");SamplesEmbed.StatsGuard;SamplesEmbed.Labels")
+ ");SamplesEmbed.StatsGuard;SamplesEmbed.Labels",sep="")
.CmdInterpreter(command)
buffer <- file.path(tempdir(), "buffer.txt")
rlb <- readLines(buffer)
@@ -23,7 +23,7 @@
} else {
sampsMonsSingle <- function(node){
command <- paste("SamplesEmbed.SetVariable(", sQuote(node),
- ");SamplesEmbed.StatsGuard;SamplesEmbed.Labels")
+ ");SamplesEmbed.StatsGuard;SamplesEmbed.Labels",sep="")
.CmdInterpreter(command)
buffer <- file.path(tempdir(), "buffer.txt")
rlb <- readLines(buffer)
Modified: trunk/BRugs/R/samples.sample.R
===================================================================
--- trunk/BRugs/R/samples.sample.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.sample.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -9,16 +9,14 @@
sM <- samplesMonitors(node)[1]
if(sM == "model must be initialized before monitors used")
stop("model must be initialized / updated / monitored before samplesSample is used")
-
- command <- "BugsRobjects.SetVariable"
- .C("CharArray", command, nchar(command), node, nchar(node), integer(1), PACKAGE="BRugs")
- command <- "BugsRobjects.GetSize"
- nodeSize <- .Integer(command)
- if(nodeSize > 1)
+ nodeSize <- .OpenBUGS(c("BugsRobjects.SetVariable", "BugsRobjects.GetSize"),
+ c("CharArray","Integer"),
+ list(node,NA))[[2]]
+ if(nodeSize > 1)
stop("Only scalar nodes such as ", node, "[1] are allowed.")
-
sampleSize <- samplesSize(node)
- command <- "SamplesEmbed.SampleValues"
- .C("RealArray", command, nchar(command),
- double(sampleSize), sampleSize, integer(1), PACKAGE="BRugs")[[3]]
+ sample <- .OpenBUGS(c(.SamplesGlobalsCmd(node), "SamplesEmbed.SampleValues"),
+ c("CmdInterpreter","RealArray"),
+ list(node,double(sampleSize)))[[2]]
+ sample
}
Modified: trunk/BRugs/R/samples.set.beg.R
===================================================================
--- trunk/BRugs/R/samples.set.beg.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.set.beg.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -5,6 +5,5 @@
if(!is.numeric(begIt))
stop("begIt ", "must be numeric")
begIt <- as.integer(begIt)
- command <- paste("SamplesEmbed.beg :=", begIt)
- invisible(.CmdInterpreter(command))
+ options("BRugsSamplesBeg" = begIt)
}
Modified: trunk/BRugs/R/samples.set.end.R
===================================================================
--- trunk/BRugs/R/samples.set.end.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.set.end.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -5,6 +5,5 @@
if(!is.numeric(endIt))
stop("endIt ", "must be numeric")
endIt <- as.integer(endIt)
- command <- paste("SamplesEmbed.end :=", endIt)
- invisible(.CmdInterpreter(command))
+ options("BRugsSamplesEnd" = endIt)
}
Modified: trunk/BRugs/R/samples.set.firstChain.R
===================================================================
--- trunk/BRugs/R/samples.set.firstChain.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.set.firstChain.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -7,6 +7,5 @@
first <- as.integer(first)
if(!(first %in% 1:getNumChains()))
stop("it is required to have 1 <= first <= nchains")
- command <- paste("SamplesEmbed.firstChain :=", as.integer(first))
- invisible(.CmdInterpreter(command))
+ options("BRugsSamplesFirstChain" = first)
}
Modified: trunk/BRugs/R/samples.set.lastChain.R
===================================================================
--- trunk/BRugs/R/samples.set.lastChain.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.set.lastChain.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -7,6 +7,5 @@
last <- as.integer(last)
if(!(last %in% 1:getNumChains()))
stop("it is required to have 1 <= last <= nchains")
- command <- paste("SamplesEmbed.lastChain :=", last)
- invisible(.CmdInterpreter(command))
+ options("BRugsSamplesLastChain" = last)
}
Modified: trunk/BRugs/R/samples.set.thin.R
===================================================================
--- trunk/BRugs/R/samples.set.thin.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.set.thin.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -4,6 +4,5 @@
{
if(!is.numeric(thin))
stop("thin ", "must be numeric")
- command <- paste("SamplesEmbed.thin :=", as.integer(thin))
- invisible(.CmdInterpreter(command))
+ options("BRugsSamplesThin" = thin)
}
Modified: trunk/BRugs/R/samples.size.R
===================================================================
--- trunk/BRugs/R/samples.size.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.size.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -9,8 +9,7 @@
if (any(grep("^model has probably not yet been updated", sM))) return(0)
if(length(sM) > 1 || sM != node)
stop("node must be a scalar variable from the model")
- command <- paste("SamplesEmbed.SetVariable(", shQuote(node), ")")
- .CmdInterpreter(command)
- command <- "SamplesEmbed.SampleSize"
- .Integer(command)
+ size <- .OpenBUGS(c(.SamplesGlobalsCmd(node), "SamplesEmbed.SampleSize"),
+ c("CmdInterpreter","Integer"))[[2]]
+ size
}
Modified: trunk/BRugs/R/samples.stats.R
===================================================================
--- trunk/BRugs/R/samples.stats.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/samples.stats.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -22,7 +22,6 @@
samplesSetLastChain(lastChain)
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,
@@ -33,9 +32,8 @@
start = numeric(), sample=numeric())
}
- for(i in seq(along=nodeName)){
- command <- paste("SamplesEmbed.SetVariable(", nodeName[i],
- ");SamplesEmbed.StatsGuard;SamplesEmbed.Stats")
+ for(i in seq(along=node)){
+ command <- paste(.SamplesGlobalsCmd(node), "SamplesEmbed.StatsGuard;SamplesEmbed.Stats")
.CmdInterpreter(command)
buffer <- file.path(tempdir(), "buffer.txt")
rlb <- readLines(buffer)
@@ -44,9 +42,9 @@
result <- rbind(result, read.table(buffer))
else{
if(length(grep("val97.5pc", rlb)))
- message("Variable ", nodeName[i], " has probably not been updated")
+ message("Variable ", node[i], " has probably not been updated")
else
- message("Variable ", nodeName[i], ": ", rlb)
+ message("Variable ", node[i], ": ", rlb)
}
}
return(result)
Modified: trunk/BRugs/R/set.values.R
===================================================================
--- trunk/BRugs/R/set.values.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/set.values.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -8,19 +8,16 @@
# if(any(DoNotSetNA))
# warning("Some NA values formerly had a non-NA value -- left unchanged")
# values[DoNotSetNA] <- cv[DoNotSetNA]
- if (dimensions(nodeLabel) == 0)
- stop("Only allowed for vector, not scalar nodes")
- command <- "BugsRobjects.SetVariable"
- .C("CharArray", command, nchar(command), nodeLabel, nchar(nodeLabel), integer(1), PACKAGE="BRugs")
- command <- "BugsRobjects.GetSize"
- nodeSize <- .Integer(command)
+ nodeSize <- .OpenBUGS(c("BugsRobjects.SetVariable", "BugsRobjects.GetSize"),
+ c("CharArray","Integer"),
+ c(nodeLabel,NA))[[2]]
if(nodeSize == -1)
stop(nodeLabel, " is not a node in BUGS model")
- if(length(values) != nodeSize)
- stop("length(values) does not correspond to the node size")
- command <- "BugsRobjects.SetValues"
- res <- .C("RealArray", command, nchar(command), as.double(values), as.integer(nodeSize),
- integer(1), NAOK = TRUE, PACKAGE="BRugs")
- handleRes(res[[5]])
+ numChains <- getNumChains()
+ if(length(values) != nodeSize*numChains)
+ stop("length(values) does not correspond to the node size and number of chains")
+ .OpenBUGS(c("BugsRobjects.SetVariable", "BugsRobjects.SetValues"),
+ c("CharArray","RealArray"),
+ list(nodeLabel,as.double(values)))[[2]]
invisible()
}
Modified: trunk/BRugs/R/unix/help.R
===================================================================
--- trunk/BRugs/R/unix/help.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/unix/help.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -24,6 +24,6 @@
"switch to its window."),
exdent = 4))
writeLines("Otherwise, be patient ...")
- browseURL(system.file("OpenBUGS", "Manuals", "Contents.html", package="BRugs"))
+ browseURL(file.path(options()$OpenBUGSdoc, "Manuals", "Contents.html"))
invisible("")
}
Added: trunk/BRugs/R/unix/internal.R
===================================================================
--- trunk/BRugs/R/unix/internal.R (rev 0)
+++ trunk/BRugs/R/unix/internal.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -0,0 +1,36 @@
+dquote <- function(x){
+ paste("\"", x, "\"", sep="")
+}
+
+.OpenBUGS.platform <- function(cmds, cmdtypes, args)
+{
+ ncmds <- length(cmds)
+ if (ncmds > 99999) stop("Maximum number of OpenBUGS API commands exceeded")
+ tempDir <- getOption("BRugsTmpdir")
+ ## Don't want internalize/externalize to overwrite the command
+ ## output buffer, so redirect its output to a separate trash can.
+ trashDir <- paste(tempDir, "_trash", sep="")
+ extFile <- getOption("BRugsExtFile")
+ pkgPath <- searchpaths()[search()=="package:BRugs"]
+ bugsPath <- paste(pkgPath, "/exec/BugsHelper", sep="")
+ shcmd <- paste(bugsPath, dquote(tempDir), dquote(trashDir), dquote(extFile))
+ for (i in 1:ncmds) {
+ if (cmdtypes[i] %in% c("CharArray","RealArray"))
+ cat(args[[i]], file=paste(tempDir, "/input",i,".txt", sep=""))
+ cmdtype <- match(cmdtypes[i], .OpenBUGS.cmdtypes) - 1
+ shcmd <- paste(shcmd, dquote(cmds[i]), cmdtype)
+ }
+ res <- system(shcmd)
+ handleRes(res)
+ out <- vector(ncmds, mode="list")
+ for (i in 1:ncmds) {
+ if (cmdtypes[i] %in% c("Integer","CharArray","RealArray"))
+ out[[i]] <- scan(paste(tempDir,"/output",i,".txt",sep=""),
+ switch(cmdtypes[i],
+ "Integer" = integer(),
+ "CharArray" = character(),
+ "RealArray" = double()),
+ quiet=TRUE)
+ }
+ out
+}
Added: trunk/BRugs/R/unix/zzz.R
===================================================================
--- trunk/BRugs/R/unix/zzz.R (rev 0)
+++ trunk/BRugs/R/unix/zzz.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -0,0 +1,25 @@
+if (is.R()){
+
+ ".onLoad" <- function(lib, pkg){
+ ## TODO any need for these to be user specifiable?
+ options("BRugsTmpdir" = gsub("\\\\", "/", tempdir()))
+ options("BRugsExtFile" = paste(basename(tempfile()), ".bug", sep=""))
+ options(OpenBUGS = "/usr/local/lib/OpenBUGS")
+ options(OpenBUGSdoc = "/usr/local/lib/OpenBUGS/doc")
+ options(OpenBUGSExamples = paste(options()$OpenBUGSdoc, "Examples", sep="/"))
+
+ if(is.null(getOption("BRugsVerbose")))
+ options("BRugsVerbose" = TRUE)
+ .initGlobals()
+ ver <- system("echo \"modelQuit()\" | /usr/local/lib/OpenBUGS/bin/OpenBUGS", intern=TRUE)
+ ver <- sub("OpenBUGS version (([0-9]\\.)+[0-9]).+","\\1",ver[1])
+ packageStartupMessage("Welcome to BRugs running on OpenBUGS version ", ver)
+ }
+
+ ".onUnload" <- function(libpath){
+ }
+
+ ## Windows-only
+ loadOpenBUGS <- function(dir) {
+ }
+}
Added: trunk/BRugs/R/unix/zzz.R.in
===================================================================
--- trunk/BRugs/R/unix/zzz.R.in (rev 0)
+++ trunk/BRugs/R/unix/zzz.R.in 2011-08-24 18:53:11 UTC (rev 191)
@@ -0,0 +1,25 @@
+if (is.R()){
+
+ ".onLoad" <- function(lib, pkg){
+ ## TODO any need for these to be user specifiable?
+ options("BRugsTmpdir" = gsub("\\\\", "/", tempdir()))
+ options("BRugsExtFile" = paste(basename(tempfile()), ".bug", sep=""))
+ options(OpenBUGS = "@OPENBUGS@")
+ options(OpenBUGSdoc = "@OPENBUGSDOC@")
+ options(OpenBUGSExamples = paste(options()$OpenBUGSdoc, "Examples", sep="/"))
+
+ if(is.null(getOption("BRugsVerbose")))
+ options("BRugsVerbose" = TRUE)
+ .initGlobals()
+ ver <- system("echo \"modelQuit()\" | @OPENBUGS@/bin/OpenBUGS", intern=TRUE)
+ ver <- sub("OpenBUGS version (([0-9]\\.)+[0-9]).+","\\1",ver[1])
+ packageStartupMessage("Welcome to BRugs running on OpenBUGS version ", ver)
+ }
+
+ ".onUnload" <- function(libpath){
+ }
+
+ ## Windows-only
+ loadOpenBUGS <- function(dir) {
+ }
+}
Modified: trunk/BRugs/R/windows/help.R
===================================================================
--- trunk/BRugs/R/windows/help.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/windows/help.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -2,7 +2,7 @@
{
## stolen from help.start()
# a <- system.file("OpenBUGS", "Manuals", "WinBUGS Manual.html", package="BRugs")
- # if (!file.exists(a))
+ # if (!file.exists(a))
# stop("I can't find the html help")
# a <- chartr("/", "\\", a)
# message("If nothing happens, you should open `", a, "' yourself")
@@ -15,9 +15,9 @@
help.WinBUGS <- function(browser = getOption("browser"))
{
# stolen from help.start()
- a <- system.file("OpenBUGS", "Manuals", "Contents.html", package="BRugs")
- if (!file.exists(a))
- stop("I can't find the html help")
+ a <- file.path(options()$OpenBUGS, "Manuals", "Contents.html")
+ if (!file.exists(a))
+ stop("HTML help not found in file ", a)
if (is.R())
a <- chartr("/", "\\", a)
else
Added: trunk/BRugs/R/windows/internal.R
===================================================================
--- trunk/BRugs/R/windows/internal.R (rev 0)
+++ trunk/BRugs/R/windows/internal.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -0,0 +1,32 @@
+### Run a list of OpenBUGS API command strings
+
+.OpenBUGS.platform <- function(cmds, cmdtypes, args)
+{
+ ncmds <- length(cmds)
+ out <- vector(ncmds, mode="list")
+ for (i in 1:ncmds) {
+ out[[i]] <- switch(cmdtypes[i],
+ "CmdInterpreter" = {
+ res <- .C("CmdInterpreter", cmds[i], nchar(cmds[i]), integer(1))
+ handleRes(res[[3]])
+ res
+ },
+ "Integer" = {
+ values <- .C("Integer", cmds[i], nchar(cmds[i]), integer(1), integer(1))
+ handleRes(values[[4]])
+ as.integer(values[[3]])
+ },
+ "CharArray" = {
+ values <- .C("CharArray", cmds[i], nchar(cmds[i]), args[[i]], nchar(args[[i]]), integer(1))
+ handleRes(values[[5]])
+ values[[3]]
+ },
+ "RealArray" = {
+ values <- .C("RealArray", cmds[i], nchar(cmds[i]), args[[i]], length(args[[i]]), integer(1))
+ handleRes(values[[5]])
+ values[[3]]
+ })
+
+ }
+ out
+}
Added: trunk/BRugs/R/windows/zzz.R
===================================================================
--- trunk/BRugs/R/windows/zzz.R (rev 0)
+++ trunk/BRugs/R/windows/zzz.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -0,0 +1,68 @@
+if (is.R()){
+
+ ".onLoad" <- function(lib, pkg){
+ if(.Platform[["r_arch"]] != "i386")
+ stop("BRugs only works for 32-bit R")
+ dir <- Sys.getenv("BRUGS_PATH")
+ if(!nchar(dir)){
+ ob.reg <- try(utils:::readRegistry("Software\\OpenBUGS", "HLM", view = "32-bit"), silent = TRUE)
+ if (inherits(ob.reg, "try-error")) {
+ warning("OpenBUGS 3.2.1 or greater must be installed\n(if so, this indicates missing registry keys of OpenBUGS).\nSetting the environment variable 'BRUGS_PATH' in advance of loading 'BRugs' overwrites the path.\nSee ?loadOpenBUGS in order to load OpenBUGS manually.")
+ return()
+ }
+ rnames <- names(ob.reg)
+ ver <- gsub("OpenBUGS ", "", rnames)
+ veri <- gsub("(.+)e$","\\1", ver)
+ version.inst <- as.numeric(paste(substr(veri, 1, 2), gsub("\\.","",substr(veri, 3, nchar(veri))), sep=""))
+ deps <- utils:::packageDescription("BRugs", fields="SystemRequirements")
+ ver <- gsub(".*OpenBUGS ?\\(>= ?(.+)\\).*", "\\1", deps)
+ version.req <- as.numeric(paste(substr(ver, 1, 2), gsub("\\.","",substr(ver, 3, nchar(ver))), sep=""))
+ if (max(version.inst) < version.req) {
+ warning("Found OpenBUGS version ", version.inst, ". Requires ", version.req, " or greater")
+ return()
+ }
+ ## OpenBUGS installation location
+ dir <- utils:::readRegistry(paste("Software","OpenBUGS",rnames[which.max(version.inst)],sep="\\"),"HLM")$InstallPath
+ loadOpenBUGS(dir)
+ packageStartupMessage("Welcome to BRugs running on OpenBUGS version ", veri[which.max(version.inst)])
+ } else {
+ if(!file.exists(file.path(dir, "libOpenBUGS.dll"))){
+ warning("Environment variable BRUGS_PATH found but cannot access ", file.path(dir, "libOpenBUGS.dll"))
+ return()
+ }
+ loadOpenBUGS(dir)
+ packageStartupMessage("Welcome to BRugs connected to OpenBUGS in\n", dir)
+ }
+ }
+
+ ## Load OpenBUGS from specified location
+ loadOpenBUGS <- function(dir) {
+ libname <- paste(dir, "libOpenBUGS.dll", sep="/")
+ if (!file.exists(libname)) {
+ warning("Shared library \"libOpenBUGS.dll\" not found in ", dir)
+ return(FALSE)
+ }
+ options(OpenBUGS = dir)
+ dyn.load(libname)
+ len <- nchar(dir)
+ .C("SetWorkingDir", as.character(dir), len)
+ ## Set temporary dir for "buffer.txt" output
+ tempDir <- gsub("\\\\", "/", tempdir())
+ .C("SetTempDir", as.character(tempDir), nchar(tempDir))
+ command <- "BugsMappers.SetDest(2)"
+ .CmdInterpreter(command)
+ if(is.null(getOption("BRugsVerbose")))
+ options("BRugsVerbose" = TRUE)
+ .initGlobals()
+ options(OpenBUGSExamples = paste(dir, "Examples", sep="/"))
+ invisible()
+ }
+
+ ".onUnload" <- function(libpath){
+ if(is.loaded("CmdInterpreter")) {
+ libname <- paste(options()$OpenBUGS, "libOpenBUGS.dll", sep="/")
+ dyn.unload(libname)
+ }
+ }
+
+}
Modified: trunk/BRugs/R/zzz.R
===================================================================
--- trunk/BRugs/R/zzz.R 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/R/zzz.R 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,32 +1,23 @@
+## See unix/zzz.R, windows/zzz.R for platform specific .onLoad functions
+
if (is.R()){
- ".onLoad" <- function(lib, pkg){
- ## sets path / file variables and initializes subsystems
- root <- file.path(system.file("OpenBUGS", package=pkg))
- ## we do have a NAMESPACE now: library.dynam("BRugs", pkg, lib)
- len <- nchar(root)
- tempDir <- gsub("\\\\", "/", tempdir())
- .C("SetWorkingDir", as.character(root), len, PACKAGE="BRugs")
- .C("SetTempDir", as.character(tempDir), nchar(tempDir), PACKAGE="BRugs")
- command <- "BugsMappers.SetDest(2)"
- .CmdInterpreter(command)
- if(is.null(getOption("BRugsVerbose")))
- options("BRugsVerbose" = TRUE)
+ .initGlobals <- function(){
+ options("BRugsSamplesBeg" = 1)
+ options("BRugsSamplesEnd" = 10000000)
+ options("BRugsSamplesFirstChain" = 1)
+ options("BRugsSamplesLastChain" = 1)
+ options("BRugsSamplesThin" = 1)
+ options("BRugsSamplesVariable" = "*")
+ options("BRugsNextChain" = 1) # index of chain which needs to be initialized next
+ options("BRugsPrec" = 4)
}
-
- ".onAttach" <- function(lib, pkg){
- message("Welcome to BRugs running on OpenBUGS version 3.1.0")
- }
-
- ".onUnload" <- function(libpath){
- library.dynam.unload("BRugs", libpath)
- }
## Overwriting new (from R-2.6.0) sQuote (for typing human readable text) in R within the BRugs Namespace!
## we cannot use sQuote that uses fancy quotes!
sQuote <- function(x) paste("'", x, "'", sep="")
-
+
} else { # ends if (is.R())
".First.lib" <- function(lib.loc, section)
@@ -41,12 +32,12 @@
command <- "BugsMappers.SetDest(2)"
.C("CmdInterpreter", as.character(command), nchar(command), integer(1))
if(is.null(getOption("BRugsVerbose")))
- options("BRugsVerbose" = TRUE)
+ options("BRugsVerbose" = TRUE)
invisible()
}
-
+
.tempDir <- getwd()
-
+
tempdir <- function(){ .tempDir }
} # ends else
Modified: trunk/BRugs/configure
===================================================================
--- trunk/BRugs/configure 2011-07-02 13:49:30 UTC (rev 190)
+++ trunk/BRugs/configure 2011-08-24 18:53:11 UTC (rev 191)
@@ -1,3 +1,5027 @@
-echo "Package 'BRugs' currently only works under Windows.\nIt is supposed to work under Linux in future releases."
-exit 1
-
+#! /bin/sh
+# Guess values for system-dependent variables and create Makefiles.
+# Generated by GNU Autoconf 2.65 for BRugs 0.7.
+#
+#
+# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
+# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation,
+# Inc.
+#
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+## -------------------- ##
+## M4sh Initialization. ##
+## -------------------- ##
+
+# Be more Bourne compatible
+DUALCASE=1; export DUALCASE # for MKS sh
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :
+ emulate sh
+ NULLCMD=:
+ # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which
+ # is contrary to our usage. Disable this feature.
+ alias -g '${1+"$@"}'='"$@"'
+ setopt NO_GLOB_SUBST
+else
+ case `(set -o)...
[truncated message content] |
|
From: <li...@us...> - 2011-08-25 15:21:55
|
Revision: 193
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=193&view=rev
Author: ligges
Date: 2011-08-25 15:21:48 +0000 (Thu, 25 Aug 2011)
Log Message:
-----------
workaround for OpenBUGS-3.2.1 not being able to deal with "()" in dirnames/filenames while this is a default location under 64-bit Windows for the Examples files
Modified Paths:
--------------
trunk/BRugs/man/BRugs.Rd
trunk/BRugs/man/BRugsFit.Rd
trunk/BRugs/tests/BRugs.R
trunk/BRugs/tests/BRugs.Rout.save
trunk/BRugs/tests/examples.R
trunk/BRugs/tests/examples.Rout.save
trunk/BRugs/tests/functions.R
trunk/BRugs/tests/functions.Rout.save
Modified: trunk/BRugs/man/BRugs.Rd
===================================================================
--- trunk/BRugs/man/BRugs.Rd 2011-08-25 15:20:34 UTC (rev 192)
+++ trunk/BRugs/man/BRugs.Rd 2011-08-25 15:21:48 UTC (rev 193)
@@ -43,9 +43,13 @@
### Step by step example: ###
library("BRugs") # loading BRugs
-## Now setting the working directory to the examples' one:
-oldwd <- setwd(options()$OpenBUGSExamples)
+## Prepare the example files in a temporary directory
+exfiles <- dir(options()$OpenBUGSExamples, pattern="^Rats.*txt$", full.names=TRUE)
+ok <- file.copy(exfiles, tempdir())
+## Now setting the working directory to the temporary one:
+oldwd <- setwd(tempdir())
+
## some usual steps (like clicking in WinBUGS):
modelCheck("Ratsmodel.txt") # check model file
modelData("Ratsdata.txt") # read data file
Modified: trunk/BRugs/man/BRugsFit.Rd
===================================================================
--- trunk/BRugs/man/BRugsFit.Rd 2011-08-25 15:20:34 UTC (rev 192)
+++ trunk/BRugs/man/BRugsFit.Rd 2011-08-25 15:21:48 UTC (rev 193)
@@ -53,10 +53,13 @@
\code{openbugs} (and \code{bugs}) and \code{as.bugs.array} functions in the CRAN package \pkg{R2WinBUGS}.}
\examples{
\donttest{
+## Prepare the example files in a temporary directory
+exfiles <- dir(options()$OpenBUGSExamples, pattern="^Rats.*txt$", full.names=TRUE)
+ok <- file.copy(exfiles, tempdir())
BRugsFit(data = "Ratsdata.txt", inits = "Ratsinits.txt",
para = c("alpha", "beta"), modelFile = "Ratsmodel.txt",
numChains = 1,
- working.directory = options()$OpenBUGSExamples)
+ working.directory = tempdir())
}
}
\keyword{interface}
Modified: trunk/BRugs/tests/BRugs.R
===================================================================
--- trunk/BRugs/tests/BRugs.R 2011-08-25 15:20:34 UTC (rev 192)
+++ trunk/BRugs/tests/BRugs.R 2011-08-25 15:21:48 UTC (rev 193)
@@ -2,14 +2,21 @@
if (test) {
-library(BRugs)
+library("BRugs")
+## Prepare the example files in a temporary directory
+exfiles <- dir(options()$OpenBUGSExamples, pattern="^Rats.*txt$", full.names=TRUE)
+ok <- file.copy(exfiles, tempdir())
+exfiles <- dir(options()$OpenBUGSExamples, pattern="^Beetles.*txt$", full.names=TRUE)
+ok <- file.copy(exfiles, tempdir())
+
+
BRugsFit(data = "Ratsdata.txt", inits = "Ratsinits.txt",
para = c("alpha", "beta"), modelFile = "Ratsmodel.txt",
numChains = 1,
- working.directory = options()$OpenBUGSExamples)
+ working.directory = tempdir())
-setwd(options()$OpenBUGSExamples)
+setwd(tempdir())
modelCheck("Ratsmodel.txt")
modelData("Ratsdata.txt")
modelCompile(numChains=2)
@@ -28,23 +35,23 @@
BRugsFit(data = "Beetlesdata.txt", inits = "Beetlesinits.txt",
para = c("alpha", "beta", "rhat"), modelFile = "Beetlesmodel.txt",
numChains = 1,
- working.directory = options()$OpenBUGSExamples)
+ working.directory = tempdir())
BRugsFit(data = beetles, inits = "Beetlesinits.txt",
para = c("alpha", "beta", "rhat"), modelFile = "Beetlesmodel.txt",
numChains = 1,
- working.directory = options()$OpenBUGSExamples)
+ working.directory = tempdir())
with(beetles,
BRugsFit(data = list("x", "n", "r", "N"), inits = "Beetlesinits.txt",
para=c("alpha", "beta", "rhat"), modelFile = "Beetlesmodel.txt",
- numChains = 1, working.directory = options()$OpenBUGSExamples)
+ numChains = 1, working.directory = tempdir())
)
with(beetles,
BRugsFit(data = c("x", "n", "r", "N"), inits = "Beetlesinits.txt",
para=c("alpha", "beta", "rhat"), modelFile = "Beetlesmodel.txt",
- numChains = 1, working.directory = options()$OpenBUGSExamples)
+ numChains = 1, working.directory = tempdir())
)
}
Modified: trunk/BRugs/tests/BRugs.Rout.save
===================================================================
--- trunk/BRugs/tests/BRugs.Rout.save 2011-08-25 15:20:34 UTC (rev 192)
+++ trunk/BRugs/tests/BRugs.Rout.save 2011-08-25 15:21:48 UTC (rev 193)
@@ -1,5 +1,5 @@
-R version 2.13.1 (2011-07-08)
+R version 2.13.1 Patched (2011-07-20 r56455)
Copyright (C) 2011 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
Platform: i386-pc-mingw32/i386 (32-bit)
@@ -20,14 +20,21 @@
>
> if (test) {
+
-+ library(BRugs)
++ library("BRugs")
+
++ ## Prepare the example files in a temporary directory
++ exfiles <- dir(options()$OpenBUGSExamples, pattern="^Rats.*txt$", full.names=TRUE)
++ ok <- file.copy(exfiles, tempdir())
++ exfiles <- dir(options()$OpenBUGSExamples, pattern="^Beetles.*txt$", full.names=TRUE)
++ ok <- file.copy(exfiles, tempdir())
++
++
+ BRugsFit(data = "Ratsdata.txt", inits = "Ratsinits.txt",
+ para = c("alpha", "beta"), modelFile = "Ratsmodel.txt",
+ numChains = 1,
-+ working.directory = options()$OpenBUGSExamples)
++ working.directory = tempdir())
+
-+ setwd(options()$OpenBUGSExamples)
++ setwd(tempdir())
+ modelCheck("Ratsmodel.txt")
+ modelData("Ratsdata.txt")
+ modelCompile(numChains=2)
@@ -46,23 +53,23 @@
+ BRugsFit(data = "Beetlesdata.txt", inits = "Beetlesinits.txt",
+ para = c("alpha", "beta", "rhat"), modelFile = "Beetlesmodel.txt",
+ numChains = 1,
-+ working.directory = options()$OpenBUGSExamples)
++ working.directory = tempdir())
+
+ BRugsFit(data = beetles, inits = "Beetlesinits.txt",
+ para = c("alpha", "beta", "rhat"), modelFile = "Beetlesmodel.txt",
+ numChains = 1,
-+ working.directory = options()$OpenBUGSExamples)
++ working.directory = tempdir())
+
+ with(beetles,
+ BRugsFit(data = list("x", "n", "r", "N"), inits = "Beetlesinits.txt",
+ para=c("alpha", "beta", "rhat"), modelFile = "Beetlesmodel.txt",
-+ numChains = 1, working.directory = options()$OpenBUGSExamples)
++ numChains = 1, working.directory = tempdir())
+ )
+
+ with(beetles,
+ BRugsFit(data = c("x", "n", "r", "N"), inits = "Beetlesinits.txt",
+ para=c("alpha", "beta", "rhat"), modelFile = "Beetlesmodel.txt",
-+ numChains = 1, working.directory = options()$OpenBUGSExamples)
++ numChains = 1, working.directory = tempdir())
+ )
+
+ }
Modified: trunk/BRugs/tests/examples.R
===================================================================
--- trunk/BRugs/tests/examples.R 2011-08-25 15:20:34 UTC (rev 192)
+++ trunk/BRugs/tests/examples.R 2011-08-25 15:21:48 UTC (rev 193)
@@ -2,7 +2,7 @@
if (test) {
-library(BRugs)
+library("BRugs")
## Selected examples which take a few seconds in total to run
@@ -28,19 +28,20 @@
Surgicalrand = c("p","pop.mean", "sigma")
)
-test.modelfile = paste(test.models,"model.txt",sep="")
-test.datafile = paste(test.models,"data.txt",sep="")
-test.inits = paste(test.models,"inits.txt",sep="")
-
+test.modelfile <- paste(test.models,"model.txt",sep="")
+test.datafile <- paste(test.models,"data.txt",sep="")
+test.inits <- paste(test.models,"inits.txt",sep="")
+test.pattern <- paste("^", test.models, ".*\\.txt$", sep="")
### Test for posterior means within 10 percent of previously saved values
res.true <- dget(file="examples.stats.R")
for (i in seq(along=test.models)) {
- fit <- BRugsFit(data=test.datafile[i], inits=test.inits[i], modelFile=test.modelfile[i], para=test.params[[test.models[i]]],
- nBurnin=5000, nIter=20000, nThin=1, numChains=1, seed=1
- ,
- working.directory=options()$OpenBUGSExamples
- )
+ exfiles <- dir(options()$OpenBUGSExamples, pattern=test.pattern[i], full.names=TRUE)
+ ok <- file.copy(exfiles, tempdir())
+ fit <- BRugsFit(data=test.datafile[i], inits=test.inits[i],
+ modelFile=test.modelfile[i], para=test.params[[test.models[i]]],
+ nBurnin=5000, nIter=20000, nThin=1, numChains=1, seed=1,
+ working.directory=tempdir())
stopifnot(isTRUE(all.equal(fit$Stats$mean, res.true[[i]]$Stats$mean, tol=1e-01)))
}
Modified: trunk/BRugs/tests/examples.Rout.save
===================================================================
--- trunk/BRugs/tests/examples.Rout.save 2011-08-25 15:20:34 UTC (rev 192)
+++ trunk/BRugs/tests/examples.Rout.save 2011-08-25 15:21:48 UTC (rev 193)
@@ -1,5 +1,5 @@
-R version 2.13.1 (2011-07-08)
+R version 2.13.1 Patched (2011-07-20 r56455)
Copyright (C) 2011 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
Platform: i386-pc-mingw32/i386 (32-bit)
@@ -20,7 +20,7 @@
>
> if (test) {
+
-+ library(BRugs)
++ library("BRugs")
+
+ ## Selected examples which take a few seconds in total to run
+
@@ -46,19 +46,20 @@
+ Surgicalrand = c("p","pop.mean", "sigma")
+ )
+
-+ test.modelfile = paste(test.models,"model.txt",sep="")
-+ test.datafile = paste(test.models,"data.txt",sep="")
-+ test.inits = paste(test.models,"inits.txt",sep="")
-+
++ test.modelfile <- paste(test.models,"model.txt",sep="")
++ test.datafile <- paste(test.models,"data.txt",sep="")
++ test.inits <- paste(test.models,"inits.txt",sep="")
++ test.pattern <- paste("^", test.models, ".*\\.txt$", sep="")
+ ### Test for posterior means within 10 percent of previously saved values
+
+ res.true <- dget(file="examples.stats.R")
+ for (i in seq(along=test.models)) {
-+ fit <- BRugsFit(data=test.datafile[i], inits=test.inits[i], modelFile=test.modelfile[i], para=test.params[[test.models[i]]],
-+ nBurnin=5000, nIter=20000, nThin=1, numChains=1, seed=1
-+ ,
-+ working.directory=options()$OpenBUGSExamples
-+ )
++ exfiles <- dir(options()$OpenBUGSExamples, pattern=test.pattern[i], full.names=TRUE)
++ ok <- file.copy(exfiles, tempdir())
++ fit <- BRugsFit(data=test.datafile[i], inits=test.inits[i],
++ modelFile=test.modelfile[i], para=test.params[[test.models[i]]],
++ nBurnin=5000, nIter=20000, nThin=1, numChains=1, seed=1,
++ working.directory=tempdir())
+ stopifnot(isTRUE(all.equal(fit$Stats$mean, res.true[[i]]$Stats$mean, tol=1e-01)))
+ }
+
@@ -268,5 +269,5 @@
monitor set for variable 'p'
monitor set for variable 'pop.mean'
monitor set for variable 'sigma'
-20000 updates took 1 s
+20000 updates took 2 s
>
Modified: trunk/BRugs/tests/functions.R
===================================================================
--- trunk/BRugs/tests/functions.R 2011-08-25 15:20:34 UTC (rev 192)
+++ trunk/BRugs/tests/functions.R 2011-08-25 15:21:48 UTC (rev 193)
@@ -3,7 +3,9 @@
if (test) {
library("BRugs")
-setwd(options()$OpenBUGSExamples)
+exfiles <- dir(options()$OpenBUGSExamples, pattern="^Rats.*txt$", full.names=TRUE)
+ok <- file.copy(exfiles, tempdir())
+setwd(tempdir())
## .onLoad(lib=.libPaths()[1], pkg="BRugs") # if developing without using namespace
### TEST ALL USER-LEVEL FUNCTIONS USING RATS EXAMPLE
Modified: trunk/BRugs/tests/functions.Rout.save
===================================================================
--- trunk/BRugs/tests/functions.Rout.save 2011-08-25 15:20:34 UTC (rev 192)
+++ trunk/BRugs/tests/functions.Rout.save 2011-08-25 15:21:48 UTC (rev 193)
@@ -1,5 +1,5 @@
-R version 2.13.1 (2011-07-08)
+R version 2.13.1 Patched (2011-07-20 r56455)
Copyright (C) 2011 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
Platform: i386-pc-mingw32/i386 (32-bit)
@@ -21,7 +21,9 @@
> if (test) {
+
+ library("BRugs")
-+ setwd(options()$OpenBUGSExamples)
++ exfiles <- dir(options()$OpenBUGSExamples, pattern="^Rats.*txt$", full.names=TRUE)
++ ok <- file.copy(exfiles, tempdir())
++ setwd(tempdir())
+ ## .onLoad(lib=.libPaths()[1], pkg="BRugs") # if developing without using namespace
+
+ ### TEST ALL USER-LEVEL FUNCTIONS USING RATS EXAMPLE
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <chr...@us...> - 2011-08-30 21:56:06
|
Revision: 209
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=209&view=rev
Author: chris-jackson
Date: 2011-08-30 21:56:00 +0000 (Tue, 30 Aug 2011)
Log Message:
-----------
More detail and bugfixes for updater methods and other internal OpenBUGS technicalities.
Modified Paths:
--------------
trunk/BRugs/R/info.updaters.R
trunk/BRugs/man/info.updaters.Rd
trunk/BRugs/man/model.factory.Rd
trunk/BRugs/man/model.setAP.Rd
Added Paths:
-----------
trunk/BRugs/R/model.getRN.R
Modified: trunk/BRugs/R/info.updaters.R
===================================================================
--- trunk/BRugs/R/info.updaters.R 2011-08-26 16:22:56 UTC (rev 208)
+++ trunk/BRugs/R/info.updaters.R 2011-08-30 21:56:00 UTC (rev 209)
@@ -1,28 +1,44 @@
-## display updaters sorted by node name
+## display updaters sorted by node name
infoUpdatersbyName <- function()
{
command <- "BugsEmbed.NotCompiledGuard; BugsEmbed.UpdatersByName"
.CmdInterpreter(command)
+ buffer <- file.path(tempdir(), "buffer.txt")
+ if (readLines(buffer)[1]=="BugsCmds:NotCompiled")
+ stop("Model not compiled")
buffer <- file.path(tempdir(), "Updater types.txt")
result <- read.fwf(buffer, c(25, 50, 10, 10), skip = 1, as.is=TRUE,
row.names=1, col.names=c("Node","Type", "Size","Depth"))
- for (i in 1:2)
- result[,i] <- gsub(" ", "", result[,i])
- rownames(result) <- gsub(" ", "", rownames(result))
+ ## strip leading and trailing spaces
+ for (i in 1:2) {
+ result[,i] <- gsub("^ +", "\\1", result[,i])
+ result[,i] <- gsub(" +$", "\\1", result[,i])
+ }
+ rownames(result) <- gsub("^ +", "", rownames(result))
+ rownames(result) <- gsub(" +$", "", rownames(result))
+ unlink(buffer)
result
}
-## display updaters sorted by node depth in graph
+## display updaters sorted by node depth in graph
infoUpdatersbyDepth <- function()
{
command <- "BugsEmbed.NotCompiledGuard; BugsEmbed.UpdatersByDepth"
.CmdInterpreter(command)
+ buffer <- file.path(tempdir(), "buffer.txt")
+ if (readLines(buffer)[1]=="BugsCmds:NotCompiled")
+ stop("Model not compiled")
buffer <- file.path(tempdir(), "Updater types.txt")
result <- read.fwf(buffer, c(25, 50, 10, 10), skip = 1, as.is=TRUE,
row.names=1, col.names=c("Node","Type", "Size","Depth"))
- for (i in 1:2)
- result[,i] <- gsub(" ", "", result[,i])
- rownames(result) <- gsub(" ", "", rownames(result))
+ ## strip leading and trailing spaces
+ for (i in 1:2) {
+ result[,i] <- gsub("^ +", "\\1", result[,i])
+ result[,i] <- gsub(" +$", "\\1", result[,i])
+ }
+ rownames(result) <- gsub("^ +", "", rownames(result))
+ rownames(result) <- gsub(" +$", "", rownames(result))
+ unlink(buffer)
result
}
Added: trunk/BRugs/R/model.getRN.R
===================================================================
--- trunk/BRugs/R/model.getRN.R (rev 0)
+++ trunk/BRugs/R/model.getRN.R 2011-08-30 21:56:00 UTC (rev 209)
@@ -0,0 +1,7 @@
+"modelGetRN" <-
+function()
+# Get the seed of random number generator
+{
+ command <- "BugsEmbed.preSet"
+ .Integer(command)
+}
Modified: trunk/BRugs/man/info.updaters.Rd
===================================================================
--- trunk/BRugs/man/info.updaters.Rd 2011-08-26 16:22:56 UTC (rev 208)
+++ trunk/BRugs/man/info.updaters.Rd 2011-08-30 21:56:00 UTC (rev 209)
@@ -8,8 +8,8 @@
infoUpdatersbyDepth()
}
\value{
- A data frame listing the MCMC updating algorithms used for each
- stochastic node in the model.
+ A data frame listing the MCMC updating algorithms chosen for each
+ stochastic node in the model after the model has been compiled.
For block updating algorithms, the first component in the block is
shown followed by the other components of the block in angle brackets.
Modified: trunk/BRugs/man/model.factory.Rd
===================================================================
--- trunk/BRugs/man/model.factory.Rd 2011-08-26 16:22:56 UTC (rev 208)
+++ trunk/BRugs/man/model.factory.Rd 2011-08-30 21:56:00 UTC (rev 209)
@@ -2,15 +2,31 @@
\alias{modelEnable}
\alias{modelDisable}
\title{Enable and disable factories to create updaters}
-\description{These functions enable and disable factories that create updaters.}
+\description{These functions enable and disable factories that create
+ updaters. Currently only supported on Windows, not Linux.
+ Linux support should be available in the next OpenBUGS release after
+ version 3.2.1.}
\usage{
modelEnable(factory)
modelDisable(factory)
}
\arguments{
- \item{factory}{Character (length 1) name of the factory to be disabled/enabled.}
+ \item{factory}{Character (length 1) name of the factory to be
+ disabled/enabled, for example \code{"conjugate gamma"}. See
+
+ \url{http://www.openbugs.info/Manuals/ModelMenu.html#Updateroptions}
+
+ for more information. A list of the currently-used updaters
+ in a compiled model is given by \code{\link{infoUpdatersbyName}} or
+ \code{\link{infoUpdatersbyDepth}}.
+
+ After enabling or disabling an updater, the model must be compiled
+ or re-compiled.
+ }
}
+\examples{\dontrun{
+modelDisable("conjugate gamma")
+}}
\seealso{\code{\link{BRugs}}, \code{\link{help.WinBUGS}}}
\keyword{interface}
\concept{factory}
-
Modified: trunk/BRugs/man/model.setAP.Rd
===================================================================
--- trunk/BRugs/man/model.setAP.Rd 2011-08-26 16:22:56 UTC (rev 208)
+++ trunk/BRugs/man/model.setAP.Rd 2011-08-30 21:56:00 UTC (rev 209)
@@ -3,7 +3,8 @@
\alias{modelSetIts}
\alias{modelSetOR}
\title{Changing settings of updating algorithms}
-\description{These functions change adaptivePhase, iterations, and overRelaxation settings.}
+\description{These functions change adaptive phase, iterations, and
+ overRelaxation settings. Currently only supported on Windows, not Linux.}
\usage{
modelSetAP(factoryName, adaptivePhase)
modelSetIts(factoryName, iterations)
@@ -12,7 +13,7 @@
\arguments{
\item{factoryName}{String defining which particular MCMC updating algorithm is to be tuned.
Technically this string is the type name of the factory object used to create the updater,
-for example \sQuote{UpdaterMetnormal.Factory} for the random walk metropolis sampler.}
+for example \sQuote{UpdaterMetnormal.Factory} for the random walk Metropolis sampler.}
\item{adaptivePhase}{length of the updater's adaptive phase}
\item{iterations}{number of times an iterative algorithm is run before a failure is reported}
\item{overRelaxation}{amount of over relaxation the updater uses}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <chr...@us...> - 2011-08-30 21:57:51
|
Revision: 210
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=210&view=rev
Author: chris-jackson
Date: 2011-08-30 21:57:45 +0000 (Tue, 30 Aug 2011)
Log Message:
-----------
Alias for R "setwd" with same name as OpenBUGS script command.
Added Paths:
-----------
trunk/BRugs/R/model.setWD.R
trunk/BRugs/man/model.setWD.Rd
Added: trunk/BRugs/R/model.setWD.R
===================================================================
--- trunk/BRugs/R/model.setWD.R (rev 0)
+++ trunk/BRugs/R/model.setWD.R 2011-08-30 21:57:45 UTC (rev 210)
@@ -0,0 +1,3 @@
+## Simple alias to mimic the OpenBUGS script command
+
+"modelSetWD" <- setwd
Added: trunk/BRugs/man/model.setWD.Rd
===================================================================
--- trunk/BRugs/man/model.setWD.Rd (rev 0)
+++ trunk/BRugs/man/model.setWD.Rd 2011-08-30 21:57:45 UTC (rev 210)
@@ -0,0 +1,15 @@
+\name{modelSetWD}
+\alias{modelSetWD}
+\title{Set working directory}
+\description{Change the working directory}
+\usage{
+modelSetWD(dir)
+}
+\arguments{
+ \item{dir}{Directory to change to. A character string}
+}
+\details{
+ Simply an alias for \code{\link{setwd}} from base R, provided
+ to mimic the OpenBUGS script function \code{modelSetWD}.
+}
+\keyword{interface}
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: <chr...@us...> - 2011-08-31 09:28:51
|
Revision: 211
http://bugs-r.svn.sourceforge.net/bugs-r/?rev=211&view=rev
Author: chris-jackson
Date: 2011-08-31 09:28:44 +0000 (Wed, 31 Aug 2011)
Log Message:
-----------
Changes to allow running on x64 R in Windows. The same helper facility as on Linux is used to call the 32-bit DLL.
Modified Paths:
--------------
trunk/BRugs/NEWS
trunk/BRugs/R/internal.R
trunk/BRugs/R/unix/internal.R
trunk/BRugs/R/unix/zzz.R
trunk/BRugs/R/unix/zzz.R.in
trunk/BRugs/R/windows/internal.R
trunk/BRugs/R/windows/zzz.R
trunk/BRugs/configure
trunk/BRugs/configure.ac
trunk/BRugs/configure.win
trunk/BRugs/man/BRugs.Rd
trunk/BRugs/src/BugsHelper.c
trunk/BRugs/src/Makefile.win
trunk/BRugs/src/Makevars.in
trunk/BRugs/tests/functions.R
Added Paths:
-----------
trunk/BRugs/R/windows/findOpenBUGS.R
trunk/BRugs/R/windows/zzz.i386.R
trunk/BRugs/R/windows/zzz.x64.R
trunk/BRugs/R/windows/zzz.x64.R.in
trunk/BRugs/configure.win.R
trunk/BRugs/exec/
Property Changed:
----------------
trunk/BRugs/
trunk/BRugs/src/
Property changes on: trunk/BRugs
___________________________________________________________________
Added: svn:ignore
+ .Rbuildignore
autom4te.cache
config.log
config.status
Modified: trunk/BRugs/NEWS
===================================================================
--- trunk/BRugs/NEWS 2011-08-30 21:57:45 UTC (rev 210)
+++ trunk/BRugs/NEWS 2011-08-31 09:28:44 UTC (rev 211)
@@ -1,10 +1,32 @@
Changes to BRugs:
=====================
-Version 0.7.2 (24 August 2011)
+Version 0.7.2 (?? September 2011)
-------------
-Backport to the original BRugs package
+BRugs now supports 64-bit R on Windows, using the same helper program
+as Linux for calling the 32 bit OpenBUGS shared library. Thanks to
+Brian Ripley for the reports.
+On Linux, when the OpenBUGS library call terminates with a "trap"
+error, the trap message is now shown. Thanks to Alexandre Villers.
+Though on Windows, OpenBUGS "traps" still crash R.
+modelSetWD() function added. This is simply an alias for setwd(), for
+compatibility with the OpenBUGS script function of the same name.
+
+Just strip trailing spaces, not internal spaces, from updater names in
+infoUpdatersbyName(). Thanks to Bob O'Hara.
+
+samplesSize() gives a warning, and samplesBgr() now gives an error,
+instead of crashing, when trying to use them when the sampler is in an
+adaptive phase.
+
+Warning in manual that enabling/disabling updaters is not supported on
+Linux until the next version of OpenBUGS.
+
+BugsCmd API function is now supported by BugsHelper, but this is not
+used.
+
+
Version 0.7.1 (19 April 2011)
-------------
Modified: trunk/BRugs/R/internal.R
===================================================================
--- trunk/BRugs/R/internal.R 2011-08-30 21:57:45 UTC (rev 210)
+++ trunk/BRugs/R/internal.R 2011-08-31 09:28:44 UTC (rev 211)
@@ -1,5 +1,10 @@
### Functions to run a single OpenBUGS API command string
+.BugsCmd <- function(command)
+{
+ unlist(.OpenBUGS(command, "BugsCmd"))
+}
+
.CmdInterpreter <- function(command)
{
unlist(.OpenBUGS(command, "CmdInterpreter"))
@@ -21,7 +26,7 @@
}
-.OpenBUGS.cmdtypes <- c("CmdInterpreter","Integer","CharArray","RealArray")
+.OpenBUGS.cmdtypes <- c("CmdInterpreter","Integer","CharArray","RealArray","BugsCmd")
.OpenBUGS <- function(cmds, cmdtypes=NULL, args=NULL) {
ncmds <- length(cmds)
@@ -32,14 +37,57 @@
.OpenBUGS.platform(cmds, cmdtypes, args)
}
+dquote <- function(x){
+ paste("\"", x, "\"", sep="")
+}
+
+.OpenBUGS.helper <- function(cmds, cmdtypes, args) {
+ ncmds <- length(cmds)
+ if (ncmds > 99999) stop("Maximum number of OpenBUGS API commands exceeded")
+ tempDir <- getOption("BRugsTmpdir")
+ ## Don't want internalize/externalize to overwrite the command
+ ## output buffer, so redirect its output to a separate trash can.
+ trashDir <- paste(tempDir, "_trash", sep="")
+ extFile <- getOption("BRugsExtFile")
+ cmdFile <- paste(tempDir, "cmds.txt", sep="/")
+ pkgPath <- searchpaths()[search()=="package:BRugs"]
+ bugsPath <- paste(pkgPath, "/exec/BugsHelper", sep="")
+ shcmd <- paste(bugsPath, dquote(tempDir), dquote(trashDir), dquote(extFile), dquote(cmdFile), dquote(ncmds))
+ for (i in 1:ncmds) {
+ if (cmdtypes[i] %in% c("CharArray","RealArray"))
+ cat(args[[i]], file=paste(tempDir, "/input",i,".txt", sep=""))
+ }
+ cmd.id <- match(cmdtypes, .OpenBUGS.cmdtypes) - 1
+ write(rbind(cmds, cmd.id), cmdFile)
+ res <- system(shcmd)
+ handleRes(res)
+ out <- vector(ncmds, mode="list")
+ for (i in 1:ncmds) {
+ if (cmdtypes[i] %in% c("Integer","CharArray","RealArray"))
+ out[[i]] <- scan(paste(tempDir,"/output",i,".txt",sep=""),
+ switch(cmdtypes[i],
+ "Integer" = integer(),
+ "CharArray" = character(),
+ "RealArray" = double()),
+ quiet=TRUE)
+ }
+ out
+}
+
handleRes <- function(res)
{
maintainer <- utils:::packageDescription("BRugs", fields="Maintainer")
- switch(res,
- stop("An OpenBUGS module or procedure was called that did not exist. Please report this bug to ", maintainer),
- stop("An OpenBUGS procedure was called with the wrong type of argument. Please report this bug to ", maintainer),
- stop("An OpenBUGS procedure was called with the wrong signature. Please report this bug to ", maintainer)
- )
+ errors <- c("Internal \"trap\" error in OpenBUGS, or non-existent module or procedure called.",
+ "An OpenBUGS procedure was called with the wrong type of argument.",
+ "An OpenBUGS procedure was called with the wrong signature.")
+ ## If a library call ends in a trap, then error code 1 will be returned from BugsHelper on Linux
+ ## On Windows it shouldn't even get this far after a trap. TODO see if the trap message is shown.
+ if (res > 0) {
+ buf <- readLines(file.path(tempdir(), "buffer.txt"))
+ trap <- grep("Sorry something went wrong", buf, value=TRUE)
+ if(length(trap) > 0) message(trap[1])
+ stop(errors[res], "\nPlease report this bug to ", maintainer)
+ }
}
.SamplesGlobalsCmd <- function(node){
@@ -50,7 +98,7 @@
paste("SamplesEmbed.firstChain :=", getOption("BRugsSamplesFirstChain")),
paste("SamplesEmbed.lastChain :=", getOption("BRugsSamplesLastChain")),
paste("SamplesEmbed.thin :=", getOption("BRugsSamplesThin")),
- paste("SamplesEmbed.SetVariable(", shQuote(node), ")", sep=""),
+ paste("SamplesEmbed.SetVariable(", sQuote(node), ")", sep=""),
paste("BugsMappers.SetPrec(", getOption("BRugsPrec"), ")", sep="")
)
options(options.old)
Modified: trunk/BRugs/R/unix/internal.R
===================================================================
--- trunk/BRugs/R/unix/internal.R 2011-08-30 21:57:45 UTC (rev 210)
+++ trunk/BRugs/R/unix/internal.R 2011-08-31 09:28:44 UTC (rev 211)
@@ -1,36 +1,4 @@
-dquote <- function(x){
- paste("\"", x, "\"", sep="")
-}
-
.OpenBUGS.platform <- function(cmds, cmdtypes, args)
{
- ncmds <- length(cmds)
- if (ncmds > 99999) stop("Maximum number of OpenBUGS API commands exceeded")
- tempDir <- getOption("BRugsTmpdir")
- ## Don't want internalize/externalize to overwrite the command
- ## output buffer, so redirect its output to a separate trash can.
- trashDir <- paste(tempDir, "_trash", sep="")
- extFile <- getOption("BRugsExtFile")
- pkgPath <- searchpaths()[search()=="package:BRugs"]
- bugsPath <- paste(pkgPath, "/exec/BugsHelper", sep="")
- shcmd <- paste(bugsPath, dquote(tempDir), dquote(trashDir), dquote(extFile))
- for (i in 1:ncmds) {
- if (cmdtypes[i] %in% c("CharArray","RealArray"))
- cat(args[[i]], file=paste(tempDir, "/input",i,".txt", sep=""))
- cmdtype <- match(cmdtypes[i], .OpenBUGS.cmdtypes) - 1
- shcmd <- paste(shcmd, dquote(cmds[i]), cmdtype)
- }
- res <- system(shcmd)
- handleRes(res)
- out <- vector(ncmds, mode="list")
- for (i in 1:ncmds) {
- if (cmdtypes[i] %in% c("Integer","CharArray","RealArray"))
- out[[i]] <- scan(paste(tempDir,"/output",i,".txt",sep=""),
- switch(cmdtypes[i],
- "Integer" = integer(),
- "CharArray" = character(),
- "RealArray" = double()),
- quiet=TRUE)
- }
- out
+ .OpenBUGS.helper(cmds, cmdtypes, args)
}
Modified: trunk/BRugs/R/unix/zzz.R
===================================================================
--- trunk/BRugs/R/unix/zzz.R 2011-08-30 21:57:45 UTC (rev 210)
+++ trunk/BRugs/R/unix/zzz.R 2011-08-31 09:28:44 UTC (rev 211)
@@ -4,16 +4,16 @@
## TODO any need for these to be user specifiable?
options("BRugsTmpdir" = gsub("\\\\", "/", tempdir()))
options("BRugsExtFile" = paste(basename(tempfile()), ".bug", sep=""))
- options(OpenBUGS = "/usr/local/lib/OpenBUGS")
+ options(OpenBUGS = "/usr/local/lib/OpenBUGS/lib")
options(OpenBUGSdoc = "/usr/local/lib/OpenBUGS/doc")
options(OpenBUGSExamples = paste(options()$OpenBUGSdoc, "Examples", sep="/"))
if(is.null(getOption("BRugsVerbose")))
options("BRugsVerbose" = TRUE)
.initGlobals()
- ver <- system("echo \"modelQuit()\" | /usr/local/lib/OpenBUGS/bin/OpenBUGS", intern=TRUE)
+ ver <- system("echo \"modelQuit()\" | /usr/local/lib/OpenBUGS/lib/../bin/OpenBUGS", intern=TRUE)
ver <- sub("OpenBUGS version (([0-9]\\.)+[0-9]).+","\\1",ver[1])
- packageStartupMessage("Welcome to BRugs running on OpenBUGS version ", ver)
+ packageStartupMessage("Welcome to BRugs connected to OpenBUGS version ", ver)
}
".onUnload" <- function(libpath){
Modified: trunk/BRugs/R/unix/zzz.R.in
===================================================================
--- trunk/BRugs/R/unix/zzz.R.in 2011-08-30 21:57:45 UTC (rev 210)
+++ trunk/BRugs/R/unix/zzz.R.in 2011-08-31 09:28:44 UTC (rev 211)
@@ -11,9 +11,9 @@
if(is.null(getOption("BRugsVerbose")))
options("BRugsVerbose" = TRUE)
.initGlobals()
- ver <- system("echo \"modelQuit()\" | @OPENBUGS@/bin/OpenBUGS", intern=TRUE)
+ ver <- system("echo \"modelQuit()\" | @OPENBUGS@/../bin/OpenBUGS", intern=TRUE)
ver <- sub("OpenBUGS version (([0-9]\\.)+[0-9]).+","\\1",ver[1])
- packageStartupMessage("Welcome to BRugs running on OpenBUGS version ", ver)
+ packageStartupMessage("Welcome to BRugs connected to OpenBUGS version ", ver)
}
".onUnload" <- function(libpath){
Added: trunk/BRugs/R/windows/findOpenBUGS.R
===================================================================
--- trunk/BRugs/R/windows/findOpenBUGS.R (rev 0)
+++ trunk/BRugs/R/windows/findOpenBUGS.R 2011-08-31 09:28:44 UTC (rev 211)
@@ -0,0 +1,43 @@
+findOpenBUGS <- function()
+{
+ dir <- Sys.getenv("OpenBUGS_PATH")
+ if(!nchar(dir)){
+ deps <- utils:::packageDescription("BRugs", fields="SystemRequirements")
+ version.req <- gsub(".*OpenBUGS ?\\(>= ?(.+)\\).*", "\\1", deps)
+
+ key <- if (.Platform$r_arch == "x64") "Software\\Wow6432Node\\OpenBUGS" else "Software\\OpenBUGS"
+ ob.reg <- try(utils:::readRegistry(key, "HLM"), silent = TRUE)
+ ## ob.reg <- try(utils:::readRegistry("Software\\OpenBUGS", "HLM", view = "32-bit"), silent = TRUE)
+ if (inherits(ob.reg, "try-error")) {
+ warning("OpenBUGS ", version.req, " or greater must be installed\n(if so, this indicates missing registry keys of OpenBUGS).\nSetting the environment variable 'OpenBUGS_PATH' in advance of loading 'BRugs' overwrites the path.\nSee ?loadOpenBUGS in order to load OpenBUGS manually.")
+ return()
+ }
+ rnames <- names(ob.reg)
+ version.full <- gsub("OpenBUGS ", "", rnames)
+ ## remove suffixes from development versions, converts e.g. 3.2.1alpha to 3.2.1
+ version.inst <- gsub("(.+[0-9]+)[a-zA-Z]+$","\\1", version.full)
+
+ if(length(version.inst > 1)){
+ id <- which(apply(outer(version.inst, version.inst, Vectorize(compareVersion, c("a", "b"))), 1, function(x) all(x >= 0)))
+ id <- max(id) # if more than one release with same number, arbitrarily choose last one in registry
+ version.inst <- version.inst[id]
+ version.full <- version.full[id]
+ rnames <- rnames[id]
+ }
+
+ if (compareVersion(version.inst, version.req) < 0) {
+ warning("Found OpenBUGS version ", version.inst, ".\n Requires ", version.req, " or greater.\nSetting the environment variable 'OpenBUGS_PATH' in advance of loading 'BRugs' overwrites the path.\nSee ?loadOpenBUGS in order to load OpenBUGS manually.")
+ return()
+ }
+
+ ## OpenBUGS installation location
+ dir <- utils:::readRegistry(paste("Software","OpenBUGS",rnames,sep="\\"), "HLM", view = "32-bit")[["InstallPath"]]
+ } else {
+ if(!file.exists(file.path(dir, "libOpenBUGS.dll"))){
+ warning("Environment variable OpenBUGS_PATH found but cannot access ", file.path(dir, "libOpenBUGS.dll"))
+ return()
+ }
+ version.inst <- NA
+ }
+ list(dir=dir, version=version.full)
+}
Modified: trunk/BRugs/R/windows/internal.R
===================================================================
--- trunk/BRugs/R/windows/internal.R 2011-08-30 21:57:45 UTC (rev 210)
+++ trunk/BRugs/R/windows/internal.R 2011-08-31 09:28:44 UTC (rev 211)
@@ -2,31 +2,39 @@
.OpenBUGS.platform <- function(cmds, cmdtypes, args)
{
- ncmds <- length(cmds)
- out <- vector(ncmds, mode="list")
- for (i in 1:ncmds) {
- out[[i]] <- switch(cmdtypes[i],
- "CmdInterpreter" = {
- res <- .C("CmdInterpreter", cmds[i], nchar(cmds[i]), integer(1))
- handleRes(res[[3]])
- res
- },
- "Integer" = {
- values <- .C("Integer", cmds[i], nchar(cmds[i]), integer(1), integer(1))
- handleRes(values[[4]])
- as.integer(values[[3]])
- },
- "CharArray" = {
- values <- .C("CharArray", cmds[i], nchar(cmds[i]), args[[i]], nchar(args[[i]]), integer(1))
- handleRes(values[[5]])
- values[[3]]
- },
- "RealArray" = {
- values <- .C("RealArray", cmds[i], nchar(cmds[i]), args[[i]], length(args[[i]]), integer(1))
- handleRes(values[[5]])
- values[[3]]
- })
+ if (.Platform$r_arch == "x64"){
+ out <- .OpenBUGS.helper(cmds, cmdtypes, args)
+ }
+ else if (.Platform$r_arch == "i386") {
+ ncmds <- length(cmds)
+ out <- vector(ncmds, mode="list")
+ for (i in 1:ncmds) {
+ out[[i]] <- switch(cmdtypes[i],
+ "CmdInterpreter" = {
+ res <- .C("CmdInterpreter", cmds[i], nchar(cmds[i]), integer(1), PACKAGE="libOpenBUGS")
+ handleRes(res[[3]])
+ res
+ },
+ "Integer" = {
+ values <- .C("Integer", cmds[i], nchar(cmds[i]), integer(1), integer(1), PACKAGE="libOpenBUGS")
+ handleRes(values[[4]])
+ as.integer(values[[3]])
+ },
+ "CharArray" = {
+ values <- .C("CharArray", cmds[i], nchar(cmds[i]), args[[i]], nchar(args[[i]]), integer(1), PACKAGE="libOpenBUGS")
+ handleRes(values[[5]])
+ values[[3]]
+ },
+ "RealArray" = {
+ values <- .C("RealArray", cmds[i], nchar(cmds[i]), args[[i]], length(args[[i]]), integer(1), PACKAGE="libOpenBUGS")
+ handleRes(values[[5]])
+ values[[3]]
+ })
- }
- out
+ }
+ }
+ else {
+ stop("Unknown architecture ", .Platform$r_arch, " , should be i386 or x64")
+ }
+ out
}
Modified: trunk/BRugs/R/windows/zzz.R
===================================================================
--- trunk/BRugs/R/windows/zzz.R 2011-08-30 21:57:45 UTC (rev 210)
+++ trunk/BRugs/R/windows/zzz.R 2011-08-31 09:28:44 UTC (rev 211)
@@ -1,75 +1,27 @@
if (is.R()){
".onLoad" <- function(lib, pkg){
- if(.Platform[["r_arch"]] != "i386"){
- stop("BRugs only works for 32-bit R")
+ if (.Platform$r_arch == "i386") {
+ .onLoad.i386(lib, pkg)
}
- dir <- Sys.getenv("OpenBUGS_PATH")
- if(!nchar(dir)){
- deps <- utils:::packageDescription("BRugs", fields="SystemRequirements")
- version.req <- gsub(".*OpenBUGS ?\\(>= ?(.+)\\).*", "\\1", deps)
-
- ob.reg <- try(utils:::readRegistry("Software\\OpenBUGS", "HLM", view = "32-bit"), silent = TRUE)
- if (inherits(ob.reg, "try-error")) {
- warning("OpenBUGS ", version.req, " or greater must be installed\n(if so, this indicates missing registry keys of OpenBUGS).\nSetting the environment variable 'OpenBUGS_PATH' in advance of loading 'BRugs' overwrites the path.\nSee ?loadOpenBUGS in order to load OpenBUGS manually.")
- return()
- }
- rnames <- names(ob.reg)
- ver <- gsub("OpenBUGS ", "", rnames)
- version.inst <- gsub("(.+)e$","\\1", ver)
-
- if(length(version.inst > 1)){
- id <- which(apply(outer(version.inst, version.inst, Vectorize(compareVersion, c("a", "b"))), 1, function(x) all(x >= 0)))
- version.inst <- version.inst[id]
- rnames <- rnames[id]
- }
-
- if (compareVersion(version.inst, version.req) < 0) {
- warning("Found OpenBUGS version ", version.inst, ".\n Requires ", version.req, " or greater.\nSetting the environment variable 'OpenBUGS_PATH' in advance of loading 'BRugs' overwrites the path.\nSee ?loadOpenBUGS in order to load OpenBUGS manually.")
- return()
- }
- ## OpenBUGS installation location
- dir <- utils:::readRegistry(paste("Software","OpenBUGS",rnames,sep="\\"), "HLM", view = "32-bit")[["InstallPath"]]
- loadOpenBUGS(dir)
- packageStartupMessage("Welcome to BRugs running on OpenBUGS version ", version.inst)
- } else {
- if(!file.exists(file.path(dir, "libOpenBUGS.dll"))){
- warning("Environment variable OpenBUGS_PATH found but cannot access ", file.path(dir, "libOpenBUGS.dll"))
- return()
- }
- loadOpenBUGS(dir)
- packageStartupMessage("Welcome to BRugs connected to OpenBUGS in\n", dir)
+ else if (.Platform$r_arch == "x64"){
+ .onLoad.x64(lib, pkg)
}
- }
-
- ## Load OpenBUGS from specified location
- loadOpenBUGS <- function(dir) {
- libname <- paste(dir, "libOpenBUGS.dll", sep="/")
- if (!file.exists(libname)) {
- warning("Shared library \"libOpenBUGS.dll\" not found in ", dir)
- return(FALSE)
+ else {
+ stop("Unknown architecture ", .Platform$r_arch, " , should be i386 or x64")
}
- options(OpenBUGS = dir)
- dyn.load(libname)
- len <- nchar(dir)
- .C("SetWorkingDir", as.character(dir), len)
- ## Set temporary dir for "buffer.txt" output
- tempDir <- gsub("\\\\", "/", tempdir())
- .C("SetTempDir", as.character(tempDir), nchar(tempDir))
- command <- "BugsMappers.SetDest(2)"
- .CmdInterpreter(command)
- if(is.null(getOption("BRugsVerbose")))
- options("BRugsVerbose" = TRUE)
- .initGlobals()
- options(OpenBUGSExamples = paste(dir, "Examples", sep="/"))
- invisible()
}
".onUnload" <- function(libpath){
- if(is.loaded("CmdInterpreter")) {
- libname <- paste(options()$OpenBUGS, "libOpenBUGS.dll", sep="/")
- dyn.unload(libname)
+ if (.Platform$r_arch == "i386") {
+ .onUnload.i386(libpath)
}
- }
+ else if (.Platform$r_arch == "x64"){
+ .onUnload.x64(libpath)
+ }
+ else {
+ stop("Unknown architecture ", .Platform$r_arch, " , should be i386 or x64")
+ }
+ }
}
Added: trunk/BRugs/R/windows/zzz.i386.R
===================================================================
--- trunk/BRugs/R/windows/zzz.i386.R (rev 0)
+++ trunk/BRugs/R/windows/zzz.i386.R 2011-08-31 09:28:44 UTC (rev 211)
@@ -0,0 +1,40 @@
+".onLoad.i386" <- function(lib, pkg){
+ ob <- findOpenBUGS()
+ loadOpenBUGS(ob$dir)
+ msg <- paste("Welcome to BRugs connected to OpenBUGS")
+ if (!is.na(ob$version))
+ msg <- paste(msg, "version", ob$version)
+ else msg <- paste(msg, "in directory", ob$dir)
+ packageStartupMessage(msg)
+}
+
+".onUnload.i386" <- function(libpath){
+ if(is.loaded("CmdInterpreter")) {
+ libname <- paste(options()$OpenBUGS, "libOpenBUGS.dll", sep="/")
+ dyn.unload(libname)
+ }
+}
+
+## Load OpenBUGS from specified location
+loadOpenBUGS <- function(dir) {
+ libname <- paste(dir, "libOpenBUGS.dll", sep="/")
+ if (!file.exists(libname)) {
+ warning("Shared library \"libOpenBUGS.dll\" not found in ", dir)
+ return(FALSE)
+ }
+ options(OpenBUGS = dir)
+ dyn.load(libname)
+ len <- nchar(dir)
+ .C("SetWorkingDir", as.character(dir), len)
+ ## Set temporary dir for "buffer.txt" output
+ tempDir <- gsub("\\\\", "/", tempdir())
+ .C("SetTempDir", as.character(tempDir), nchar(tempDir))
+ command <- "BugsMappers.SetDest(2)"
+ .CmdInterpreter(command)
+ if(is.null(getOption("BRugsVerbose")))
+ options("BRugsVerbose" = TRUE)
+ .initGlobals()
+ options(OpenBUGSExamples = paste(dir, "Examples", sep="/"))
+ invisible()
+}
+
Added: trunk/BRugs/R/windows/zzz.x64.R
===================================================================
--- trunk/BRugs/R/windows/zzz.x64.R (rev 0)
+++ trunk/BRugs/R/windows/zzz.x64.R 2011-08-31 09:28:44 UTC (rev 211)
@@ -0,0 +1,25 @@
+if (is.R()){
+
+ ".onLoad.x64" <- function(lib, pkg){
+ ## TODO any need for these to be user specifiable?
+ options("BRugsTmpdir" = gsub("\\\\", "/", tempdir()))
+ options("BRugsExtFile" = paste(basename(tempfile()), ".bug", sep=""))
+ options(OpenBUGS = "C:/Program Files (x86)/OpenBUGS/OpenBUGS321")
+ options(OpenBUGSdoc = "C:/Program Files (x86)/OpenBUGS/OpenBUGS321")
+ options(OpenBUGSExamples = paste(options()$OpenBUGSdoc, "Examples", sep="/"))
+
+ if(is.null(getOption("BRugsVerbose")))
+ options("BRugsVerbose" = TRUE)
+ .initGlobals()
+ ob <- findOpenBUGS()
+ msg <- paste("Welcome to BRugs connected to OpenBUGS")
+ if (!is.na(ob$version))
+ msg <- paste(msg, " version ", ob$version)
+ else msg <- paste(msg, " in directory ", ob$dir)
+ packageStartupMessage(msg)
+ }
+
+ ".onUnload.x64" <- function(libpath){
+ }
+
+}
Added: trunk/BRugs/R/windows/zzz.x64.R.in
===================================================================
--- trunk/BRugs/R/windows/zzz.x64.R.in (rev 0)
+++ trunk/BRugs/R/windows/zzz.x64.R.in 2011-08-31 09:28:44 UTC (rev 211)
@@ -0,0 +1,25 @@
+if (is.R()){
+
+ ".onLoad" <- function(lib, pkg){
+ ## TODO any need for these to be user specifiable?
+ options("BRugsTmpdir" = gsub("\\\\", "/", tempdir()))
+ options("BRugsExtFile" = paste(basename(tempfile()), ".bug", sep=""))
+ options(OpenBUGS = "@OPENBUGS@")
+ options(OpenBUGSdoc = "@OPENBUGSDOC@")
+ options(OpenBUGSExamples = paste(options()$OpenBUGSdoc, "Examples", sep="/"))
+
+ if(is.null(getOption("BRugsVerbose")))
+ options("BRugsVerbose" = TRUE)
+ .initGlobals()
+ ob <- findOpenBUGS()
+ msg <- paste("Welcome to BRugs connected to OpenBUGS")
+ if (!is.na(ob$version))
+ msg <- paste(msg, " version ", ob$version)
+ else msg <- paste(msg, " in directory ", ob$dir)
+ packageStartupMessage(msg)
+ }
+
+ ".onUnload" <- function(libpath){
+ }
+
+}
Modified: trunk/BRugs/configure
===================================================================
--- trunk/BRugs/configure 2011-08-30 21:57:45 UTC (rev 210)
+++ trunk/BRugs/configure 2011-08-31 09:28:44 UTC (rev 211)
@@ -556,6 +556,7 @@
ac_default_prefix=/usr/local
ac_subst_vars='LTLIBOBJS
LIBOBJS
+DYNLIBEXT
OPENBUGSDOC
OPENBUGS
OBJEXT
@@ -2726,6 +2727,14 @@
LDFLAGS=${OLDFLAGS}
+VERSION=`echo "modelQuit()" | ${OPENBUGS}/bin/OpenBUGS | sed -ne "s/OpenBUGS version \(.*\) rev \(.*\)/\1/p"`
+if test `echo ${VERSION} |cut -d. -f1` -lt 3; then
+ as_fn_error "Requires OpenBUGS version 3.2.1 or greater" "$LINENO" 5
+fi
+if test `echo ${VERSION} |cut -d. -f1` -eq 3 -a `echo ${VERSION} |cut -d. -f2` -lt 2 ; then
+ as_fn_error "Requires OpenBUGS version 3.2.1 or greater" "$LINENO" 5
+fi
+
if ${SOURCEINST} ; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: Found OpenBUGS installation from source package " >&5
$as_echo "$as_me: Found OpenBUGS installation from source package " >&6;}
@@ -2736,16 +2745,12 @@
OPENBUGSDOC=${OPENBUGS}/share/doc/openbugs-${VERSION}
fi
-VERSION=`echo "modelQuit()" | ${OPENBUGS}/bin/OpenBUGS | sed -ne "s/OpenBUGS version \(.*\) rev \(.*\)/\1/p"`
-if test `echo ${VERSION} |cut -d. -f1` -lt 3; then
- as_fn_error "Requires OpenBUGS version 3.2.1 or greater" "$LINENO" 5
-fi
-if test `echo ${VERSION} |cut -d. -f1` -eq 3 -a `echo ${VERSION} |cut -d. -f2` -lt 2 ; then
- as_fn_error "Requires OpenBUGS version 3.2.1 or greater" "$LINENO" 5
-fi
+OPENBUGS=${OPENBUGS}/lib
+DYNLIBEXT="so"
+
ac_config_files="$ac_config_files src/Makevars"
cat >confcache <<\_ACEOF
Modified: trunk/BRugs/configure.ac
===================================================================
--- trunk/BRugs/configure.ac 2011-08-30 21:57:45 UTC (rev 210)
+++ trunk/BRugs/configure.ac 2011-08-31 09:28:44 UTC (rev 211)
@@ -59,7 +59,11 @@
OPENBUGSDOC=${OPENBUGS}/share/doc/openbugs-${VERSION}
fi
+OPENBUGS=${OPENBUGS}/lib
+DYNLIBEXT="so"
+
AC_SUBST(OPENBUGS)
AC_SUBST(OPENBUGSDOC)
+AC_SUBST(DYNLIBEXT)
AC_OUTPUT(src/Makevars)
AC_OUTPUT(R/unix/zzz.R)
Modified: trunk/BRugs/configure.win
===================================================================
--- trunk/BRugs/configure.win 2011-08-30 21:57:45 UTC (rev 210)
+++ trunk/BRugs/configure.win 2011-08-31 09:28:44 UTC (rev 211)
@@ -0,0 +1,13 @@
+## Configure script only needed for 64 bit Windows, where BRugs calls
+## the 32-bit OpenBUGS library via a helper application. First find
+## the location of the OpenBUGS installation.
+
+OPENBUGS=`"${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" configure.win.R`
+
+## Install the OpenBUGS DLL into the package. There is no Windows
+## equivalent of $rpath for adding to the dynamic link path, therefore
+## the DLL is installed in the same directory as the helper
+## executable.
+
+OPENBUGSLIB="$OPENBUGS/libOpenBUGS.dll"
+cp "$OPENBUGSLIB" exec
Added: trunk/BRugs/configure.win.R
===================================================================
--- trunk/BRugs/configure.win.R (rev 0)
+++ trunk/BRugs/configure.win.R 2011-08-31 09:28:44 UTC (rev 211)
@@ -0,0 +1,20 @@
+## Find OpenBUGS installation location
+source("R/windows/findOpenBUGS.R")
+OPENBUGS <- findOpenBUGS()$dir
+OPENBUGS <- gsub("\\\\","/",OPENBUGS)
+
+dummy <- file.copy("src/Makevars.in","src/Makefile.win", overwrite=TRUE)
+x <- readLines("src/Makefile.win")
+x <- gsub("@OPENBUGS@", dQuote(OPENBUGS), x, fixed=TRUE)
+x <- gsub("@DYNLIBEXT@", "dll", x, fixed=TRUE)
+writeLines(x, "src/Makefile.win")
+
+dummy <- file.copy("R/windows/zzz.x64.R.in","R/windows/zzz.x64.R", overwrite=TRUE)
+x <- readLines("R/windows/zzz.x64.R")
+x <- gsub("@OPENBUGS@", OPENBUGS, x, fixed=TRUE)
+x <- gsub("@OPENBUGSDOC@", OPENBUGS, x, fixed=TRUE)
+x <- gsub("\".onLoad\"[[:space:]]*<-[[:space:]]*function", "\".onLoad.x64\" <- function", x)
+x <- gsub("\".onUnload\"[[:space:]]*<-[[:space:]]*function", "\".onUnload.x64\" <- function", x)
+writeLines(x, "R/windows/zzz.x64.R")
+
+cat(OPENBUGS)
Property changes on: trunk/BRugs/exec
___________________________________________________________________
Added: svn:ignore
+ BugsHelper
Modified: trunk/BRugs/man/BRugs.Rd
===================================================================
--- trunk/BRugs/man/BRugs.Rd 2011-08-30 21:57:45 UTC (rev 210)
+++ trunk/BRugs/man/BRugs.Rd 2011-08-31 09:28:44 UTC (rev 211)
@@ -35,6 +35,15 @@
with types of model that are currently not featured. If there is a problem, BRugs might just crash, which is not
very good, but it might well carry on and produce answers that are wrong, which is even worse. Please let us know
of any successes or failures.
+
+ If BRugs does cause R to crash, it is advised to run the model from
+ within the Windows interface to OpenBUGS. This should give a "Trap"
+ window, which indicates an internal problem with OpenBUGS. See
+
+ \url{http://www.openbugs.info/Manuals/TipsTroubleshooting.html#TrapMessages}
+
+ for suggestions for how to interpret these problematic error
+ messages.
}
%\references{}
\seealso{\code{\link{help.WinBUGS}} (which currently is called from \code{help.BRugs}) and the meta function \code{\link{BRugsFit}}}
Property changes on: trunk/BRugs/src
___________________________________________________________________
Added: svn:ignore
+ BRugs.dll
Makevars
Makevars.win
Modified: trunk/BRugs/src/BugsHelper.c
===================================================================
--- trunk/BRugs/src/BugsHelper.c 2011-08-30 21:57:45 UTC (rev 210)
+++ trunk/BRugs/src/BugsHelper.c 2011-08-31 09:28:44 UTC (rev 211)
@@ -1,68 +1,77 @@
/* BugsHelper - Perform one or more OpenBUGS API commands as specified
in the command line arguments.
-ARGUMENTS (not named)
+ARGUMENTS (not named)
argv[1]: Full path to temporary directory containing the buffer file
for messages from the main API commands, and any input and output
corresponding to the commands.
-
+
argv[2]: Full path to temporary directory containing the buffer file
for messages from the Internalize and Externalize commands. We do not
- want these to overwrite the main buffer.
-
+ want these to overwrite the main buffer.
+
argv[3]: Name of the file used to store the externalized model
- state. This will be saved in the directory specified in argv[1].
-
- The remaining arguments argv[4], argv[5], ... specify any number of
- calls to OpenBUGS API functions. These are given in the order:
-
- cmd, cmdtype, cmd, cmdtype, ...
-
+ state. This will be saved in the directory specified in argv[1].
+
+ argv[4]: Name of the command file, which contains a list of
+ calls to OpenBUGS API functions and the types of each call.
+ These are given on alternate lines of this file, in the order:
+
+ cmd, cmdtype, cmd, cmdtype, ...
+
where "cmd" is an OpenBUGS API command, and "cmdtype" is an integer
specifying the API function being called. Currently allowed values of
"cmdtype" are
-
- 0 : if "cmd" is a call to the "CmdInterpreter" API function
+
+ 0 : if "cmd" is a call to the "CmdInterpreter" API function
1 : if "cmd" is a call to the "Integer" API function
2 : if "cmd" is a call to the "CharArray" API function
3 : if "cmd" is a call to the "RealArray" API function
-
+ 4 : if "cmd" is a call to "BugsCmd" (currently unused in BRugs, and not tested)
-INPUT AND OUTPUT
+ argv[5]: Number of commands contained in the command file.
+INPUT AND OUTPUT
+
Some OpenBUGS commands require input or produce output. The input and
output for the Nth command given in the call to BugsHelper are stored
in files called inputN.txt and outputN.txt, and are saved in the
directory specified in argv[1].
-
-EXAMPLE
+EXAMPLE
+
The following command checks a BUGS model file stored in the file
/path/to/Examples/Ratsmodel.txt and then loads a data file from
/path/to/Examples/Ratsdata.txt. Temporary files are stored in
subdirectories of /tmp.
-
+
"BugsEmbed.SetFilePath('/scratch/chris/lib/R/BRugs/OpenBUGS/Examples/Ratsdata.txt');BugsEmbed.LoadDataGuard;BugsEmbed.LoadData" 0
-
+
/path/to/BugsHelper "/tmp/RtmpaRQois" "/tmp/RtmpaRQois_trash" "file327b23c6.bug" "BugsEmbed.SetFilePath('/path/to/Examples/Ratsmodel.txt');BugsEmbed.ParseGuard;BugsEmbed.Parse" 0 "BugsEmbed.SetFilePath('/path/to/Examples/Ratsdata.txt');BugsEmbed.LoadDataGuard;BugsEmbed.LoadData" 0
-
+
+TODO
+ How to handle an OpenBUGS "trap"? If the library call terminates with a crash, then BugsHelper terminates with an error code of 1.
+ But this error code is also used for "unknown module" internal errors which are handled. How to distinguish?
+
+
AUTHOR
- Chris Jackson <chr...@mr...>
+ Chris Jackson <chr...@mr...>
- */
+ */
#include <stdio.h>
#include <string.h>
#include <stdlib.h>
#include <sys/stat.h>
+#include <assert.h>
-#define NODEBUG
+#define NODEBUG
-/* OpenBUGS API functions from libOpenBUGS.so */
+/* OpenBUGS API functions from libOpenBUGS.so */
int errno;
extern void CLI ();
extern void BugsCmd(char **command, int *len);
@@ -82,7 +91,7 @@
char *fname;
struct stat buf;
FILE *ifp;
- double tmp;
+ double tmp;
fname = (char *) malloc(strlen(tmpdir) + 16);
sprintf(fname, "%s/input%d.txt", tmpdir, cmdno);
if (stat(fname, &buf) != -1) {
@@ -178,7 +187,7 @@
}
int do_Cmd(char *cmd) {
- int length, res;
+ int length, res=0;
length = strlen(cmd);
#ifdef DEBUG
printf("%s: %d\n", cmd, strlen(cmd));
@@ -188,7 +197,7 @@
}
int do_Integer(char *cmd, char *tmpdir, int cmdno) {
- int length, out, res;
+ int length, out, res=0;
// doesn't need input -- assume only used for reading integers
length = strlen(cmd);
#ifdef DEBUG
@@ -200,7 +209,7 @@
}
int do_CharArray(char *cmd, char *tmpdir, int cmdno) {
- int length, outlength, res;
+ int length, outlength, res=0;
char *out;
length = strlen(cmd);
read_input_char(tmpdir, &out, &outlength, cmdno);
@@ -214,7 +223,10 @@
}
int do_RealArray(char *cmd, char *tmpdir, int cmdno) {
- int length, outlength, res;
+ int length, outlength, res=0;
+#ifdef DEBUG
+ int i;
+#endif
double *out;
read_input_real(tmpdir, &out, &outlength, cmdno);
length = strlen(cmd);
@@ -229,6 +241,15 @@
return res;
}
+void do_BugsCmd(char *cmd) {
+ int length;
+ length = strlen(cmd);
+#ifdef DEBUG
+ printf("%s: %d\n", cmd, strlen(cmd));
+#endif
+ BugsCmd(&cmd, &length);
+}
+
int do_Internalize(char *tmpdir, char *extfile){
char *extpath, *int_cmd;
struct stat buf;
@@ -241,7 +262,7 @@
res = do_Cmd(int_cmd);
free(int_cmd);
}
- else res = 10; /* TODO handle error */
+ else res = 10; /* TODO handle error */
free(extpath);
return res;
}
@@ -257,20 +278,39 @@
}
int main(int argc, char **argv){
- int i, res, ncmds;
+#ifdef DEBUG
+ printf("Entering BUGSHelper...\n");
+#endif
+ int i, res=0, ncmds, len;
char *tmpdir = argv[1];
char *trashdir = argv[2];
char *extfile = argv[3];
- char *cmd, cmd_type;
+ char *cmdfile = argv[4];
+ char *cmd, cmd_type;
char *output_to_buffer_cmd = "BugsMappers.SetDest(2)";
+ FILE *ifp;
+ struct stat buf;
do_Cmd(output_to_buffer_cmd);
do_TempDir(trashdir);
do_Internalize(tmpdir, extfile);
do_TempDir(tmpdir);
- ncmds = (argc - 3) / 2;
- for (i=0; i<ncmds; ++i) {
- cmd = argv[4 + i*2];
- cmd_type = argv[5 + i*2][0];
+
+// Commands and command type IDs are read from alternate lines of command file
+ ifp = fopen(cmdfile, "r");
+ assert(stat(cmdfile, &buf) != -1);
+ len = buf.st_size;
+ cmd = (char *) malloc(len + 1); // command cannot be bigger than the command file
+ sscanf(argv[5], "%d", &ncmds);
+
+ for (i=0; i<ncmds; ++i) {
+ len = 0;
+ while((cmd[len] = getc(ifp)) != '\n') {
+ ++len;
+ }
+ cmd[len] = '\0';
+ cmd_type = getc(ifp);
+ assert(getc(ifp) == '\n');
+
#ifdef DEBUG
printf("%s, type %c of %d cmds\n", cmd, cmd_type, ncmds);
#endif
@@ -287,9 +327,13 @@
case '3':
res = do_RealArray(cmd, tmpdir, i+1);
break;
+ case '4':
+ do_BugsCmd(cmd);
+ break;
}
- if (res > 0) return res;
+ if (res > 0) return res;
}
+ free(cmd);
do_TempDir(trashdir);
do_Externalize(tmpdir, extfile);
return res;
Modified: trunk/BRugs/src/Makefile.win
===================================================================
--- trunk/BRugs/src/Makefile.win 2011-08-30 21:57:45 UTC (rev 210)
+++ trunk/BRugs/src/Makefile.win 2011-08-31 09:28:44 UTC (rev 211)
@@ -1,2 +1,6 @@
-all:
-
+BUGS_LIBS = "C:/Program Files (x86)/OpenBUGS/OpenBUGS321"/libOpenBUGS.dll
+BUGS_LDFLAGS = -m32 -Wl,-rpath="C:/Program Files (x86)/OpenBUGS/OpenBUGS321"
+
+BugsHelper:
+ mkdir -p ../exec
+ $(CC) $(CFLAGS) $(LDFLAGS) $(BUGS_LDFLAGS) BugsHelper.c $(BUGS_LIBS) -o ../exec/BugsHelper
Modified: trunk/BRugs/src/Makevars.in
===================================================================
--- trunk/BRugs/src/Makevars.in 2011-08-30 21:57:45 UTC (rev 210)
+++ trunk/BRugs/src/Makevars.in 2011-08-31 09:28:44 UTC (rev 211)
@@ -1,5 +1,5 @@
-BUGS_LIBS = @OPENBUGS@/lib/libOpenBUGS.so
-BUGS_LDFLAGS = -m32 -Wl,-rpath=@OPENBUGS@/lib
+BUGS_LIBS = @OPENBUGS@/libOpenBUGS.@DYNLIBEXT@
+BUGS_LDFLAGS = -m32 -Wl,-rpath=@OPENBUGS@
BugsHelper:
mkdir -p ../exec
Modified: trunk/BRugs/tests/functions.R
===================================================================
--- trunk/BRugs/tests/functions.R 2011-08-30 21:57:45 UTC (rev 210)
+++ trunk/BRugs/tests/functions.R 2011-08-31 09:28:44 UTC (rev 211)
@@ -123,8 +123,8 @@
## Info functions
stopifnot(infoNodeMethods("alpha")[,"Type"] == "UpdaterNormal.StdUpdater")
stopifnot(infoNodeTypes("alpha")[1,"Type"]=="GraphNormal.Node")
-stopifnot(infoUpdatersbyName()["alpha.c","Type"]=="conjugatenormalupdater")
-stopifnot(infoUpdatersbyDepth()["alpha.c","Type"]=="conjugatenormalupdater")
+stopifnot(infoUpdatersbyName()["alpha.c","Type"]=="conjugate normal updater")
+stopifnot(infoUpdatersbyDepth()["alpha.c","Type"]=="conjugate normal updater")
mem <- infoMemory()
stopifnot(is.numeric(mem) && mem > 0)
stopifnot(any(infoModules()[,"Module"] == "Kernel"))
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
|
From: Uwe L. <li...@st...> - 2011-08-31 12:22:53
|
Chris, thanks for your modifications and the 64-bit code. Great! I will test during the weekend (I am about to travel in an hour or so). On 31.08.2011 11:28, chr...@us... wrote: > Revision: 211 > http://bugs-r.svn.sourceforge.net/bugs-r/?rev=211&view=rev > Author: chris-jackson > Date: 2011-08-31 09:28:44 +0000 (Wed, 31 Aug 2011) > Log Message: > ----------- > Changes to allow running on x64 R in Windows. The same helper facility as on Linux is used to call the 32-bit DLL. > > + stop(errors[res], "\nPlease report this bug to ", maintainer) May I object against this line of code? If there are BUGS traps, I am certainly not the person who likes to get the bug report, since I cannot help in that case anyway. > Added: trunk/BRugs/R/windows/findOpenBUGS.R > =================================================================== > --- trunk/BRugs/R/windows/findOpenBUGS.R (rev 0) > +++ trunk/BRugs/R/windows/findOpenBUGS.R 2011-08-31 09:28:44 UTC (rev 211) > @@ -0,0 +1,43 @@ > +findOpenBUGS<- function() > +{ > + dir<- Sys.getenv("OpenBUGS_PATH") > + if(!nchar(dir)){ > + deps<- utils:::packageDescription("BRugs", fields="SystemRequirements") > + version.req<- gsub(".*OpenBUGS ?\\(>= ?(.+)\\).*", "\\1", deps) > + > + key<- if (.Platform$r_arch == "x64") "Software\\Wow6432Node\\OpenBUGS" else "Software\\OpenBUGS" The above is implemented by the view argument in readRegistry. Why not use it? It will be safe in case Microsoft changes the names of registry keys again in the next version of Windows. You have not changed it below. > + ob.reg<- try(utils:::readRegistry(key, "HLM"), silent = TRUE) > + ## ob.reg<- try(utils:::readRegistry("Software\\OpenBUGS", "HLM", view = "32-bit"), silent = TRUE) > + ## remove suffixes from development versions, converts e.g. 3.2.1alpha to 3.2.1 Question is if we actually want to remove that in case we really require a release rather than the alpha version. > + version.inst<- gsub("(.+[0-9]+)[a-zA-Z]+$","\\1", version.full) > + > + if(length(version.inst> 1)){ > + id<- which(apply(outer(version.inst, version.inst, Vectorize(compareVersion, c("a", "b"))), 1, function(x) all(x>= 0))) > + id<- max(id) # if more than one release with same number, arbitrarily choose last one in registry > + version.inst<- version.inst[id] > + version.full<- version.full[id] > + rnames<- rnames[id] > + } > + > + if (compareVersion(version.inst, version.req)< 0) { > + warning("Found OpenBUGS version ", version.inst, ".\n Requires ", version.req, " or greater.\nSetting the environment variable 'OpenBUGS_PATH' in advance of loading 'BRugs' overwrites the path.\nSee ?loadOpenBUGS in order to load OpenBUGS manually.") > + return() > + } > + > + ## OpenBUGS installation location > + dir<- utils:::readRegistry(paste("Software","OpenBUGS",rnames,sep="\\"), "HLM", view = "32-bit")[["InstallPath"]] > + } else { > + if(!file.exists(file.path(dir, "libOpenBUGS.dll"))){ > + warning("Environment variable OpenBUGS_PATH found but cannot access ", file.path(dir, "libOpenBUGS.dll")) > + return() > + } > + version.inst<- NA > + } > + list(dir=dir, version=version.full) > +} > > Added: trunk/BRugs/R/windows/zzz.i386.R > =================================================================== > --- trunk/BRugs/R/windows/zzz.i386.R (rev 0) > +++ trunk/BRugs/R/windows/zzz.i386.R 2011-08-31 09:28:44 UTC (rev 211) > @@ -0,0 +1,40 @@ > +".onLoad.i386"<- function(lib, pkg){ > + ob<- findOpenBUGS() > + loadOpenBUGS(ob$dir) > + msg<- paste("Welcome to BRugs connected to OpenBUGS") > + if (!is.na(ob$version)) > + msg<- paste(msg, "version", ob$version) > + else msg<- paste(msg, "in directory", ob$dir) > + packageStartupMessage(msg) > +} > + > +".onUnload.i386"<- function(libpath){ > + if(is.loaded("CmdInterpreter")) { > + libname<- paste(options()$OpenBUGS, "libOpenBUGS.dll", sep="/") > + dyn.unload(libname) > + } > +} > + > +## Load OpenBUGS from specified location > +loadOpenBUGS<- function(dir) { > + libname<- paste(dir, "libOpenBUGS.dll", sep="/") > + if (!file.exists(libname)) { > + warning("Shared library \"libOpenBUGS.dll\" not found in ", dir) > + return(FALSE) > + } > + options(OpenBUGS = dir) > + dyn.load(libname) > + len<- nchar(dir) > + .C("SetWorkingDir", as.character(dir), len) > + ## Set temporary dir for "buffer.txt" output > + tempDir<- gsub("\\\\", "/", tempdir()) > + .C("SetTempDir", as.character(tempDir), nchar(tempDir)) > + command<- "BugsMappers.SetDest(2)" > + .CmdInterpreter(command) > + if(is.null(getOption("BRugsVerbose"))) > + options("BRugsVerbose" = TRUE) > + .initGlobals() > + options(OpenBUGSExamples = paste(dir, "Examples", sep="/")) > + invisible() > +} > + > > Added: trunk/BRugs/R/windows/zzz.x64.R > =================================================================== > --- trunk/BRugs/R/windows/zzz.x64.R (rev 0) > +++ trunk/BRugs/R/windows/zzz.x64.R 2011-08-31 09:28:44 UTC (rev 211) > @@ -0,0 +1,25 @@ > +if (is.R()){ > + > + ".onLoad.x64"<- function(lib, pkg){ > + ## TODO any need for these to be user specifiable? > + options("BRugsTmpdir" = gsub("\\\\", "/", tempdir())) > + options("BRugsExtFile" = paste(basename(tempfile()), ".bug", sep="")) > + options(OpenBUGS = "C:/Program Files (x86)/OpenBUGS/OpenBUGS321") > + options(OpenBUGSdoc = "C:/Program Files (x86)/OpenBUGS/OpenBUGS321") > + options(OpenBUGSExamples = paste(options()$OpenBUGSdoc, "Examples", sep="/")) Why not do it the same way as for 32-bit? The stuff is in the 32-bit view in the registry, hence findOpenBUGS results could be used here. The .in file is not helpful given we provide binaries for the package on CRAN and *my* installation will be inserted. Best wishes, uwe |
|
From: Uwe L. <li...@st...> - 2011-08-31 12:22:53
|
Chris, thanks for your modifications and the 64-bit code. Great! I will test during the weekend (I am about to travel in an hour or so). On 31.08.2011 11:28, chr...@us... wrote: > Revision: 211 > http://bugs-r.svn.sourceforge.net/bugs-r/?rev=211&view=rev > Author: chris-jackson > Date: 2011-08-31 09:28:44 +0000 (Wed, 31 Aug 2011) > Log Message: > ----------- > Changes to allow running on x64 R in Windows. The same helper facility as on Linux is used to call the 32-bit DLL. > > + stop(errors[res], "\nPlease report this bug to ", maintainer) May I object against this line of code? If there are BUGS traps, I am certainly not the person who likes to get the bug report, since I cannot help in that case anyway. > Added: trunk/BRugs/R/windows/findOpenBUGS.R > =================================================================== > --- trunk/BRugs/R/windows/findOpenBUGS.R (rev 0) > +++ trunk/BRugs/R/windows/findOpenBUGS.R 2011-08-31 09:28:44 UTC (rev 211) > @@ -0,0 +1,43 @@ > +findOpenBUGS<- function() > +{ > + dir<- Sys.getenv("OpenBUGS_PATH") > + if(!nchar(dir)){ > + deps<- utils:::packageDescription("BRugs", fields="SystemRequirements") > + version.req<- gsub(".*OpenBUGS ?\\(>= ?(.+)\\).*", "\\1", deps) > + > + key<- if (.Platform$r_arch == "x64") "Software\\Wow6432Node\\OpenBUGS" else "Software\\OpenBUGS" The above is implemented by the view argument in readRegistry. Why not use it? It will be safe in case Microsoft changes the names of registry keys again in the next version of Windows. You have not changed it below. > + ob.reg<- try(utils:::readRegistry(key, "HLM"), silent = TRUE) > + ## ob.reg<- try(utils:::readRegistry("Software\\OpenBUGS", "HLM", view = "32-bit"), silent = TRUE) > + ## remove suffixes from development versions, converts e.g. 3.2.1alpha to 3.2.1 Question is if we actually want to remove that in case we really require a release rather than the alpha version. > + version.inst<- gsub("(.+[0-9]+)[a-zA-Z]+$","\\1", version.full) > + > + if(length(version.inst> 1)){ > + id<- which(apply(outer(version.inst, version.inst, Vectorize(compareVersion, c("a", "b"))), 1, function(x) all(x>= 0))) > + id<- max(id) # if more than one release with same number, arbitrarily choose last one in registry > + version.inst<- version.inst[id] > + version.full<- version.full[id] > + rnames<- rnames[id] > + } > + > + if (compareVersion(version.inst, version.req)< 0) { > + warning("Found OpenBUGS version ", version.inst, ".\n Requires ", version.req, " or greater.\nSetting the environment variable 'OpenBUGS_PATH' in advance of loading 'BRugs' overwrites the path.\nSee ?loadOpenBUGS in order to load OpenBUGS manually.") > + return() > + } > + > + ## OpenBUGS installation location > + dir<- utils:::readRegistry(paste("Software","OpenBUGS",rnames,sep="\\"), "HLM", view = "32-bit")[["InstallPath"]] > + } else { > + if(!file.exists(file.path(dir, "libOpenBUGS.dll"))){ > + warning("Environment variable OpenBUGS_PATH found but cannot access ", file.path(dir, "libOpenBUGS.dll")) > + return() > + } > + version.inst<- NA > + } > + list(dir=dir, version=version.full) > +} > > Added: trunk/BRugs/R/windows/zzz.i386.R > =================================================================== > --- trunk/BRugs/R/windows/zzz.i386.R (rev 0) > +++ trunk/BRugs/R/windows/zzz.i386.R 2011-08-31 09:28:44 UTC (rev 211) > @@ -0,0 +1,40 @@ > +".onLoad.i386"<- function(lib, pkg){ > + ob<- findOpenBUGS() > + loadOpenBUGS(ob$dir) > + msg<- paste("Welcome to BRugs connected to OpenBUGS") > + if (!is.na(ob$version)) > + msg<- paste(msg, "version", ob$version) > + else msg<- paste(msg, "in directory", ob$dir) > + packageStartupMessage(msg) > +} > + > +".onUnload.i386"<- function(libpath){ > + if(is.loaded("CmdInterpreter")) { > + libname<- paste(options()$OpenBUGS, "libOpenBUGS.dll", sep="/") > + dyn.unload(libname) > + } > +} > + > +## Load OpenBUGS from specified location > +loadOpenBUGS<- function(dir) { > + libname<- paste(dir, "libOpenBUGS.dll", sep="/") > + if (!file.exists(libname)) { > + warning("Shared library \"libOpenBUGS.dll\" not found in ", dir) > + return(FALSE) > + } > + options(OpenBUGS = dir) > + dyn.load(libname) > + len<- nchar(dir) > + .C("SetWorkingDir", as.character(dir), len) > + ## Set temporary dir for "buffer.txt" output > + tempDir<- gsub("\\\\", "/", tempdir()) > + .C("SetTempDir", as.character(tempDir), nchar(tempDir)) > + command<- "BugsMappers.SetDest(2)" > + .CmdInterpreter(command) > + if(is.null(getOption("BRugsVerbose"))) > + options("BRugsVerbose" = TRUE) > + .initGlobals() > + options(OpenBUGSExamples = paste(dir, "Examples", sep="/")) > + invisible() > +} > + > > Added: trunk/BRugs/R/windows/zzz.x64.R > =================================================================== > --- trunk/BRugs/R/windows/zzz.x64.R (rev 0) > +++ trunk/BRugs/R/windows/zzz.x64.R 2011-08-31 09:28:44 UTC (rev 211) > @@ -0,0 +1,25 @@ > +if (is.R()){ > + > + ".onLoad.x64"<- function(lib, pkg){ > + ## TODO any need for these to be user specifiable? > + options("BRugsTmpdir" = gsub("\\\\", "/", tempdir())) > + options("BRugsExtFile" = paste(basename(tempfile()), ".bug", sep="")) > + options(OpenBUGS = "C:/Program Files (x86)/OpenBUGS/OpenBUGS321") > + options(OpenBUGSdoc = "C:/Program Files (x86)/OpenBUGS/OpenBUGS321") > + options(OpenBUGSExamples = paste(options()$OpenBUGSdoc, "Examples", sep="/")) Why not do it the same way as for 32-bit? The stuff is in the 32-bit view in the registry, hence findOpenBUGS results could be used here. The .in file is not helpful given we provide binaries for the package on CRAN and *my* installation will be inserted. Best wishes, uwe |
|
From: Uwe L. <li...@st...> - 2011-08-31 12:25:28
|
Chris, as a side note: I'd prefer not to copy the dlls into libs. In any case, it won't work the way you did it. Please R CMD build before R CMD INSTALL the tar file. I can take a look how to clean this up diring the weekend. I prefer to do things in Makevars.win rather than configure.win which makes it much harder to produce bi-arch binaries for BRugs. Uwe On 31.08.2011 14:01, Uwe Ligges wrote: > Chris, > > > thanks for your modifications and the 64-bit code. Great! I will test > during the weekend (I am about to travel in an hour or so). > > > > On 31.08.2011 11:28, chr...@us... wrote: >> Revision: 211 >> http://bugs-r.svn.sourceforge.net/bugs-r/?rev=211&view=rev >> Author: chris-jackson >> Date: 2011-08-31 09:28:44 +0000 (Wed, 31 Aug 2011) >> Log Message: >> ----------- >> Changes to allow running on x64 R in Windows. The same helper facility as on Linux is used to call the 32-bit DLL. >> >> + stop(errors[res], "\nPlease report this bug to ", maintainer) > > > > May I object against this line of code? > If there are BUGS traps, I am certainly not the person who likes to get > the bug report, since I cannot help in that case anyway. > > > >> Added: trunk/BRugs/R/windows/findOpenBUGS.R >> =================================================================== >> --- trunk/BRugs/R/windows/findOpenBUGS.R (rev 0) >> +++ trunk/BRugs/R/windows/findOpenBUGS.R 2011-08-31 09:28:44 UTC (rev 211) >> @@ -0,0 +1,43 @@ >> +findOpenBUGS<- function() >> +{ >> + dir<- Sys.getenv("OpenBUGS_PATH") >> + if(!nchar(dir)){ >> + deps<- utils:::packageDescription("BRugs", fields="SystemRequirements") >> + version.req<- gsub(".*OpenBUGS ?\\(>= ?(.+)\\).*", "\\1", deps) >> + >> + key<- if (.Platform$r_arch == "x64") "Software\\Wow6432Node\\OpenBUGS" else "Software\\OpenBUGS" > > > The above is implemented by the view argument in readRegistry. Why not > use it? It will be safe in case Microsoft changes the names of registry > keys again in the next version of Windows. You have not changed it below. > > > >> + ob.reg<- try(utils:::readRegistry(key, "HLM"), silent = TRUE) >> + ## ob.reg<- try(utils:::readRegistry("Software\\OpenBUGS", "HLM", view = "32-bit"), silent = TRUE) > > > >> + ## remove suffixes from development versions, converts e.g. 3.2.1alpha to 3.2.1 > > > Question is if we actually want to remove that in case we really require > a release rather than the alpha version. > > > >> + version.inst<- gsub("(.+[0-9]+)[a-zA-Z]+$","\\1", version.full) >> + >> + if(length(version.inst> 1)){ >> + id<- which(apply(outer(version.inst, version.inst, Vectorize(compareVersion, c("a", "b"))), 1, function(x) all(x>= 0))) >> + id<- max(id) # if more than one release with same number, arbitrarily choose last one in registry >> + version.inst<- version.inst[id] >> + version.full<- version.full[id] >> + rnames<- rnames[id] >> + } >> + >> + if (compareVersion(version.inst, version.req)< 0) { >> + warning("Found OpenBUGS version ", version.inst, ".\n Requires ", version.req, " or greater.\nSetting the environment variable 'OpenBUGS_PATH' in advance of loading 'BRugs' overwrites the path.\nSee ?loadOpenBUGS in order to load OpenBUGS manually.") >> + return() >> + } >> + >> + ## OpenBUGS installation location >> + dir<- utils:::readRegistry(paste("Software","OpenBUGS",rnames,sep="\\"), "HLM", view = "32-bit")[["InstallPath"]] >> + } else { >> + if(!file.exists(file.path(dir, "libOpenBUGS.dll"))){ >> + warning("Environment variable OpenBUGS_PATH found but cannot access ", file.path(dir, "libOpenBUGS.dll")) >> + return() >> + } >> + version.inst<- NA >> + } >> + list(dir=dir, version=version.full) >> +} >> > > > > >> Added: trunk/BRugs/R/windows/zzz.i386.R >> =================================================================== >> --- trunk/BRugs/R/windows/zzz.i386.R (rev 0) >> +++ trunk/BRugs/R/windows/zzz.i386.R 2011-08-31 09:28:44 UTC (rev 211) >> @@ -0,0 +1,40 @@ >> +".onLoad.i386"<- function(lib, pkg){ >> + ob<- findOpenBUGS() >> + loadOpenBUGS(ob$dir) >> + msg<- paste("Welcome to BRugs connected to OpenBUGS") >> + if (!is.na(ob$version)) >> + msg<- paste(msg, "version", ob$version) >> + else msg<- paste(msg, "in directory", ob$dir) >> + packageStartupMessage(msg) >> +} >> + >> +".onUnload.i386"<- function(libpath){ >> + if(is.loaded("CmdInterpreter")) { >> + libname<- paste(options()$OpenBUGS, "libOpenBUGS.dll", sep="/") >> + dyn.unload(libname) >> + } >> +} >> + >> +## Load OpenBUGS from specified location >> +loadOpenBUGS<- function(dir) { >> + libname<- paste(dir, "libOpenBUGS.dll", sep="/") >> + if (!file.exists(libname)) { >> + warning("Shared library \"libOpenBUGS.dll\" not found in ", dir) >> + return(FALSE) >> + } >> + options(OpenBUGS = dir) >> + dyn.load(libname) >> + len<- nchar(dir) >> + .C("SetWorkingDir", as.character(dir), len) >> + ## Set temporary dir for "buffer.txt" output >> + tempDir<- gsub("\\\\", "/", tempdir()) >> + .C("SetTempDir", as.character(tempDir), nchar(tempDir)) >> + command<- "BugsMappers.SetDest(2)" >> + .CmdInterpreter(command) >> + if(is.null(getOption("BRugsVerbose"))) >> + options("BRugsVerbose" = TRUE) >> + .initGlobals() >> + options(OpenBUGSExamples = paste(dir, "Examples", sep="/")) >> + invisible() >> +} >> + >> >> Added: trunk/BRugs/R/windows/zzz.x64.R >> =================================================================== >> --- trunk/BRugs/R/windows/zzz.x64.R (rev 0) >> +++ trunk/BRugs/R/windows/zzz.x64.R 2011-08-31 09:28:44 UTC (rev 211) >> @@ -0,0 +1,25 @@ >> +if (is.R()){ >> + >> + ".onLoad.x64"<- function(lib, pkg){ >> + ## TODO any need for these to be user specifiable? >> + options("BRugsTmpdir" = gsub("\\\\", "/", tempdir())) >> + options("BRugsExtFile" = paste(basename(tempfile()), ".bug", sep="")) >> + options(OpenBUGS = "C:/Program Files (x86)/OpenBUGS/OpenBUGS321") >> + options(OpenBUGSdoc = "C:/Program Files (x86)/OpenBUGS/OpenBUGS321") >> + options(OpenBUGSExamples = paste(options()$OpenBUGSdoc, "Examples", sep="/")) > > > > Why not do it the same way as for 32-bit? The stuff is in the 32-bit > view in the registry, hence findOpenBUGS results could be used here. > > The .in file is not helpful given we provide binaries for the package on > CRAN and *my* installation will be inserted. > > > > Best wishes, > uwe > > ------------------------------------------------------------------------------ > Special Offer -- Download ArcSight Logger for FREE! > Finally, a world-class log management solution at an even better > price-free! And you'll get a free "Love Thy Logs" t-shirt when you > download Logger. Secure your free ArcSight Logger TODAY! > http://p.sf.net/sfu/arcsisghtdev2dev > _______________________________________________ > Bugs-r-devel mailing list > Bug...@li... > https://lists.sourceforge.net/lists/listinfo/bugs-r-devel |
|
From: Uwe L. <li...@st...> - 2011-08-31 12:37:32
|
And finally, I think samplesSample is broken, at least it does not do anything for me now. Uwe On 31.08.2011 14:25, Uwe Ligges wrote: > Chris, as a side note: > > I'd prefer not to copy the dlls into libs. In any case, it won't work > the way you did it. Please R CMD build before R CMD INSTALL the tar file. > > I can take a look how to clean this up diring the weekend. I prefer to > do things in Makevars.win rather than configure.win which makes it much > harder to produce bi-arch binaries for BRugs. > > Uwe > > > > > > > On 31.08.2011 14:01, Uwe Ligges wrote: >> Chris, >> >> >> thanks for your modifications and the 64-bit code. Great! I will test >> during the weekend (I am about to travel in an hour or so). >> >> >> >> On 31.08.2011 11:28, chr...@us... wrote: >>> Revision: 211 >>> http://bugs-r.svn.sourceforge.net/bugs-r/?rev=211&view=rev >>> Author: chris-jackson >>> Date: 2011-08-31 09:28:44 +0000 (Wed, 31 Aug 2011) >>> Log Message: >>> ----------- >>> Changes to allow running on x64 R in Windows. The same helper facility as on Linux is used to call the 32-bit DLL. >>> >>> + stop(errors[res], "\nPlease report this bug to ", maintainer) >> >> >> >> May I object against this line of code? >> If there are BUGS traps, I am certainly not the person who likes to get >> the bug report, since I cannot help in that case anyway. >> >> >> >>> Added: trunk/BRugs/R/windows/findOpenBUGS.R >>> =================================================================== >>> --- trunk/BRugs/R/windows/findOpenBUGS.R (rev 0) >>> +++ trunk/BRugs/R/windows/findOpenBUGS.R 2011-08-31 09:28:44 UTC (rev 211) >>> @@ -0,0 +1,43 @@ >>> +findOpenBUGS<- function() >>> +{ >>> + dir<- Sys.getenv("OpenBUGS_PATH") >>> + if(!nchar(dir)){ >>> + deps<- utils:::packageDescription("BRugs", fields="SystemRequirements") >>> + version.req<- gsub(".*OpenBUGS ?\\(>= ?(.+)\\).*", "\\1", deps) >>> + >>> + key<- if (.Platform$r_arch == "x64") "Software\\Wow6432Node\\OpenBUGS" else "Software\\OpenBUGS" >> >> >> The above is implemented by the view argument in readRegistry. Why not >> use it? It will be safe in case Microsoft changes the names of registry >> keys again in the next version of Windows. You have not changed it below. >> >> >> >>> + ob.reg<- try(utils:::readRegistry(key, "HLM"), silent = TRUE) >>> + ## ob.reg<- try(utils:::readRegistry("Software\\OpenBUGS", "HLM", view = "32-bit"), silent = TRUE) >> >> >> >>> + ## remove suffixes from development versions, converts e.g. 3.2.1alpha to 3.2.1 >> >> >> Question is if we actually want to remove that in case we really require >> a release rather than the alpha version. >> >> >> >>> + version.inst<- gsub("(.+[0-9]+)[a-zA-Z]+$","\\1", version.full) >>> + >>> + if(length(version.inst> 1)){ >>> + id<- which(apply(outer(version.inst, version.inst, Vectorize(compareVersion, c("a", "b"))), 1, function(x) all(x>= 0))) >>> + id<- max(id) # if more than one release with same number, arbitrarily choose last one in registry >>> + version.inst<- version.inst[id] >>> + version.full<- version.full[id] >>> + rnames<- rnames[id] >>> + } >>> + >>> + if (compareVersion(version.inst, version.req)< 0) { >>> + warning("Found OpenBUGS version ", version.inst, ".\n Requires ", version.req, " or greater.\nSetting the environment variable 'OpenBUGS_PATH' in advance of loading 'BRugs' overwrites the path.\nSee ?loadOpenBUGS in order to load OpenBUGS manually.") >>> + return() >>> + } >>> + >>> + ## OpenBUGS installation location >>> + dir<- utils:::readRegistry(paste("Software","OpenBUGS",rnames,sep="\\"), "HLM", view = "32-bit")[["InstallPath"]] >>> + } else { >>> + if(!file.exists(file.path(dir, "libOpenBUGS.dll"))){ >>> + warning("Environment variable OpenBUGS_PATH found but cannot access ", file.path(dir, "libOpenBUGS.dll")) >>> + return() >>> + } >>> + version.inst<- NA >>> + } >>> + list(dir=dir, version=version.full) >>> +} >>> >> >> >> >> >>> Added: trunk/BRugs/R/windows/zzz.i386.R >>> =================================================================== >>> --- trunk/BRugs/R/windows/zzz.i386.R (rev 0) >>> +++ trunk/BRugs/R/windows/zzz.i386.R 2011-08-31 09:28:44 UTC (rev 211) >>> @@ -0,0 +1,40 @@ >>> +".onLoad.i386"<- function(lib, pkg){ >>> + ob<- findOpenBUGS() >>> + loadOpenBUGS(ob$dir) >>> + msg<- paste("Welcome to BRugs connected to OpenBUGS") >>> + if (!is.na(ob$version)) >>> + msg<- paste(msg, "version", ob$version) >>> + else msg<- paste(msg, "in directory", ob$dir) >>> + packageStartupMessage(msg) >>> +} >>> + >>> +".onUnload.i386"<- function(libpath){ >>> + if(is.loaded("CmdInterpreter")) { >>> + libname<- paste(options()$OpenBUGS, "libOpenBUGS.dll", sep="/") >>> + dyn.unload(libname) >>> + } >>> +} >>> + >>> +## Load OpenBUGS from specified location >>> +loadOpenBUGS<- function(dir) { >>> + libname<- paste(dir, "libOpenBUGS.dll", sep="/") >>> + if (!file.exists(libname)) { >>> + warning("Shared library \"libOpenBUGS.dll\" not found in ", dir) >>> + return(FALSE) >>> + } >>> + options(OpenBUGS = dir) >>> + dyn.load(libname) >>> + len<- nchar(dir) >>> + .C("SetWorkingDir", as.character(dir), len) >>> + ## Set temporary dir for "buffer.txt" output >>> + tempDir<- gsub("\\\\", "/", tempdir()) >>> + .C("SetTempDir", as.character(tempDir), nchar(tempDir)) >>> + command<- "BugsMappers.SetDest(2)" >>> + .CmdInterpreter(command) >>> + if(is.null(getOption("BRugsVerbose"))) >>> + options("BRugsVerbose" = TRUE) >>> + .initGlobals() >>> + options(OpenBUGSExamples = paste(dir, "Examples", sep="/")) >>> + invisible() >>> +} >>> + >>> >>> Added: trunk/BRugs/R/windows/zzz.x64.R >>> =================================================================== >>> --- trunk/BRugs/R/windows/zzz.x64.R (rev 0) >>> +++ trunk/BRugs/R/windows/zzz.x64.R 2011-08-31 09:28:44 UTC (rev 211) >>> @@ -0,0 +1,25 @@ >>> +if (is.R()){ >>> + >>> + ".onLoad.x64"<- function(lib, pkg){ >>> + ## TODO any need for these to be user specifiable? >>> + options("BRugsTmpdir" = gsub("\\\\", "/", tempdir())) >>> + options("BRugsExtFile" = paste(basename(tempfile()), ".bug", sep="")) >>> + options(OpenBUGS = "C:/Program Files (x86)/OpenBUGS/OpenBUGS321") >>> + options(OpenBUGSdoc = "C:/Program Files (x86)/OpenBUGS/OpenBUGS321") >>> + options(OpenBUGSExamples = paste(options()$OpenBUGSdoc, "Examples", sep="/")) >> >> >> >> Why not do it the same way as for 32-bit? The stuff is in the 32-bit >> view in the registry, hence findOpenBUGS results could be used here. >> >> The .in file is not helpful given we provide binaries for the package on >> CRAN and *my* installation will be inserted. >> >> >> >> Best wishes, >> uwe >> >> ------------------------------------------------------------------------------ >> Special Offer -- Download ArcSight Logger for FREE! >> Finally, a world-class log management solution at an even better >> price-free! And you'll get a free "Love Thy Logs" t-shirt when you >> download Logger. Secure your free ArcSight Logger TODAY! >> http://p.sf.net/sfu/arcsisghtdev2dev >> _______________________________________________ >> Bugs-r-devel mailing list >> Bug...@li... >> https://lists.sourceforge.net/lists/listinfo/bugs-r-devel > > ------------------------------------------------------------------------------ > Special Offer -- Download ArcSight Logger for FREE! > Finally, a world-class log management solution at an even better > price-free! And you'll get a free "Love Thy Logs" t-shirt when you > download Logger. Secure your free ArcSight Logger TODAY! > http://p.sf.net/sfu/arcsisghtdev2dev > _______________________________________________ > Bugs-r-devel mailing list > Bug...@li... > https://lists.sourceforge.net/lists/listinfo/bugs-r-devel |
×
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