welcome: please sign in
location: attachment:Win2OpenBUGS.txt of UserContributedCode

Attachment 'Win2OpenBUGS.txt'

Download

   1 Win2OpenBUGS <- function(WinBugsScriptFile,OpenBugsScriptFile)
   2 {
   3 ###  Translate a WinBUGS script file to an OpenBUGS script file.
   4 ###
   5 ###  The first argument is a character string giving the name of a text file
   6 ###  containing a WinBUGS script, e.g., "c:/temp/wbscript.txt".  The second
   7 ###  argument is a character string giving the name of a text file to which
   8 ###  the corresponding OpenBUGS script will be written, e.g.,
   9 ###  "c:/temp/obscript.txt".
  10 ###
  11 ###  Chris Jackson <chris.jackson@mrc-bsu.cam.ac.uk> April 2010
  12 
  13     cmds <- 
  14         rbind(
  15               c("compile","modelCompile"),
  16               c("gen.inits","modelGenInits"),
  17               c("data","modelData"),
  18               c("check","modelCheck"),
  19               c("display","modelDisplay"),
  20               c("quit","modelQuit"),
  21               c("save","modelSaveLog"),
  22               c("set.rank","ranksSet"),
  23               c("stats.rank","ranksStats"),
  24               c("hist.rank","ranksHistogram"),
  25               c("clear.rank","ranksClear"),
  26               c("set","samplesSet"),
  27               c("thin.samples","samplesThin"),
  28               c("density","samplesDensity"),
  29               c("autoC","samplesAutoC"),
  30               c("history","samplesHistory"),
  31               c("stats","samplesStats"),
  32               c("trace","samplesTrace"),
  33               c("coda","samplesCoda"),
  34               c("quantiles","samplesQuantiles"),
  35               c("gr","samplesBgr"),
  36               c("beg","samplesBeg"),
  37               c("end","samplesEnd"),
  38               c("first","samplesFirstChain"),
  39               c("last","samplesLastChain"),
  40               c("set.summary","summarySet"),
  41               c("stats.summary","summaryStats"),
  42               c("mean.summary","summaryMean"),
  43               c("clear.summary","summaryClear"),
  44               c("dic.set","dicSet"),
  45               c("dic.stats","dicStats")
  46               )
  47 
  48     ## Most commands are simple drop-in replacements of their WinBUGS equivalents.
  49     ## Preserve any space between command and open bracket.
  50     ## Commands may be commented out or have whitespace before them 
  51     OpenBugsScript <- readLines(WinBugsScriptFile)
  52     for (i in 1:nrow(cmds)) {
  53         win.cmd <- paste("^([[:space:]#]*)", cmds[i,1], "([[:space:]]*\\(.*\\).*)", sep="")
  54         open.cmd <- paste("\\1", cmds[i,2], "\\2", sep="")
  55         OpenBugsScript <- gsub(win.cmd, open.cmd, OpenBugsScript)
  56     }
  57 
  58     ## modelInits(file, chain) instead of inits(chain, file)
  59     ## preserve existing white-space formatting
  60     sqstring <- "\\'[^\\']*\\'"   # single-quoted file name. spaces are meaningful in filenames
  61     win.cmd <- paste("inits([[:space:]]*\\([[:space:]]*)([^[:space:]]*)([[:space:]]*,[[:space:]]*)(",sqstring,")([[:space:]]*\\))",sep="")
  62     open.cmd <- "modelInits\\1\\4\\3\\2\\5"
  63     OpenBugsScript <- gsub(win.cmd, open.cmd, OpenBugsScript)
  64     dqstring <- '\"[^\"]*\"'   # double-quoted file name. 
  65     win.cmd <- paste("inits([[:space:]]*\\([[:space:]]*)([^[:space:]]*)([[:space:]]*,[[:space:]]*)(",dqstring,")([[:space:]]*\\))",sep="")
  66     OpenBugsScript <- gsub(win.cmd, open.cmd, OpenBugsScript)
  67     
  68     ## modelUpdate(1000, 2, 10, 'T')  instead of
  69     ## update(1000); thin.updater(2); refresh(10); over.relax('T')
  70     ## set thin to 1 if no thin.updater command or it's commented out 
  71     ## set refresh to 100 if no refresh command or it's commented out 
  72     thin.ind <- grep("^[^#]*thin\\.updater[[:space:]]*\\(.+\\).*", OpenBugsScript)
  73     refresh.ind <- grep("^[^#]*refresh[[:space:]]*\\(.+\\).*", OpenBugsScript)
  74     overrelax.ind <- grep("^[^#]*over\\.relax[[:space:]]*\\(.+\\).*", OpenBugsScript)
  75     thin <-
  76         if (length(thin.ind) == 0) 1
  77         else gsub("^[^#]*thin\\.updater[[:space:]]*\\((.+)\\).*", "\\1", OpenBugsScript[thin.ind][1])
  78     refresh <-
  79         if (length(refresh.ind) == 0) 100
  80         else gsub("^[^#]*refresh[[:space:]]*\\((.+)\\).*", "\\1", OpenBugsScript[refresh.ind][1])
  81     overrelax <-
  82         if (length(overrelax.ind) == 0) "\'F\'"
  83         else gsub("^[^#]*over\\.relax[[:space:]]*\\((.+)\\).*", "\\1", OpenBugsScript[overrelax.ind][1])
  84     if (any(length(thin.ind),length(refresh.ind),length(overrelax.ind)))
  85         OpenBugsScript <- OpenBugsScript[-c(thin.ind,refresh.ind,overrelax.ind)]
  86     win.cmd <- "update([[:space:]]*\\(.*)\\)"
  87     open.cmd <- 
  88         if (length(overrelax.ind) > 0)
  89             paste("modelUpdate\\1,",thin,",",refresh,",",overrelax,")",sep="")
  90         else if (length(refresh.ind) > 0)
  91             paste("modelUpdate\\1,",thin,",",refresh,")",sep="")
  92         else if (length(thin.ind) > 0)
  93             paste("modelUpdate\\1,",thin,")",sep="")          
  94         else "modelUpdate\\1)"
  95     OpenBugsScript <- gsub(win.cmd, open.cmd, OpenBugsScript)        
  96     
  97     ## double-quote any stars supplied as node wildcards
  98     ## only quote stars which are not already single or double quoted
  99     ## preserve existing white-space formatting 
 100     OpenBugsScript <- gsub("([^\"\'[:space:]][[:space:]]*)\\*([[:space:]]*[^\"\'[:space:]])", "\\1\"\\*\"\\2", OpenBugsScript)
 101 
 102     writeLines(OpenBugsScript,OpenBugsScriptFile)
 103     OpenBugsScript
 104 }

Attached Files

To refer to attachments on a page, use attachment:filename, as shown below in the list of files. Do NOT use the URL of the [get] link, since this is subject to change and can break easily.

You are not allowed to attach a file to this page.