[Qca-commits] r20 - pkg/R

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

Author: dusadrian
Date: 2014-07-08 16:24:27 +0200 (Tue, 08 Jul 2014)
New Revision: 20

Modified:
   pkg/R/eqmcc.R
   pkg/R/getSolution.R
   pkg/R/solveChart.R
Log:
Introducing the possibility to use more than 2GB of RAM via the (undocumented) optional, numerical argument "forceRAM" in function eqmcc()
Ex. forcing using 4GB of RAM:
eqmcc(..., ..., ..., forceRAM = 4)

Modified: pkg/R/eqmcc.R
===================================================================
--- pkg/R/eqmcc.R	2014-07-03 15:48:32 UTC (rev 19)
+++ pkg/R/eqmcc.R	2014-07-08 14:24:27 UTC (rev 20)
@@ -286,7 +286,7 @@
     expressions <- minExpressions(expressions)
     
     #                 return(list(expressions=expressions, collapse=collapse, uplow=uplow, use.tilde=use.tilde, inputt=inputt, row.dom=row.dom, initial=initial, min.dis=min.dis))
-    c.sol <- p.sol <- getSolution(expressions=expressions, collapse=collapse, uplow=uplow, use.tilde=use.tilde, inputt=inputt, row.dom=row.dom, initial=initial, min.dis=min.dis)
+    c.sol <- p.sol <- getSolution(expressions=expressions, collapse=collapse, uplow=uplow, use.tilde=use.tilde, inputt=inputt, row.dom=row.dom, initial=initial, min.dis=min.dis, ...=...)
     
     mbase <- rev(c(1, cumprod(rev(noflevels + 1))))[-1]
     
@@ -335,7 +335,7 @@
         
         # return(list(expressions=expressions, collapse=collapse, uplow=uplow, use.tilde=use.tilde, inputt=inputt, row.dom=row.dom, initial=initial, min.dis=min.dis))
         
-        p.sol <- getSolution(expressions=expressions, collapse=collapse, uplow=uplow, use.tilde=use.tilde, inputt=inputt, row.dom=row.dom, initial=initial, min.dis=min.dis)
+        p.sol <- getSolution(expressions=expressions, collapse=collapse, uplow=uplow, use.tilde=use.tilde, inputt=inputt, row.dom=row.dom, initial=initial, min.dis=min.dis, ...=...)
         
     }
     
@@ -591,7 +591,7 @@
                     
                     expressions <- minExpressions(expl.matrix.i.sol)
                     
-                    i.sol.index <- getSolution(expressions=expressions, collapse=collapse, uplow=uplow, use.tilde=use.tilde, inputt=inputt, row.dom=row.dom, initial=initial, min.dis=min.dis)
+                    i.sol.index <- getSolution(expressions=expressions, collapse=collapse, uplow=uplow, use.tilde=use.tilde, inputt=inputt, row.dom=row.dom, initial=initial, min.dis=min.dis, ...=...)
                     
                     i.sol.index$expressions <- i.sol.index$expressions[rowSums(i.sol.index$mtrx) > 0, ]
                     

Modified: pkg/R/getSolution.R
===================================================================
--- pkg/R/getSolution.R	2014-07-03 15:48:32 UTC (rev 19)
+++ pkg/R/getSolution.R	2014-07-08 14:24:27 UTC (rev 20)
@@ -1,5 +1,5 @@
 `getSolution` <-
-function(expressions, collapse, uplow, use.tilde, inputt, row.dom, initial, min.dis) {
+function(expressions, collapse, uplow, use.tilde, inputt, row.dom, initial, min.dis, ...) {
         
     PI <- writePrimeimp(expressions, collapse=collapse, uplow=uplow, use.tilde=use.tilde)
     rownames(expressions) <- PI
@@ -38,7 +38,7 @@
         
     # }
     
-    sol.matrix <- solveChart(mtrx, min.dis = min.dis)
+    sol.matrix <- solveChart(mtrx, min.dis = min.dis, ...=...)
     
     sol.matrix <- matrix(rownames(mtrx)[sol.matrix], nrow=nrow(sol.matrix))
     

Modified: pkg/R/solveChart.R
===================================================================
--- pkg/R/solveChart.R	2014-07-03 15:48:32 UTC (rev 19)
+++ pkg/R/solveChart.R	2014-07-08 14:24:27 UTC (rev 20)
@@ -34,8 +34,18 @@
         k <- ceiling(sum(lp("min", rep(1, nrow(chart)), t(chart), ">=", 1)$solution))
         # cat(paste("k: ", k, "\n"))
         
+        forceRAM <- 2
+        if ("forceRAM" %in% names(other.args)) {
+            if (length(other.args$forceRAM) == 1) {
+                if (is.numeric(other.args$forceRAM) & other.args$forceRAM > 0) {
+                    forceRAM <- other.args$forceRAM
+                }
+            }
+        }
+        
+        
          # Stop if the matrix with all possible combinations of k PIs has over 2GB of memory
-        if ((mem <- nrow(chart)*choose(nrow(chart), k)*8/1024^3) > 2) {
+        if ((mem <- nrow(chart)*choose(nrow(chart), k)*8/1024^3) > forceRAM) {
             errmessage <- paste(paste("Too much memory needed (", round(mem, 1), " GB) to solve the PI chart using combinations of", sep=""),
                                    k, "out of", nrow(chart), "minimised PIs, with the PI chart having", ncol(chart), "columns.\n\n")
             cat("\n")