[Bugs-r-devel] SF.net SVN: bugs-r:[127] trunk/R2WinBUGS

[<li...@us...>]

Revision: 127
          http://bugs-r.svn.sourceforge.net/bugs-r/?rev=127&view=rev
Author:   ligges
Date:     2009-11-05 16:01:06 +0000 (Thu, 05 Nov 2009)

Log Message:
-----------
fix for encoding issues for R >= 2.10.0

Modified Paths:
--------------
    trunk/R2WinBUGS/R/bugs.update.settings.R
    trunk/R2WinBUGS/inst/NEWS

Modified: trunk/R2WinBUGS/R/bugs.update.settings.R
===================================================================
--- trunk/R2WinBUGS/R/bugs.update.settings.R	2009-11-05 16:00:32 UTC (rev 126)
+++ trunk/R2WinBUGS/R/bugs.update.settings.R	2009-11-05 16:01:06 UTC (rev 127)
@@ -1,58 +1,60 @@
 "bugs.update.settings" <-
   function (n.burnin, bugs.directory)
 {
-  char.burnin <- as.character(n.burnin - 1)
   if(is.R()) {
     .fileCopy <- file.copy
+    .regexpr <- function(...) regexpr(..., useBytes = TRUE)
+    .sub <- function(...) sub(..., useBytes = TRUE)
+    .writeBin <- 
+        if(getRversion() >= "2.10") 
+            function(...) writeBin(..., useBytes = TRUE)
+        else 
+            writeBin
   } else {
     .fileCopy <- splus.file.copy
+    .regexpr <- regexpr
+    .sub <- sub
+    .writeBin <- writeBin
   }
-  .fileCopy(file.path(bugs.directory, "System/Rsrc/Registry.odc"),
-            file.path(bugs.directory, "System/Rsrc/Registry_Rsave.odc"),
-            overwrite=TRUE)
+  
+  
+  char.burnin <- as.character(n.burnin - 1)
   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")
-  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)
+  .fileCopy(file.path(bugs.directory, "System/Rsrc/Registry.odc"),
+            file.path(bugs.directory, "System/Rsrc/Registry_Rsave.odc"),
+            overwrite = TRUE)
+  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) {
-      if(is.R()) {
-        numpos <- regexpr("Int", line, fixed=TRUE, useBytes=TRUE) + 4
-      } else {
-        numpos <- regexpr("Int", line, fixed=TRUE) + 4
-      }
+    line <- substring(info, 1, .regexpr("\r", info) - 1)
+    if(.regexpr("AdaptivePhase", line) > 0) {
+      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"))
         num.new <- paste(paste(blanks, collapse=""), char.burnin, sep="")
-        line.new <- sub(num, num.new, line)
-        registry <- sub(line, line.new, registry)
+        line.new <- .sub(num, num.new, line)
+        registry <- .sub(line, line.new, registry)
       }
     }
   }
   Sys.setlocale("LC_CTYPE", locale)
-  writeBin(registry,
-           file.path(bugs.directory, "System/Rsrc/Registry.odc"), endian="little")
+  .writeBin(registry,
+           file.path(bugs.directory, "System/Rsrc/Registry.odc"), endian="little", useBytes = TRUE)
 }
 
-## TODO: why is not this function called just file.copy within !is.R()
 
-"splus.file.copy"<-
-  function(from, to, overwrite=FALSE)
+splus.file.copy <- function(from, to, overwrite=FALSE)
 {
-  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)
+    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)
 }

Modified: trunk/R2WinBUGS/inst/NEWS
===================================================================
--- trunk/R2WinBUGS/inst/NEWS	2009-11-05 16:00:32 UTC (rev 126)
+++ trunk/R2WinBUGS/inst/NEWS	2009-11-05 16:01:06 UTC (rev 127)
@@ -4,6 +4,7 @@
 Update 2.1-15
 - added seed argument to openbugs()
 - fix write.model() to work for separatly specified function body
+- fix bugs.update.settings() for R>=2.10.0 compatibility
 
 Update 2.1-14
 - new argument over.relax=FALSE


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.