.packageName <- "rbugs"
#### configurations  12/15/2003
## BUGS stores the executable of bugs
## workingDir is the directory to save all files, default is ??tempdir()??
## bugsWorkingDir is the directory for wine to use windows type directory
## WINE stores the executable of wine
## useWine = TRUE if use wine

## example usage on linux
## schools.sim <- rbugs(data=schools.data, inits, parameters, "schools.bug", n.chains=3, n.iter=1000, workingDir="/var/tmp/jyan/c/tmp", bugsWorkingDir="c:/tmp", useWine=T, wine="/var/scratch/jyan//wine/wine-20031016/wine", debug=T)


rbugs <- function(data, inits, paramSet, model,
                  n.chains=1, n.iter=2000, n.burnin=floor(n.iter/2),
                  n.thin=max(1, floor(n.chains*(n.iter-n.burnin)/1000)),
                  debug=FALSE,
                  bugs=Sys.getenv("BUGS"),
                  ##"c:/Program Files/WinBUGS14/WinBUGS14.exe",
                  workingDir = NULL, #getwd(),
                  ##"/var/scratch/jyan/c/tmp", # native
                  bugsWorkingDir = getwd(),
                  ##"c:/tmp",
                  useWine = FALSE, 
                  wine = Sys.getenv("WINE"),
                  verbose = FALSE
                  ## "/var/scratch/jyan/wine/wine-20031016/wine"
                  ){
  ##  start.time <- Sys.time ()
  os.type <- .Platform$OS.type
  if (os.type == "windows") {
    if (!file.exists(bugs))
      stop(paste("BUGS executable", bugs, "does not exists."))
  }
  else if (os.type == "unix") {
    if (!useWine) stop ("Please set useWine = TRUE.")
    if (!file.exists(wine))
      stop(paste("wine executable", wine, "does not exists."))
    ## how to check the existence of WinBUGS???
  }
  else warning("This function has not been tested on mac-os.")
  
  ## setup workingDir 
  if (is.null(workingDir)) {
    if (useWine) workingDir <- driveTr(bugsWorkingDir, .DriveTable)
    else workingDir <- bugsWorkingDir
  }
  ## prepare the model file by 
  ## making a copy of model to the working directory
  if (!file.exists(model)) stop("Model file doesn't exits.")
  model.file <- paste(workingDir, "model.txt", sep="/")
  file.copy(model, model.file, overwrite=TRUE)

  ## prepare the data file
  data.file <- paste(workingDir, "data.txt", sep="/")
  genDataFile(data, data.file)

  ## prepare the inits files
  inits.file.stem <- paste(workingDir, "init", sep="/")
  genInitsFile(n.chains, inits, inits.file.stem)
  inits.files <- paste(inits.file.stem, 1:n.chains, ".txt", sep="")

  ## prepare the script file
  script.file <- paste(workingDir, "script.txt", sep="/")
  genBugsScript(paramSet, n.chains, n.iter, n.burnin, n.thin,
                model.file, data.file, inits.files,
                workingDir, bugsWorkingDir,
                script.file, debug, useWine)

  ## run bugs
  if (useWine) script.file <- gsub(workingDir, bugsWorkingDir, script.file)
  runBugs(bugs, script.file, n.chains, workingDir, useWine, wine, verbose)

  ## collect the output
  out <- getBugsOutput(n.chains, workingDir)
  out
}


genDataFile <- function(dataList, dataFile) {
  if (is.numeric(unlist(dataList))) {
    ## cat(dput2bugs(dataList), file = data.file)
    cat(format4Bugs(dataList), file = dataFile, fill = TRUE)
  }
  else {
    data <- lapply(dataList, get, pos = 1)
    names(data) <- dataList
    ## cat(dput2bugs(data), file = data.file, fill = TRUE)
    cat(format4Bugs(data), file = dataFile, fill = TRUE)
  }
}


genInitsFile <- function(n.chains, inits, initsFileStem) {
  for (i in 1:n.chains) {
    file <- paste(initsFileStem, i, ".txt", sep="")
    if (is.function(inits)) cat(format4Bugs(inits()), file=file, fill = TRUE)
    else cat(format4Bugs(inits[[i]]), file=file, fill = TRUE)
  }
}


