Thread: [Bugs-r-devel] SF.net SVN: bugs-r: [14] trunk/R2WinBUGS/R

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Revision: 14
          http://svn.sourceforge.net/bugs-r/?rev=14&view=rev
Author:   woodard_
Date:     2007-05-08 14:58:37 -0700 (Tue, 08 May 2007)

Log Message:
-----------
Fixed the handling of numbers in scientific notation by write.model in S-PLUS.  The S-PLUS scientific notation is different from the WinBUGS notation.  A new function was added to change the format of all numbers in scientific notation in the model text.

Modified Paths:
--------------
    trunk/R2WinBUGS/R/bugs.data.R
    trunk/R2WinBUGS/R/write.model.R

Modified: trunk/R2WinBUGS/R/bugs.data.R
===================================================================

--- trunk/R2WinBUGS/R/bugs.data.R	2007-05-08 21:50:38 UTC (rev 13)
+++ trunk/R2WinBUGS/R/bugs.data.R	2007-05-08 21:58:37 UTC (rev 14)
@@ -55,55 +55,6 @@
 	# 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)
@@ -219,4 +170,60 @@
 	invisible(0)
 }
 
+
+toSingleS4 =
+#
+# Takes numeric vector and removes digit of exponent in scientific notation (if any)
+# 
+# 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(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
+}
+
 } # ends if (!is.R())

Modified: trunk/R2WinBUGS/R/write.model.R
===================================================================
--- trunk/R2WinBUGS/R/write.model.R	2007-05-08 21:50:38 UTC (rev 13)
+++ trunk/R2WinBUGS/R/write.model.R	2007-05-08 21:58:37 UTC (rev 14)
@@ -10,5 +10,48 @@
     model.text <- paste("model", model.text)
   }
   model.text <- gsub("%_%", "", model.text)
+  if (!is.R()){
+    ## In S-PLUS, scientific notation is different than it is in WinBUGS.
+    ## Change the format of any numbers in scientific notation.
+    model.text <- replaceScientificNotation(model.text)
+
+    ## remove the "invisible()" line.  
+    model.text <- gsub("invisible[ ]*\\([ ]*\\)", "", model.text)
+  }
   writeLines(model.text, con = con)
 }
+
+if (!is.R()){
+
+replaceScientificNotation <- function(text){
+## Change the format of any numbers in "text" that are in S-PLUS 
+## scientific notation to WinBUGS scientific notation
+
+  ## First, handle the positive exponents
+  ## Find the first instance
+  ## Note that the number may or may not have a decimal point.
+  sciNoteLoc <- regexpr("[0-9]*\\.{0,1}[0-9]*e\\+0[0-9]{2}", text)
+	
+  ## For every instance, replace the number
+  while(sciNoteLoc > -1){
+    sciNoteEnd <- sciNoteLoc + attr(sciNoteLoc, "match.length")-1
+    sciNote <- substring(text, sciNoteLoc, sciNoteEnd)
+    text <- gsub(sciNote, toSingleS4(sciNote), text)
+    sciNoteLoc <- regexpr("[0-9]*\\.{0,1}[0-9]*e\\+0[0-9]{2}", text)
+  }
+
+  ## Then, handle the negative exponents
+  ## Find the first instance
+  sciNoteLoc <- regexpr("[0-9]*.{0,1}[0-9]*e\\-0[0-9]{2}", text)
+
+  ## For every instance, replace the number
+  while(sciNoteLoc > -1){
+    sciNoteEnd <- sciNoteLoc + attr(sciNoteLoc, "match.length")-1
+    sciNote <- substring(text, sciNoteLoc, sciNoteEnd)
+    text <- gsub(sciNote, toSingleS4(sciNote), text)
+    sciNoteLoc <- regexpr("[0-9]*\\.{0,1}[0-9]*e\\-0[0-9]{2}", text)
+  }
+
+  text
+}
+} ## ends if (!is.R())


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




Thread: [Bugs-r-devel] SF.net SVN: bugs-r: [14] trunk/R2WinBUGS/R

bugs-r-devel