[Mattice-commits] r183 - in pkg: R misc

[noreply at r-forge.r-project.org]

Author: andrew_hipp
Date: 2009-02-25 22:19:08 +0100 (Wed, 25 Feb 2009)
New Revision: 183

Added:
   pkg/misc/oldRegimeMatrix.R
Modified:
   pkg/R/regimes.R
Log:
trimming three obsolete functions from the project, moving to misc/oldRegimeMatrix.R

Modified: pkg/R/regimes.R
===================================================================
--- pkg/R/regimes.R	2009-02-25 15:45:50 UTC (rev 182)
+++ pkg/R/regimes.R	2009-02-25 21:19:08 UTC (rev 183)
@@ -132,27 +132,6 @@
   return(outdata)
 }
 
-oldRegimeMatrix <- function(n = NULL, nodeNames = NULL, regimeNames = NULL, maxNodes = NULL) {
-## a brute-force approach, very inefficient as n and maxNodes diverge
-## I'm leaving this in here only b/c i don't know whether the recursive function will fail at large maxNodes
-  if(identical(n, NULL) && identical(nodeNames, NULL)) stop("You have to give regimeMatrix the number of nodes, a vector of node names, or both")
-  if(identical(nodeNames, NULL)) nodeNames <- as.character(seq(n))
-  else n <- length(nodeNames)
-  if(identical(maxNodes, NULL)) maxNodes <- n
-  outmatrix <- matrix(NA, nrow = 0, ncol = n, dimnames = list(NULL, nodeNames))
-  maxNumberOfRegimes <- ifelse(n == 1, 2, 2^n)
-  counter <- 1
-  repeat {
-    temp <- as.binary(counter, digits = n)
-    if(sum(temp) <= maxNodes) outmatrix <- rbind(outmatrix, temp) 
-    if(counter == maxNumberOfRegimes - 1) break
-    counter <- counter + 1
-    }
-  outmatrix <- rbind(outmatrix, as.binary(0, digits = n))
-  dimnames(outmatrix)[[1]] <- seq(dim(outmatrix)[1])
-  return(outmatrix)
-}
-
 regimeMatrix <- function(n, maxNodes) {
 ## recursive function that returns the same thing as oldRegimeMatrix, but much more efficient, at least for small maxNodes
 ## actually, it appears to be more efficient even at n = maxNodes
@@ -172,32 +151,4 @@
   outmat <- rbind(outmat, rep(0,n))
   dimnames(outmat) = list(seq(dim(outmat)[1]), seq(dim(outmat)[2]))
   return(outmat)
-}
-
-as.binary <- function(n, base = 2, r = FALSE, digits = NULL)
-# Robin Hankin <initialDOTsurname at soc.soton.ac.uk (edit in obvious way; spam precaution)>
-# submitted to R listserv Thu Apr 15 12:27:39 CEST 2004
-# AH added 'digits' to make it work with regimeMatrix
-# https://stat.ethz.ch/pipermail/r-help/2004-April/049419.html
-{
-   out <- NULL
-   while(n > 0) {
-     if(r) {
-       out <- c(out , n%%base)
-     } else {
-       out <- c(n%%base , out)
-     }   
-     n <- n %/% base
-   }
-   if(!identical(digits, NULL) && !r) out <- c(rep(0, digits-length(out)), out)
-   if(!identical(digits, NULL) && r) out <- c(out, rep(0, digits-length(out)))
-   return(out)
-}
-
-as.decimal <- function(n) {
-# takes a binary vector and makes it a decimal
-  digits <- length(n)
-  result <- 0
-  for(i in digits:1) result <- result + n[i] * 2 ^ (digits - i)
-  result
 }
\ No newline at end of file

Added: pkg/misc/oldRegimeMatrix.R
===================================================================
--- pkg/misc/oldRegimeMatrix.R	                        (rev 0)
+++ pkg/misc/oldRegimeMatrix.R	2009-02-25 21:19:08 UTC (rev 183)
@@ -0,0 +1,49 @@
+oldRegimeMatrix <- function(n = NULL, nodeNames = NULL, regimeNames = NULL, maxNodes = NULL) {
+## a brute-force approach, very inefficient as n and maxNodes diverge
+## I'm leaving this in the project only b/c i don't know whether the recursive function will fail at large maxNodes
+  if(identical(n, NULL) && identical(nodeNames, NULL)) stop("You have to give regimeMatrix the number of nodes, a vector of node names, or both")
+  if(identical(nodeNames, NULL)) nodeNames <- as.character(seq(n))
+  else n <- length(nodeNames)
+  if(identical(maxNodes, NULL)) maxNodes <- n
+  outmatrix <- matrix(NA, nrow = 0, ncol = n, dimnames = list(NULL, nodeNames))
+  maxNumberOfRegimes <- ifelse(n == 1, 2, 2^n)
+  counter <- 1
+  repeat {
+    temp <- as.binary(counter, digits = n)
+    if(sum(temp) <= maxNodes) outmatrix <- rbind(outmatrix, temp) 
+    if(counter == maxNumberOfRegimes - 1) break
+    counter <- counter + 1
+    }
+  outmatrix <- rbind(outmatrix, as.binary(0, digits = n))
+  dimnames(outmatrix)[[1]] <- seq(dim(outmatrix)[1])
+  return(outmatrix)
+}
+
+
+as.binary <- function(n, base = 2, r = FALSE, digits = NULL)
+# Robin Hankin <initialDOTsurname at soc.soton.ac.uk (edit in obvious way; spam precaution)>
+# submitted to R listserv Thu Apr 15 12:27:39 CEST 2004
+# AH added 'digits' to make it work with regimeMatrix
+# https://stat.ethz.ch/pipermail/r-help/2004-April/049419.html
+{
+   out <- NULL
+   while(n > 0) {
+     if(r) {
+       out <- c(out , n%%base)
+     } else {
+       out <- c(n%%base , out)
+     }   
+     n <- n %/% base
+   }
+   if(!identical(digits, NULL) && !r) out <- c(rep(0, digits-length(out)), out)
+   if(!identical(digits, NULL) && r) out <- c(out, rep(0, digits-length(out)))
+   return(out)
+}
+
+as.decimal <- function(n) {
+# takes a binary vector and makes it a decimal
+  digits <- length(n)
+  result <- 0
+  for(i in digits:1) result <- result + n[i] * 2 ^ (digits - i)
+  result
+}
\ No newline at end of file