Menu
▾
▴
[Bugs-r-devel] SF.net SVN: bugs-r: [9] trunk/R2WinBUGS
|
From: <li...@us...> - 2007-04-07 18:04:19
|
Revision: 9
http://svn.sourceforge.net/bugs-r/?rev=9&view=rev
Author: ligges
Date: 2007-04-07 11:04:11 -0700 (Sat, 07 Apr 2007)
Log Message:
-----------
R2WinBUGS has been ported to S-PLUS by Insightful Corp.
Special thanks to Dawn Woodard!
Modified Paths:
--------------
trunk/R2WinBUGS/Changes
trunk/R2WinBUGS/DESCRIPTION
trunk/R2WinBUGS/R/as.bugs.array.R
trunk/R2WinBUGS/R/attach.all.R
trunk/R2WinBUGS/R/bugs.R
trunk/R2WinBUGS/R/bugs.data.R
trunk/R2WinBUGS/R/bugs.inits.R
trunk/R2WinBUGS/R/bugs.plot.inferences.R
trunk/R2WinBUGS/R/bugs.plot.summary.R
trunk/R2WinBUGS/R/bugs.run.R
trunk/R2WinBUGS/R/bugs.sims.R
trunk/R2WinBUGS/R/bugs.update.settings.R
trunk/R2WinBUGS/R/conv.par.R
trunk/R2WinBUGS/R/monitor.R
trunk/R2WinBUGS/R/openbugs.R
trunk/R2WinBUGS/R/plot.bugs.R
trunk/R2WinBUGS/R/wineutils.R
trunk/R2WinBUGS/R/write.model.R
trunk/R2WinBUGS/man/bugs.Rd
trunk/R2WinBUGS/man/bugs.log.Rd
trunk/R2WinBUGS/man/bugs.run.Rd
trunk/R2WinBUGS/man/bugs.script.Rd
trunk/R2WinBUGS/man/bugs.sims.Rd
trunk/R2WinBUGS/man/openbugs.Rd
trunk/R2WinBUGS/man/write.model.Rd
Modified: trunk/R2WinBUGS/Changes
===================================================================
--- trunk/R2WinBUGS/Changes 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/Changes 2007-04-07 18:04:11 UTC (rev 9)
@@ -69,3 +69,6 @@
Update 2.0-4 (01 November 2006):
- print.bugs / plot.bugs documentation fixes
- write.model() fix
+
+Update 2.1-1 (07 April 2007):
+- Ported to S-PLUS by Insightful Corp.
Modified: trunk/R2WinBUGS/DESCRIPTION
===================================================================
--- trunk/R2WinBUGS/DESCRIPTION 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/DESCRIPTION 2007-04-07 18:04:11 UTC (rev 9)
@@ -1,18 +1,22 @@
Package: R2WinBUGS
-Title: Running WinBUGS and OpenBUGS from R
-Date: 2006-11-01
-Version: 2.0-4
+Title: Running WinBUGS and OpenBUGS from R / S-PLUS
+Date: 2007-04-07
+Version: 2.1-1
Author: originally written by Andrew Gelman <ge...@st...>;
changes and packaged by Sibylle Sturtz <st...@st...>
and Uwe Ligges <li...@st...>.
With considerable contributions by Gregor Gorjanc <gre...@bf...>
and Jouni Kerman <ke...@st...>.
+ Ported to S-PLUS by Insightful Corp.
Description: Using this package,
it is possible to call a BUGS model, summarize inferences and
- convergence in a table and graph, and save the simulations in arrays for easy access in R.
-Depends: R (>= 2.2.0)
+ convergence in a table and graph, and save the simulations in arrays for easy access
+ in R / S-PLUS. In S-PLUS, the openbugs functionality and the windows emulation
+ functionality is not yet available.
+Depends: R (>= 2.4.0)
Suggests: coda (>= 0.9-0), BRugs (>= 0.3-0)
SystemRequirements: WinBUGS 1.4 on Windows
URL: http://www.stat.columbia.edu/~gelman/bugsR/
Maintainer: Sibylle Sturtz <st...@st...>
License: GPL version 2
+Dialect: R, S-PLUS
Modified: trunk/R2WinBUGS/R/as.bugs.array.R
===================================================================
--- trunk/R2WinBUGS/R/as.bugs.array.R 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/R/as.bugs.array.R 2007-04-07 18:04:11 UTC (rev 9)
@@ -71,9 +71,11 @@
summary <- monitor(sims.array, n.chains, keep.all = TRUE)
last.values <- as.list(numeric(n.chains))
for (i in 1:n.chains) {
- n.roots.0 <- if (!is.null(DIC))
- n.roots - 1
- else n.roots
+ if (is.R()) {
+ n.roots.0 <- if(!is.null(DIC)) n.roots - 1 else n.roots
+ } else {
+ n.roots.0 <- if(DIC) n.roots - 1 else n.roots
+ }
last.values[[i]] <- as.list(numeric(n.roots.0))
names(last.values[[i]]) <- root.short[1:n.roots.0]
for (j in 1:n.roots.0) {
@@ -111,6 +113,11 @@
}
}
summary <- summary[rank.long, ]
+ if (is.R())
+ is.DIC = !is.null(DIC)
+ else
+ is.DIC = DIC
+
all <- list(n.chains = n.chains, n.iter = n.iter, n.burnin = n.burnin,
n.thin = n.thin, n.keep = n.keep, n.sims = n.sims,
sims.array = sims.array[,,rank.long,drop = FALSE], sims.list = sims.list,
@@ -118,7 +125,7 @@
sd = summary.sd, median = summary.median, root.short = root.short,
long.short = long.short, dimension.short = dimension.short,
indexes.short = indexes.short, last.values = last.values, program=program,
- model.file=model.file, is.DIC=!is.null(DIC), DIC=DIC)
+ model.file=model.file, is.DIC=is.DIC, DIC=DIC)
if(sum(DIC)) {
deviance <- all$sims.array[, , dim(sims.array)[3], drop = FALSE]
dim(deviance) <- dim(deviance)[1:2]
Modified: trunk/R2WinBUGS/R/attach.all.R
===================================================================
--- trunk/R2WinBUGS/R/attach.all.R 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/R/attach.all.R 2007-04-07 18:04:11 UTC (rev 9)
@@ -1,11 +1,12 @@
attach.all <- function(x, overwrite = NA, name = "attach.all"){
+ if(is.R()){
rem <- names(x) %in% ls(.GlobalEnv)
if(!any(rem)) overwrite <- FALSE
rem <- names(x)[rem]
if(is.na(overwrite)){
question <- paste("The following objects in .GlobalEnv will mask\nobjects in the attached database:\n",
- paste(rem, collapse=", "),
- "\nRemove these objects from .GlobalEnv?", sep="")
+ paste(rem, collapse=", "),
+ "\nRemove these objects from .GlobalEnv?", sep="")
if(interactive()){
if(.Platform$OS.type == "windows")
overwrite <- "YES" == winDialog(type = "yesno", question)
@@ -16,6 +17,9 @@
}
if(overwrite) remove(list=rem, envir=.GlobalEnv)
attach(x, name=name)
+ } else {
+ attach.default(x, name = name)
+ }
}
attach.bugs <- function (x, overwrite = NA){
@@ -25,12 +29,24 @@
detach("bugs.sims")}
x$sims.list$n.sims <- x$n.sims # put n.sims into sims.list for convenience
r2 <- attach.all(x$sims.list, overwrite = overwrite, name = "bugs.sims")
- invisible (bugs.sims = r2)
+ if (is.R())
+ invisible (bugs.sims = r2)
+ else
+ invisible (r2)
}
-detach.all <- function(name = "attach.all")
+detach.all <- function(name = "attach.all"){
+ if (is.R()){
do.call("detach", list(name=name))
+ } else {
+ do.call("detach", list(what=name))
+ }
+}
detach.bugs <- function(){
+ if (is.R()){
detach.all("bugs.sims")
+ } else {
+ invisible(detach.all("bugs.sims"))
+ }
}
Modified: trunk/R2WinBUGS/R/bugs.R
===================================================================
--- trunk/R2WinBUGS/R/bugs.R 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/R/bugs.R 2007-04-07 18:04:11 UTC (rev 9)
@@ -10,17 +10,23 @@
clearWD = FALSE, useWINE = .Platform$OS.type != "windows", WINE = Sys.getenv("WINE"),
newWINE = FALSE, WINEPATH = NULL){
- ## If OpenBUGS, we only call openbugs() and exit...
program <- match.arg(program)
if (program %in% c("openbugs", "OpenBugs"))
- return(openbugs(data, inits, parameters.to.save, model.file,
- n.chains, n.iter, n.burnin, n.thin, DIC, bugs.directory,
- working.directory, digits))
-
+ if (is.R()){
+ ## If OpenBUGS, we only call openbugs() and exit...
+ return(openbugs(data, inits, parameters.to.save, model.file,
+ n.chains, n.iter, n.burnin, n.thin, DIC, bugs.directory,
+ working.directory, digits))
+ } else {
+ stop ("OpenBUGS is not yet available in S-PLUS")
+ }
## Checking number of inits, which is NOT save here:
if(!missing(inits) && !is.function(inits) && !is.null(inits) && (length(inits) != n.chains))
stop("Number of initialized chains (length(inits)) != n.chains")
- if (useWINE) { # attempt to find wine and winepath
+ if(useWINE) {
+ if (!is.R())
+ stop ("Non-Windows platforms not yet supported in R2WinBUGS for S-PLUS")
+ ## attempt to find wine and winepath
if (!nchar(WINE)) {
WINE <- system("locate wine | grep bin/wine$", intern = TRUE)
WINE <- WINE[length(WINE)]
@@ -31,7 +37,7 @@
WINEPATH <- WINEPATH[length(WINEPATH)]
}
if (!length(WINEPATH)) stop("couldn't locate WINEPATH binary")
- }
+ }
if(!is.null(working.directory)){
savedWD <- getwd()
setwd(working.directory)
@@ -59,8 +65,13 @@
if(codaPkg)
return(file.path(getwd(), paste("coda", 1:n.chains, ".txt", sep="")))
- sims <- c(bugs.sims(parameters.to.save, n.chains, n.iter, n.burnin, n.thin, DIC),
- model.file = model.file, is.DIC = !is.null(DIC), program = program)
+ if (is.R()){
+ sims <- c(bugs.sims(parameters.to.save, n.chains, n.iter, n.burnin, n.thin, DIC),
+ model.file = model.file, is.DIC = !is.null(DIC), program = program)
+ } else {
+ sims <- c(bugs.sims(parameters.to.save, n.chains, n.iter, n.burnin, n.thin, DIC),
+ model.file = model.file, is.DIC = DIC, program = program)
+ }
if(clearWD)
file.remove(c("data.txt", "log.odc", "log.txt", "codaIndex.txt",
paste("inits", 1:n.chains, ".txt", sep=""),
Modified: trunk/R2WinBUGS/R/bugs.data.R
===================================================================
--- trunk/R2WinBUGS/R/bugs.data.R 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/R/bugs.data.R 2007-04-07 18:04:11 UTC (rev 9)
@@ -1,12 +1,222 @@
-"bugs.data" <-
+"bugs.data" <-
function(data, dir = getwd(), digits = 5){
if(is.numeric(unlist(data)))
- write.datafile(lapply(data, formatC, digits = digits, format = "E"),
- file.path(dir, "data.txt"))
+ if(is.R()) {
+ write.datafile(lapply(data, formatC, digits = digits, format = "E"),
+ file.path(dir, "data.txt"))
+ }
+ else {
+ writeDatafileS4(data, towhere = "data.txt")
+ }
else {
- data.list <- lapply(as.list(data), get, pos = parent.frame(2))
- names(data.list) <- as.list(data)
- write.datafile(lapply(data.list, formatC, digits = digits, format = "E"),
- file.path(dir, "data.txt"))
- }
+ 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"),
+ file.path(dir, "data.txt"))
+ }
+ else {
+ data.list <- lapply(as.list(data), get, where = parent.frame(2))
+ names(data.list) <- unlist(data)
+ writeDatafileS4(data.list, towhere = "data.txt")
+ }
+ }
}
+
+if (!is.R()) {
+
+"writeDatafileS4" <-
+#
+# Writes to file "towhere" text defining a list containing "DATA" in a form compatable with WinBUGS.
+# Required arguments:
+# DATA - either a data frame or else a list consisting of any combination of scalars, vectors, arrays or data frames (but not lists).
+# If a list, all list elements that are not data.frames must be named. Names of data.frames in DATA are ignored.
+# Optional arguments:
+# towhere - file to receive output. Is clipboard by default, which is convenient for pasting into a WinBUTS ODC file.
+# fill - If numeric, number of columns for output. If FALSE, output will be on one line. If TRUE (default), number of
+# columns is given by .Options$width.
+# Value:
+# Text defining a list is output to file "towhere".
+# Details:
+# The function performs considerable checking of DATA argument. Since WinBUGS requires numeric input, no factors or character vectors
+# are allowed. All data must be named, either as named elements of DATA (if it is a list) or else using the names given in data frames.
+# Data frames may contain matrices.
+# Arrays of any dimension are rearranged to be in row-major order, as required by WinBUGS. Scientific notation is also handled properly.
+# In particular, the number will consist of a mantissa _containing a decimal point_ followed by "E", then either "+" or "-", and finally
+# a _two-digit_ number. S-Plus does not always provide a decimal point in the mantissa, uses "e" instead of "E", followed by
+# either a "+" or "-" and then _three_ digits.
+# Written by Terry Elrod. Disclaimer: This function is used at the user's own risk.
+# Please send comments to Ter...@UA....
+# Revision history: 2002-11-19. Fixed to handle missing values properly.
+function(DATA, towhere = "clipboard", fill = TRUE)
+{
+ formatDataS4 =
+ #
+ # Prepared DATA for input to WinBUGS.
+ function(DATA)
+ {
+ toSingleS4 =
+ #
+ # Takes numeric vector and removes digit of exponent in scientific notation (if any)
+ function(x)
+ {
+ xdim <- dim(x)
+ x <- as.character(as.single(x))
+ # First to look for positives:
+ pplus <- regMatchPos(x, "e\\+0")
+ pplusind <- apply(pplus, 1, function(y)
+ (!any(is.na(y))))
+ if(any(pplusind)) {
+ # Making sure that periods are in mantissa...
+ init <- substring(x[pplusind], 1, pplus[
+ pplusind, 1] - 1)
+ #...preceeding exponent
+ pper <- regMatchPos(init, "\\.")
+ pperind <- apply(pper, 1, function(y)
+ (all(is.na(y))))
+ if(any(pperind))
+ init[pperind] <- paste(init[pperind],
+ ".0", sep = "")
+ # Changing the format of the exponent...
+ x[pplusind] <- paste(init, "E+", substring(
+ x[pplusind], pplus[pplusind, 2] + 1),
+ sep = "")
+ }
+ # Then to look for negatives:
+ pminus <- regMatchPos(x, "e\\-0")
+ pminusind <- apply(pminus, 1, function(y)
+ (!any(is.na(y))))
+ if(any(pminusind)) {
+ # Making sure that periods are in mantissa...
+ init <- substring(x[pminusind], 1, pminus[
+ pminusind, 1] - 1)
+ #...preceeding exponent
+ pper <- regMatchPos(init, "\\.")
+ pperind <- apply(pper, 1, function(y)
+ (all(is.na(y))))
+ if(any(pperind))
+ init[pperind] <- paste(init[pperind],
+ ".0", sep = "")
+ # Changing the format of the exponent...
+ x[pminusind] <- paste(init, "E-", substring(
+ x[pminusind], pminus[pminusind, 2] +
+ 1), sep = "")
+ }
+ x
+ }
+ if(!is.list(DATA))
+ stop("DATA must be a named list or data frame.")
+ dlnames <- names(DATA)
+ if(is.data.frame(DATA))
+ DATA <- as.list(DATA)
+ #
+ # Checking for lists in DATA....
+ lind <- sapply(DATA, is.list)
+ # Checking for data frames in DATA....
+ dfind <- sapply(DATA, is.data.frame)
+ # Any lists that are not data frames?...
+ if(any(lind & !dfind)) stop("DATA may not contain lists.")
+ # Checking for unnamed elements of list that are not data frames....
+ if(any(dlnames[!dfind] == "")) stop(
+ "When DATA is a list, all its elements that are not data frames must be named."
+ )
+ # Checking for duplicate names....
+ dupnames <- unique(dlnames[duplicated(dlnames)])
+ if(length(dupnames) > 0)
+ stop(paste(
+ "The following names are used more than once in DATA:",
+ paste(dupnames, collapse = ", ")))
+ if(any(dfind)) {
+ dataold <- DATA
+ DATA <- vector("list", 0)
+ for(i in seq(along = dataold)) {
+ if(dfind[i])
+ DATA <- c(DATA, as.list(dataold[[i]]))
+ else DATA <- c(DATA, dataold[i])
+ }
+ dataold <- NULL
+ }
+ dlnames <- names(DATA)
+ dupnames <- unique(dlnames[duplicated(dlnames)])
+ # Checking for duplicated names again (now that columns of data frames are included)....
+ if(length(dupnames) > 0) stop(paste(
+ "The following names are used more than once in DATA (at least once within a data frame):",
+ paste(dupnames, collapse = ", ")))
+ # Checking for factors....
+ factorind <- sapply(DATA, is.factor)
+ if(any(factorind))
+ stop(paste(
+ "DATA may not include factors. One or more factor variables were detected:",
+ paste(dlnames[factorind], collapse = ", ")))
+ # Checking for character vectors....
+ charind <- sapply(DATA, is.character)
+ if(any(charind))
+ stop(paste(
+ "WinBUGS does not handle character data. One or more character variables were detected:",
+ paste(dlnames[charind], collapse = ", ")))
+ # Checking for complex vectors....
+ complexind <- sapply(DATA, is.complex)
+ if(any(complexind))
+ stop(paste(
+ "WinBUGS does not handle complex data. One or more complex variables were detected:",
+ paste(dlnames[complexind], collapse = ", ")))
+ # Checking for values farther from zero than 1E+38 (which is limit of single precision)....
+ toobigind <- sapply(DATA, function(x)
+ {
+ y <- abs(x[!is.na(x)])
+ any(y[y > 0] > 9.9999999999999998e+37)
+ }
+ )
+ if(any(toobigind))
+ stop(paste(
+ "WinBUGS works in single precision. The following variables contain data outside the range +/-1.0E+38: ",
+ paste(dlnames[toobigind], collapse = ", "),
+ ".\n", sep = ""))
+ # Checking for values in range +/-1.0E-38 (which is limit of single precision)....
+ toosmallind <- sapply(DATA, function(x)
+ {
+ y <- abs(x[!is.na(x)])
+ any(y[y > 0] < 9.9999999999999996e-39)
+ }
+ )
+ n <- length(dlnames)
+ data.string <- as.list(rep(NA, n))
+ for(i in 1:n) {
+ if(length(DATA[[i]]) == 1) {
+ ac <- toSingleS4(DATA[[i]])
+ data.string[[i]] <- paste(names(DATA)[i], "=",
+ ac, sep = "")
+ next
+ }
+ if(is.vector(DATA[[i]]) & length(DATA[[i]]) > 1) {
+ ac <- toSingleS4(DATA[[i]])
+ data.string[[i]] <- paste(names(DATA)[i], "=c(",
+ paste(ac, collapse = ", "), ")", sep =
+ "")
+ next
+ }
+ if(is.array(DATA[[i]])) {
+ ac <- toSingleS4(aperm(DATA[[i]]))
+ data.string[[i]] <- paste(names(DATA)[i],
+ "= structure(.Data= c(", paste(ac,
+ collapse = ", "), "), \n .Dim=c(",
+ paste(as.character(dim(DATA[[i]])),
+ collapse = ", "), "))", sep = "")
+ }
+ }
+ data.tofile <- paste("list(", paste(unlist(data.string),
+ collapse = ", "), ")", sep = "")
+ if(any(toosmallind))
+ warning(paste(
+ "WinBUGS works in single precision. The following variables contained nonzero data",
+ "\ninside the range +/-1.0E-38 that were set to zero: ",
+ paste(dlnames[toosmallind], collapse = ", "),
+ ".\n", sep = ""))
+ return(data.tofile)
+ }
+ rslt <- formatDataS4(DATA)
+ cat(rslt, file = towhere, fill = fill)
+ invisible(0)
+}
+
+} # ends if (!is.R())
Modified: trunk/R2WinBUGS/R/bugs.inits.R
===================================================================
--- trunk/R2WinBUGS/R/bugs.inits.R 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/R/bugs.inits.R 2007-04-07 18:04:11 UTC (rev 9)
@@ -1,13 +1,22 @@
-"bugs.inits" <-
+"bugs.inits" <-
function (inits, n.chains, digits){
- if(!is.null(inits)){
- for (i in 1:n.chains){
- if (is.function(inits))
- write.datafile(lapply(inits(), formatC, digits = digits, format = "E"),
- paste ("inits", i, ".txt", sep=""))
- else
- write.datafile(lapply(inits[[i]], formatC, digits = digits, format = "E"),
- paste ("inits", i, ".txt", sep=""))
- }
- }
+ if(!is.null(inits)) {
+ for(i in 1:n.chains) {
+ if(is.function(inits))
+ if(is.R()) {
+ write.datafile(lapply(inits(), formatC, digits = digits, format = "E"),
+ paste("inits", i, ".txt", sep = ""))
+ } else {
+ writeDatafileS4(inits(), towhere =
+ paste("inits", i, ".txt", sep = ""))
+ }
+ else if(is.R()) {
+ write.datafile(lapply(inits[[i]], formatC, digits = digits, format = "E"),
+ paste("inits", i, ".txt", sep = ""))
+ } else {
+ writeDatafileS4(inits[[i]], towhere = paste(
+ "inits", i, ".txt", sep = ""))
+ }
+ }
+ }
}
Modified: trunk/R2WinBUGS/R/bugs.plot.inferences.R
===================================================================
--- trunk/R2WinBUGS/R/bugs.plot.inferences.R 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/R/bugs.plot.inferences.R 2007-04-07 18:04:11 UTC (rev 9)
@@ -28,8 +28,18 @@
long.short <- sims$long.short
height <- .6
par (mar=c(0,0,1,0))
+
+ ## if in Splus, suppress printing of warnings during the plotting.
+ ## otherwise a warning is generated
+ if (!is.R()){
+ warn.settings <- options("warn")[[1]]
+ options (warn = -1)
+ }
plot (c(0,1), c(-n.roots-.5,-.4),
ann=FALSE, bty="n", xaxt="n", yaxt="n", type="n")
+ if (!is.R())
+ options(warn = warn.settings)
+
W <- max(strwidth(rootnames, cex=cex.names))
B <- (1-W)/3.8
A <- 1-3.5*B
Modified: trunk/R2WinBUGS/R/bugs.plot.summary.R
===================================================================
--- trunk/R2WinBUGS/R/bugs.plot.summary.R 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/R/bugs.plot.summary.R 2007-04-07 18:04:11 UTC (rev 9)
@@ -1,6 +1,7 @@
"bugs.plot.summary" <-
function (sims, ...){
DIC <- sims$is.DIC
+
if (.Device=="windows" ||
(.Device=="null device" && options("device")=="windows")){
cex.names <- .7
@@ -29,7 +30,11 @@
J[J==max(J)] <- max(J)-1
total <- ceiling(sum(J+.5))
}
- pos <- -1
+ if (is.R()){
+ pos <- -1
+ } else {
+ pos <- -1.5
+ }
ypos <- NULL
id <- NULL
ystart <- NULL
@@ -39,13 +44,25 @@
ystart <- numeric(n.roots)
for (k in 1:n.roots){
ystart[k] <- pos
- ypos <- c(ypos, pos - seq(0, J[k]-1))
+ if (is.R()) {
+ ypos <- c(ypos, pos - seq(0, J[k]-1))
+ } else {
+ # In S-PLUS, increase the vertical spacing
+ ypos <- c(ypos, pos - 1.5*seq(0, J[k]-1))
+ }
id <- c(id, 1:J[k])
- pos <- pos - J[k] -.5
+ if (is.R()) {
+ pos <- pos - J[k] -.5
+ } else {
+ pos <- pos - 1.5*J[k] -0.75
+ }
if (k>1) jj <- c(jj, sum(J0[1:(k-1)]) + (1:J[k]))
}
- bottom <- min(ypos)-1
-
+ if (is.R()){
+ bottom <- min(ypos)-1
+ } else {
+ bottom <- min(ypos)-1.5
+ }
med <- numeric(sum(J))
i80 <- matrix( , sum(J), 2)
i80.chains <- array (NA, c(sum(J), n.chains, 2))
@@ -61,8 +78,17 @@
a <- -b * p.rng[1]
par (mar=c(0,0,1,3))
+ # if in Splus, suppress printing of warnings during the plotting.
+ # otherwise a warning is generated
+ if (!is.R()){
+ warn.settings <- options("warn")[[1]]
+ options (warn = -1)
+ }
plot (c(0,1), c(min(bottom, -max.length)-3,2.5),
ann=FALSE, bty="n", xaxt="n", yaxt="n", type="n")
+ if (!is.R())
+ options(warn = warn.settings)
+
W <- max(strwidth(unlist(dimnames(summ)[[1]]), cex=cex.names))
B <- (1-W)/3.6
A <- 1-3.5*B
@@ -100,7 +126,16 @@
for (j in 1:sum(J)){
name <- dimnames(summ)[[1]][jj[j]]
if (id[j]==1)
- text (0, ypos[j], name, adj=0, cex=cex.names)
+ if (is.R()) {
+ text (0, ypos[j], name, adj=0, cex=cex.names)
+ } else {
+ # in S-PLUS, strwidth is an upper bound on the length of the string,
+ # so we must align the brackets differently than in R
+ pos <- as.vector(regexpr("[[]", name))
+ text (0, ypos[j], substring(name, 1, pos-1), adj=0, cex=cex.names)
+ text (strwidth(substring(name,1,pos-1),cex=cex.names),
+ ypos[j], substring(name, pos, nchar(name)), adj=0, cex=cex.names)
+ }
else {
pos <- as.vector(regexpr("[[]", name))
text (strwidth(substring(name,1,pos-1),cex=cex.names),
Modified: trunk/R2WinBUGS/R/bugs.run.R
===================================================================
--- trunk/R2WinBUGS/R/bugs.run.R 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/R/bugs.run.R 2007-04-07 18:04:11 UTC (rev 9)
@@ -1,15 +1,24 @@
"bugs.run" <-
function(n.burnin, bugs.directory, WINE = "",
useWINE = .Platform$OS.type != "windows", newWINE = TRUE){
-
+
+if(useWINE && !is.R())
+ stop ("Non-Windows platforms not yet supported in R2WinBUGS for S-PLUS")
if(useWINE && !newWINE) bugs.directory <- win2native(bugs.directory)
## Update the lengths of the adaptive phases in the Bugs updaters
try(bugs.update.settings(n.burnin, bugs.directory))
## Return the lengths of the adaptive phases to their original settings
- on.exit(try(file.copy(file.path(bugs.directory, "System/Rsrc/Registry_Rsave.odc"),
- file.path(bugs.directory, "System/Rsrc/Registry.odc"),
- overwrite = TRUE)))
+ if (is.R()){
+ on.exit(try(file.copy(file.path(bugs.directory, "System/Rsrc/Registry_Rsave.odc"),
+ file.path(bugs.directory, "System/Rsrc/Registry.odc"),
+ overwrite = TRUE)))
+ } else {
+ on.exit(try(splus.file.copy(file.path(bugs.directory, "System/Rsrc/Registry_Rsave.odc"),
+ file.path(bugs.directory, "System/Rsrc/Registry.odc"),
+ overwrite = TRUE)))
+ }
+
## Search Win*.exe (WinBUGS executable) within bugs.directory
dos.location <- file.path(bugs.directory,
grep("^Win[[:alnum:]]*[.]exe$", list.files(bugs.directory), value = TRUE)[1])
@@ -26,9 +35,15 @@
if(temp == -1)
stop("Error in bugs.run().\nCheck that WinBUGS is in the specified directory.")
## Stop and print an error message if Bugs did not run correctly
- if (length(grep("Bugs did not run correctly",
- scan("coda1.txt", character(), quiet=TRUE, sep="\n"))) > 0)
- stop("Look at the log file and\ntry again with debug=TRUE and figure out what went wrong within Bugs.")
+ if(is.R()) {
+ if(length(grep("Bugs did not run correctly",
+ scan("coda1.txt", character(), quiet=TRUE, sep="\n"))) > 0)
+ stop("Look at the log file and\ntry again with debug=TRUE and figure out what went wrong within Bugs.")
+ } else {
+ if (length(grep("Bugs did not run correctly",
+ scan("coda1.txt", character(), sep="\n"))) > 0)
+ stop("Look at the log file and\ntry again with debug=TRUE and figure out what went wrong within Bugs.")
+ }
}
Modified: trunk/R2WinBUGS/R/bugs.sims.R
===================================================================
--- trunk/R2WinBUGS/R/bugs.sims.R 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/R/bugs.sims.R 2007-04-07 18:04:11 UTC (rev 9)
@@ -1,10 +1,18 @@
"bugs.sims" <-
function (parameters.to.save, n.chains, n.iter, n.burnin, n.thin, DIC = TRUE){
-# Read the simulations from Bugs into R, format them, and monitor convergence
+## Read the simulations from Bugs into R, format them, and monitor convergence
sims.files <- paste ("coda", 1:n.chains, ".txt", sep="")
- index <- read.table ("codaIndex.txt", header=FALSE, sep="\t")
- parameter.names <- as.vector(index[,1])
- n.keep <- index[1,3] - index[1,2] + 1
+ index <- read.table("codaIndex.txt", header = FALSE, sep = "\t") # read in the names of the parameters and the indices of their samples
+ ## in Splus, read.table interprets the first row of the file as row names,
+ ## while in R it does not
+ if(is.R()) {
+ parameter.names <- as.vector(index[, 1])
+ n.keep <- index[1, 3] - index[1, 2] + 1
+ }
+ else {
+ parameter.names <- row.names(index)
+ n.keep <- index[1, 2] - index[1, 1] + 1
+ }
n.parameters <- length(parameter.names)
n.sims <- n.keep*n.chains
sims <- matrix( , n.sims, n.parameters)
@@ -50,7 +58,9 @@
rank.long <- unlist(long.short)
for (i in 1:n.chains){
- sims.i <- scan (sims.files[i], quiet=TRUE) [2*(1:(n.keep*n.parameters))]
+ if(is.R())
+ sims.i <- scan(sims.files[i], quiet = TRUE)[2 * (1:(n.keep * n.parameters))]
+ else sims.i <- scan(sims.files[i])[2 * (1:(n.keep * n.parameters))]
sims[(n.keep*(i-1)+1):(n.keep*i), ] <- sims.i
sims.array[,i,] <- sims.i
}
@@ -112,6 +122,8 @@
LOG <- bugs.log("log.txt")$DIC
if(any(is.na(LOG))){
deviance <- all$sims.array[, , dim(sims.array)[3], drop = FALSE]
+ if(!is.R())
+ dimnames(deviance) <- NULL
dim(deviance) <- dim(deviance)[1:2]
pD <- numeric(n.chains)
DIC <- numeric(n.chains)
@@ -128,3 +140,9 @@
}
return(all)
}
+
+if (!is.R()){
+ .subset <- function(x, index){
+ return (x[index])
+ }
+}
Modified: trunk/R2WinBUGS/R/bugs.update.settings.R
===================================================================
--- trunk/R2WinBUGS/R/bugs.update.settings.R 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/R/bugs.update.settings.R 2007-04-07 18:04:11 UTC (rev 9)
@@ -1,20 +1,36 @@
"bugs.update.settings" <-
function (n.burnin, bugs.directory){
+ if (!is.R())
+ if (!require(rwBin)) stop ("The rwBin package is required")
+
char.burnin <- as.character(n.burnin - 1)
- file.copy(file.path(bugs.directory, "System/Rsrc/Registry.odc"),
+ if (is.R()){
+ file.copy(file.path(bugs.directory, "System/Rsrc/Registry.odc"),
file.path(bugs.directory, "System/Rsrc/Registry_Rsave.odc"),
- overwrite = TRUE)
+ overwrite = TRUE)
+ } else {
+ splus.file.copy(file.path(bugs.directory, "System/Rsrc/Registry.odc"),
+ file.path(bugs.directory, "System/Rsrc/Registry_Rsave.odc"),
+ overwrite = TRUE)
+ }
registry <- readBin(file.path(bugs.directory, "System/Rsrc/Registry.odc"),
"character", 400, size = 1, endian = "little")
locale <- Sys.getlocale("LC_CTYPE")
Sys.setlocale("LC_CTYPE", "C")
- info <- registry[regexpr("Int", registry, fixed = TRUE, useBytes = TRUE) > 0]
+ if (is.R())
+ info <- registry[regexpr("Int", registry, fixed = TRUE, useBytes = TRUE) > 0]
+ else
+ info <- registry[regexpr("Int", registry, fixed = TRUE) > 0]
while(regexpr("\r", info) > 0){
newline <- regexpr("\r", info)
info <- substring(info, newline + 1)
line <- substring(info, 1, regexpr("\r", info) - 1)
if(regexpr("AdaptivePhase", line) > 0){
- numpos <- regexpr("Int", line, fixed = TRUE, useBytes = TRUE) + 4
+ if (is.R())
+ numpos <- regexpr("Int", line, fixed = TRUE, useBytes = TRUE) + 4
+ else
+ numpos <- regexpr("Int", line, fixed = TRUE) + 4
+
num <- substring(line, numpos)
if (as.numeric(num) > n.burnin){
blanks <- rep(" ", nchar(num, type = "chars") - nchar(char.burnin, type = "chars"))
@@ -28,3 +44,21 @@
writeBin (registry,
file.path(bugs.directory, "System/Rsrc/Registry.odc"), endian = "little")
}
+
+if (!is.R()){
+
+"splus.file.copy"<-
+function(from, to, overwrite = FALSE)
+{
+ require(rwBin)
+ if(!file.exists(from))
+ stop("File: ", from, " does not exist")
+ if(!overwrite && file.exists(to))
+ stop("File: ", to, " already exists and overwrite is FALSE")
+ n <- file.info(from)$size
+ z <- writeBin(readBin(from, what = "integer", size = 1, n = n), to,
+ size = 1)
+ invisible(z)
+}
+
+} #ends if (!is.R())
Modified: trunk/R2WinBUGS/R/conv.par.R
===================================================================
--- trunk/R2WinBUGS/R/conv.par.R 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/R/conv.par.R 2007-04-07 18:04:11 UTC (rev 9)
@@ -29,7 +29,7 @@
B <- n*var(xdot)
varW <- var(s2)/m
varB <- B^2 * 2/(m-1)
- covWB <- (n/m)*(cov(s2,xdot^2) - 2*muhat*cov(s2,xdot))
+ covWB <- (n/m)*(var(s2, xdot^2) - 2*muhat*var(s2, xdot))
sig2hat <- ((n-1)*W + B)/n
# Posterior interval post.range combines all uncertainties
Modified: trunk/R2WinBUGS/R/monitor.R
===================================================================
--- trunk/R2WinBUGS/R/monitor.R 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/R/monitor.R 2007-04-07 18:04:11 UTC (rev 9)
@@ -30,6 +30,9 @@
confshrink = conv.p$confshrink, n.eff = conv.p$n.eff)
}
else if (trans[i]=="logit"){
+ if (!is.R()){
+ logit <- function (x) { log(x /(1- x)) }
+ }
conv.p <- conv.par(logit(ai), n.chains, Rupper.keep=Rupper.keep)
conv.p <- list(quantiles = invlogit(conv.p$quantiles),
confshrink = conv.p$confshrink, n.eff = conv.p$n.eff)
Modified: trunk/R2WinBUGS/R/openbugs.R
===================================================================
--- trunk/R2WinBUGS/R/openbugs.R 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/R/openbugs.R 2007-04-07 18:04:11 UTC (rev 9)
@@ -1,3 +1,5 @@
+if (is.R()){
+
openbugs <- function(data, inits, parameters.to.save, model.file="model.txt",
n.chains = 3, n.iter = 2000, n.burnin = floor(n.iter/2),
n.thin = max(1, floor(n.chains *(n.iter - n.burnin)/1000)),
@@ -83,3 +85,5 @@
a.stem <- substr(a, 1, ifelse(bracket.pos>0, bracket.pos-1, nchar(a)))
return(a[order(match(a.stem, b))])
}
+
+}
Modified: trunk/R2WinBUGS/R/plot.bugs.R
===================================================================
--- trunk/R2WinBUGS/R/plot.bugs.R 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/R/plot.bugs.R 2007-04-07 18:04:11 UTC (rev 9)
@@ -1,7 +1,11 @@
plot.bugs <- function (x, display.parallel = FALSE, ...){
mar.old <- par("mar")
pty.old <- par(pty = "m")
- layout(matrix(c(1,2),1,2))
+ if (is.R())
+ layout(matrix(c(1,2),1,2))
+ else
+ par(mfrow = c(1,2))
+
bugs.plot.summary (x, ...)
bugs.plot.inferences (x, display.parallel, ...)
header <- ""
@@ -12,5 +16,42 @@
header <- paste(header, x$n.chains, " chains, each with ",
x$n.iter, " iterations (first ", x$n.burnin, " discarded)", sep = "")
mtext(header, outer = TRUE, line = -1, cex = 0.7)
- par(pty = pty.old[[1]], mar = mar.old)
+ if (is.R()) par(pty = pty.old[[1]], mar = mar.old)
+ else invisible(par(pty = pty.old[[1]], mar = mar.old))
}
+
+if (!is.R()) {
+
+strwidth <-function(s, units = c("user", "inches", "figure"), cex = NULL) {
+ s<-as.character(s)
+ if (!missing(cex)) {
+ oldcex <- par(cex=cex)
+ on.exit(par(oldcex))
+ }
+ units <- match.arg(units)
+ if (units == "user") {
+ nchar(s) * par("cxy")[1]
+ } else if (units == "inches") {
+ nchar(s) * par("cin")[1]
+ } else if (units == "figure") {
+ nchar(s) * par("cin")[1] / par("fin")[1]
+ }
+}
+
+strheight <- function(s, units = "user", cex = NULL) {
+ s<-as.character(s)
+ if (!missing(cex)) {
+ oldcex <- par(cex=cex)
+ on.exit(par(oldcex))
+ }
+ units <- match.arg(units)
+ if (units == "user") {
+ par("cxy")[2]
+ } else if (units == "inches") {
+ par("cin")[2]
+ } else if (units == "figure") {
+ par("cin")[2] / par("fin")[2]
+ }
+}
+
+} #ends if (!is.R())
Modified: trunk/R2WinBUGS/R/wineutils.R
===================================================================
--- trunk/R2WinBUGS/R/wineutils.R 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/R/wineutils.R 2007-04-07 18:04:11 UTC (rev 9)
@@ -1,5 +1,7 @@
## from Jun Yan's rbugs package, extended
+if (is.R()){
+
## get drive mapping table from ~/.wine/config
winedriveMap <- function(config="~/.wine/config") {
if (!file.exists(config)) return (NULL);
@@ -48,10 +50,16 @@
else x
}
+} # end if (is.R())
+
native2win <- function(x, useWINE=.Platform$OS.type != "windows", newWINE=TRUE) { # native -> win
- if (useWINE && !newWINE) return(winedriveRTr(x))
- if (useWINE && newWINE) {
- x <- system(paste(WINEPATH, "-w", x), intern = TRUE)
- return(gsub("\\\\", "/", x)) ## under wine BUGS cannot use \ or \\
- } else x
+ if(is.R()){
+ if (useWINE && !newWINE) return(winedriveRTr(x))
+ if (useWINE && newWINE) {
+ x <- system(paste(WINEPATH, "-w", x), intern = TRUE)
+ return(gsub("\\\\", "/", x)) ## under wine BUGS cannot use \ or \\
+ } else x
+ } else { #S-PLUS
+ gsub("\\\\", "/", x)
+ }
}
Modified: trunk/R2WinBUGS/R/write.model.R
===================================================================
--- trunk/R2WinBUGS/R/write.model.R 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/R/write.model.R 2007-04-07 18:04:11 UTC (rev 9)
@@ -1,7 +1,14 @@
write.model <- function(model, con = "model.bug")
{
- model.text <- attr(model, "source")
- model.text <- sub("^\\s*function\\s*\\(\\s*\\)", "model", model.text)
+ if (is.R()){
+ model.text <- attr(model, "source")
+ model.text <- sub("^\\s*function\\s*\\(\\s*\\)", "model", model.text)
+ } else {
+ ## In S-PLUS the source code of a function can be obtained with
+ ## as.character(function_name). This omits the "function_name <- function()" piece
+ model.text <- as.character(model)
+ model.text <- paste("model", model.text)
+ }
model.text <- gsub("%_%", "", model.text)
writeLines(model.text, con = con)
}
Modified: trunk/R2WinBUGS/man/bugs.Rd
===================================================================
--- trunk/R2WinBUGS/man/bugs.Rd 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/man/bugs.Rd 2007-04-07 18:04:11 UTC (rev 9)
@@ -1,9 +1,9 @@
\name{bugs}
\alias{bugs}
-\title{Run WinBUGS and OpenBUGS from R}
+\title{Run WinBUGS and OpenBUGS from R or S-PLUS}
\description{The \code{bugs} function takes data and starting values as input.
It automatically writes a WinBUGS script, calls the model,
-and saves the simulations for easy access in R.}
+and saves the simulations for easy access in R or S-PLUS.}
\usage{
bugs(data, inits, parameters.to.save, model.file = "model.bug",
n.chains = 3, n.iter = 2000, n.burnin = floor(n.iter/2),
@@ -57,7 +57,8 @@
through function \code{\link{read.bugs}}. (not used if \code{program = "openbugs"})}
\item{bugs.directory}{directory that contains the WinBUGS executable}
\item{program}{the program to use, either \code{winbugs}/\code{WinBugs} or \code{openbugs}/\code{OpenBugs},
- the latter makes use of function \code{\link{openbugs}} and requires the CRAN package \pkg{BRugs}.}
+ the latter makes use of function \code{\link{openbugs}} and requires the CRAN package \pkg{BRugs}.
+ The \code{openbugs}/\code{OpenBugs} choice is not available in S-PLUS.}
\item{working.directory}{sets working directory during execution of this function;
WinBUGS' in- and output will be stored in this directory;
if \code{NULL}, the current working directory is chosen.}
@@ -69,7 +70,8 @@
\item{useWINE}{logical; attempt to use the WINE emulator to run WinBUGS,
defaults to \code{TRUE} on Windows, and \code{FALSE} otherwise.
If WINE is used, the arguments \code{bugs.directory} and \code{working.directory} must be given in form of Linux paths
- rather than Windows paths (if not \code{NULL}).}
+ rather than Windows paths (if not \code{NULL}).
+ The \code{useWINE = TRUE} option is not available in S-PLUS.}
\item{WINE}{character; name of WINE binary file}
\item{newWINE}{Set this one to \code{TRUE} for new versions of WINE.}
\item{WINEPATH}{Path the WINE, it is tried hard to get the information automatically if not given.}
@@ -78,12 +80,12 @@
To run:
\enumerate{
\item Write a WinBUGS model in a ASCII file.
-\item Go into R.
+\item Go into R / S-PLUS.
\item Prepare the inputs to the \code{bugs} function and run it (see Example).
-\item A WinBUGS window will pop up amd R will freeze up. The model
+\item A WinBUGS window will pop up and R / S-PLUS will freeze up. The model
will now run in WinBUGS. It might take awhile. You will see
things happening in the Log window within WinBUGS. When WinBugs
- is done, its window will close and R will work again.
+ is done, its window will close and R / S-PLUS will work again.
\item If an error message appears, re-run with \code{debug = TRUE}.
}}
\value{
Modified: trunk/R2WinBUGS/man/bugs.log.Rd
===================================================================
--- trunk/R2WinBUGS/man/bugs.log.Rd 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/man/bugs.log.Rd 2007-04-07 18:04:11 UTC (rev 9)
@@ -17,7 +17,7 @@
}
\details{
In later releases of R2WiNBUGS, this function is considered to read the relevant data from the log file rather than
-analysing and calculating the relevant data in R again.
+analysing and calculating the relevant data in R / S-PLUS again.
}
\seealso{The main function that generates the log file is \code{\link{bugs}}.}
\keyword{IO}
Modified: trunk/R2WinBUGS/man/bugs.run.Rd
===================================================================
--- trunk/R2WinBUGS/man/bugs.run.Rd 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/man/bugs.run.Rd 2007-04-07 18:04:11 UTC (rev 9)
@@ -13,7 +13,8 @@
\item{bugs.directory}{directory that contains the WinBUGS executable}
\item{WINE}{name of WINE binary, for Windows emulation}
\item{useWINE}{logical; attempt to use the WINE emulator to run WinBUGS,
- defaults to \code{TRUE} on Windows, and \code{FALSE} otherwise.}
+ defaults to \code{TRUE} on Windows, and \code{FALSE} otherwise.
+ The \code{useWINE = TRUE} option is not available in S-PLUS.}
\item{newWINE}{set this one to \code{TRUE} for new versions of WINE.}
}
\value{
Modified: trunk/R2WinBUGS/man/bugs.script.Rd
===================================================================
--- trunk/R2WinBUGS/man/bugs.script.Rd 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/man/bugs.script.Rd 2007-04-07 18:04:11 UTC (rev 9)
@@ -20,7 +20,8 @@
or have to be generated by WinBUGS}
\item{bin}{number of iterations between saving of results}
\item{DIC}{logical; if \code{TRUE}, compute deviance, pD, and DIC automatically in WinBUGS}
- \item{useWINE}{logical; use WINE to run WinBUGS under Linux}
+ \item{useWINE}{logical; use WINE to run WinBUGS under Linux.
+ The \code{useWINE = TRUE} option is not available in S-PLUS.}
\item{newWINE}{set this one to \code{TRUE} for new versions of WINE.}
\item{WINEPATH}{Path the WINE, \code{bugs} tries hard to get the information automatically and
pass it to this function, if not given.}
Modified: trunk/R2WinBUGS/man/bugs.sims.Rd
===================================================================
--- trunk/R2WinBUGS/man/bugs.sims.Rd 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/man/bugs.sims.Rd 2007-04-07 18:04:11 UTC (rev 9)
@@ -2,7 +2,7 @@
\alias{bugs.sims}
\title{WinBUGS output reader - intended for internal use only}
\description{
-Reads simulations from WinBUGS into R, formats them, monitors convergence,
+Reads simulations from WinBUGS into R/ S-PLUS, formats them, monitors convergence,
performs convergence checks, and computes medians and quantiles. Intended for internal use only.}
\usage{
bugs.sims(parameters.to.save, n.chains, n.iter, n.burnin, n.thin,
Modified: trunk/R2WinBUGS/man/openbugs.Rd
===================================================================
--- trunk/R2WinBUGS/man/openbugs.Rd 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/man/openbugs.Rd 2007-04-07 18:04:11 UTC (rev 9)
@@ -2,7 +2,8 @@
\alias{openbugs}
\title{Wrapper to run OpenBUGS}
\description{The \code{openbugs} function takes data and starting values as input.
-It automatically calls the package \pkg{BRugs} and runs something similar to \code{\link[BRugs]{BRugsFit}}.}
+It automatically calls the package \pkg{BRugs} and runs something similar to \code{\link[BRugs]{BRugsFit}}.
+Not available in S-PLUS.}
\usage{
openbugs(data, inits, parameters.to.save,
model.file = "model.txt", n.chains = 3, n.iter = 2000,
Modified: trunk/R2WinBUGS/man/write.model.Rd
===================================================================
--- trunk/R2WinBUGS/man/write.model.Rd 2006-12-29 16:10:15 UTC (rev 8)
+++ trunk/R2WinBUGS/man/write.model.Rd 2007-04-07 18:04:11 UTC (rev 9)
@@ -1,12 +1,12 @@
\name{write.model}
\alias{write.model}
\title{Creating a WinBUGS model file}
-\description{Convert R function to a WinBUGS model file}
+\description{Convert R / S-PLUS function to a WinBUGS model file}
\usage{
write.model(model, con = "model.bug")
}
\arguments{
- \item{model}{R function containg the BUGS model in the BUGS model language, for minor differences see Section Details.}
+ \item{model}{R / S-PLUS function containing the BUGS model in the BUGS model language, for minor differences see Section Details.}
\item{con}{passed to \code{link{writeLines}} which actually writes the model file}
}
\value{
@@ -18,7 +18,7 @@
As a difference, BUGS syntax allows truncation specification like this:
\code{dnorm(...) I(...)}
-but this is illegal in R. To overcome this incompatibility, use \code{\%_\%} before \code{I(...)}:
+but this is illegal in R / S-PLUS. To overcome this incompatibility, use \code{\%_\%} before \code{I(...)}:
\code{dnorm(...) \%_\% I(...)}.
The dummy operator \code{\%_\%} will be removed before the BUGS code is saved.
}
@@ -36,8 +36,14 @@
sigma.theta ~ dunif (0, 1000)
}
-## some temporary filename:
-filename <- file.path(tempdir(), "schoolsmodel.bug")
+if (is.R()){ # for R
+ ## some temporary filename:
+ filename <- file.path(tempdir(), "schoolsmodel.bug")
+} else{ # for S-PLUS
+ ## put the file in the working directory:
+ filename <- "schoolsmodel.bug"
+}
+
## write model file:
write.model(schoolsmodel, filename)
## and let's take a look:
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
|