genBugsScript <- function(paramSet,
                          n.chains,
                          n.iter,
                          n.burnin,
                          n.thin,
                          model.file,
                          data.file,
                          inits.files,
                          workingDir=NULL, #getwd(),
                          ## needs to be readable for BUGS
                          bugsWorkingDir=getwd(), 
                          script, #output
                          debug=FALSE, useWine=FALSE) {
  if (n.chains != length(inits.files)) stop("length(inits.files) should equal n.chains.")
  ## n.iter <- n.burnin + n.thin * n.keep

  ## add deviance to the paramSet list
  paramSet <- c(paramSet, "deviance")

  ## setup workingDir 
  if (is.null(workingDir)) {
    if (useWine) workingDir <- driveTr(bugsWorkingDir, .DriveTable)
    else workingDir <- bugsWorkingDir
  }
  ## necessary if useWine == TRUE:
  if (useWine) {
    model.file <- sub(workingDir, bugsWorkingDir, model.file)
    data.file <- sub(workingDir, bugsWorkingDir, data.file)
    for (i in 1:length(inits.files))
      inits.files[i] <- sub(workingDir, bugsWorkingDir, inits.files[i])
  }
  
  ##  history <- paste(bugsWorkingDir, "history.txt", sep="/")
  coda  <- paste(bugsWorkingDir, "coda", sep="/")
  logodc <- paste(bugsWorkingDir, "log.odc", sep="/")
  logfile <- paste(bugsWorkingDir, "log.txt", sep="/")
  initlist <- paste("inits (", 1:n.chains, ", '", inits.files, "')\n", sep="")
  savelist <- paste("set (", paramSet, ")\n", sep="")
  ## write out to script.txt
  cat (
       "display ('log')\n",
       "check ('", model.file, "')\n",
       "data ('", data.file, "')\n",
       "compile (", n.chains, ")\n",
       initlist,
       "gen.inits()\n",
       "beg (", ceiling(n.burnin / n.thin) + 1, ")\n",
       "thin.updater (", n.thin, ")\n",
       savelist,
       ## some try update before dic.set()
       "update (", ceiling(n.burnin / n.thin), ")\n",
       "dic.set()\n",
       "update (", ceiling((n.iter - n.burnin) / n.thin), ")\n",
       "stats (*)\n",
       "dic.stats()\n",
       ## "history (*, '", history, "')\n",
       "coda (*, '", coda, "')\n",
       "save ('", logodc, "')\n", 
       "save ('", logfile, "')\n", file=script, sep="", append=FALSE)
  if (!debug) cat ("quit ()\n", file=script, append=TRUE)
}



#### run bugs
runBugs <- function(bugs=Sys.getenv("BUGS"),
                    script, n.chains, workingDir,
                    useWine=FALSE,
                    wine = Sys.getenv("WINE"), verbose = TRUE) {
#  BUGS <- Sys.getenv("BUGS")
#  if (!file.exists(BUGS)) stop(paste(BUGS, "does not exists."))
  if (is.na(pmatch("\"", bugs)))bugs <- paste("\"", bugs, "\"", sep="")
  if (is.na(pmatch("\"", script))) script <- paste("\"", script, "\"", sep="")
  command <- paste(bugs, "/par", script)
  if (useWine) {
    command <- paste(wine, command)

    ## put a "q" to quit from wine debugg
    q.tmp <- tempfile("q")
    on.exit(unlink(q.tmp))
    cat("q\n", file=q.tmp)
    command <- paste(command, "< ", q.tmp)

    ## redirect the erorr/warning message of Wine
    wine.warn <- tempfile("warn")
    on.exit(unlink(wine.warn))
    command <- paste(command, ">", wine.warn, " 2>&1 ")
  }
  
  ## clean up previous coda files8dd
  coda.files <- paste ("coda", 1:n.chains, ".txt", sep="")
  coda.files <- c("codaIndex.txt", coda.files)
  coda.files <- file.path(workingDir, coda.files)
  for (i in coda.files) {
    ## cat ("Bugs did not run correctly.\n", file=coda.files[i], append=FALSE)
   if (file.exists(i)) file.remove(i) 
  }
  ## execute it!
  err <- system(command)
  if (err == -1) stop("System call to BUGS failed.")
  ## show log
  if (verbose) file.show(file.path(workingDir, "log.txt"))

  if (!file.exists(coda.files[1])) 
    stop("BUGS stopped before getting to coda.")
}


#### functions to get the output



getBugsOutput <- function(n.chains, workingDir) {
  coda  <- paste(workingDir, "coda", sep="/")
  codaFiles <- paste(coda, 1:n.chains, ".txt", sep="")
  codaIndexFile <- paste(coda, "Index.txt", sep="")
  codaIndex <- read.table(codaIndexFile, header=FALSE, sep="\t", as.is=TRUE)
  n.keep <- codaIndex[1, 3] - codaIndex[1, 2] + 1
  nodes <- codaIndex[, 1]
  n.param <- length(nodes)
  output <- list()
  for (i in 1:n.chains) {
    foo <- read.table(codaFiles[i], header=FALSE)
    iter <- foo[1:n.keep, 1]
    vals <- matrix(foo[,2], n.keep, n.param)
    dat <- as.data.frame(cbind(iter, vals))
    names(dat) <- c("iter", nodes)
    output[[i]] <- dat
  }    
  output
}
## Modified Function from EmBedBugs package (embedR), by Kenneth Rice
## adapted from http://www.mrc-bsu.cam.ac.uk/personal/ken/embed.html
## old page was: www.statslab.cam.ac.uk/~krice/embed.html
formatData <- function (datalist){
    if (!is.list(datalist) || is.data.frame(datalist)) 
        stop("Argument to format.data must be a list.")
    n <- length(datalist)
    datalist.string <- as.list(rep(NA, n))
    for (i in 1:n) {
        if (length(datalist[[i]]) == 
            1) 
            datalist.string[[i]] <- paste(names(datalist)[i], 
                "=", as.character(datalist[[i]]), sep = "")
        if (is.vector(datalist[[i]]) & length(datalist[[i]]) > 
            1) 
            datalist.string[[i]] <- paste(names(datalist)[i], 
                "=c(", paste(as.character(datalist[[i]]), collapse = ", "), 
                ")", sep = "")
        if (is.array(datalist[[i]])) 
            datalist.string[[i]] <- paste(names(datalist)[i], 
                "= structure(.Data= c(", paste(as.character(as.vector(aperm(datalist[[i]]))), 
                  collapse = ", "), "), .Dim=c(", paste(as.character(dim(datalist[[i]])), 
                  collapse = ", "), "))", sep = "")
    }
    datalist.tofile <- paste("list(", paste(unlist(datalist.string), 
        collapse = ", "), ")", sep = "")
    return(datalist.tofile)
}

format4Bugs <- function (dataList, digits=5){
  if (!is.list(dataList) || is.data.frame(dataList)) 
    stop("Argument to formatdata() must be a list.")
#   tmp <- tempfile("dat")
#   on.exit(unlink(tmp))
  ## make sure there is no more than 14 digits
  if (digits > 14) digits <- 14
  dataListString <- lapply(dataList,
                            function(x) {
                              if (is.data.frame(x)) x <- as.matrix(x)
                              dimnames(x) <- NULL
                              if (is.integer(x)) formatC(x, digits=0)
                              ## make sure "E" instead of "e"
                              else formatC(x, format="E", digits=digits)
                            })

  foo <- formatData(dataListString)
  foo <- gsub('"', '', foo)
  foo
# The following method does not always work!  
#   dput(dataListString, tmp)
#   foo <- readLines(tmp)
#   foo <- sub('^structure\\(', '', foo)
#   foo <- gsub('structure\\(c', 'structure\\(.Data=c', foo)
#   foo <- sub('\\), .Names.*$', '\\)', foo)
#   foo <- gsub('"', '', foo)
#   foo <- gsub('as.integer\\(c\\(', 'c\\(', foo)
#   foo <- gsub('\\)\\)', '\\)', foo)
#   foo
}


## generate t.cen from a Surv object

# t.cen <- function(time, status) {
#   ifelse(status == 1, 0, time)
# }

## get drive mapping table from ~/.wine/config
driveMap <- function(config) {
  if (!file.exists(config)) return (NULL);
  con <- readLines(config)
  con <- con[- grep("^;", con)]
  drive <- con[grep("^\\[Drive ", con)]
  drive <- substr(drive, 8, 8)
  drive <- paste(drive, ":", sep="")
  path <- con[grep("Path", con)]
  len <- length(drive)
  path <- path[1:len]
  dir <- sapply(path, 
                 function(x) {
                   foo <- unlist(strsplit(x, "\""))
                   foo[length(foo)]
                 })
  data.frame(drive = I(drive), path = I(dir), row.names=NULL)
}


## translate windows dir to native dir
driveTr <- function(windir, DriveTable) {
##  .DriveTable <- driveMap(file.path(Sys.getenv("HOME"), ".wine/config"))
##  win.dr <- unlist(strsplit(windir, ":"))[1]
  win.dr <- substr(windir, 1, 2)
  ind <- pmatch(toupper(win.dr), DriveTable$drive)
  native.dr <- DriveTable$path[ind]
  sub(win.dr, native.dr, windir)
}

.DriveTable <- driveMap(file.path(Sys.getenv("HOME"), ".wine/config"))
