[Qca-commits] r18 - pkg/R

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

Author: dusadrian
Date: 2014-07-03 14:50:17 +0200 (Thu, 03 Jul 2014)
New Revision: 18

Modified:
   pkg/R/base3rows.R
   pkg/R/calibrate.R
   pkg/R/eqmcc.R
   pkg/R/solveChart.R
Log:
Minor cosmetic changes

Modified: pkg/R/base3rows.R
===================================================================
--- pkg/R/base3rows.R	2014-06-26 13:56:32 UTC (rev 17)
+++ pkg/R/base3rows.R	2014-07-03 12:50:17 UTC (rev 18)
@@ -4,12 +4,12 @@
     for (i in 2:nofconditions) {
         multiplier <- 3*multiplier + 1
         gap <- c(gap, multiplier, gap)
-        }
+    }
     
     linejump <- (3^nofconditions + 1)/2
     rownums <- c(linejump, sapply(gap, function(jump) {
         linejump <<- linejump + jump + 2
         }))
     return(sort(c(rownums, rownums + 1)))
-    }
+}
 

Modified: pkg/R/calibrate.R
===================================================================
--- pkg/R/calibrate.R	2014-06-26 13:56:32 UTC (rev 17)
+++ pkg/R/calibrate.R	2014-07-03 12:50:17 UTC (rev 18)
@@ -4,15 +4,18 @@
     if (!is.numeric(x)) {
         cat("\n")
         stop("x is not numeric.\n\n", call. = FALSE)
-    }    
+    }
+    
     if (!(type %in% c("crisp", "fuzzy"))) {
         cat("\n")
         stop("Unknown calibration type.\n\n", call. = FALSE)
     }
+    
     if (all(is.na(thresholds))) {
         cat("\n")
         stop("Threshold value(s) not specified.\n\n", call. = FALSE)
     }
+    
     if (type == "crisp") {
         xrange <- range(x, na.rm=TRUE)
         if (any(as.numeric(unclass(cut(thresholds, breaks=c(-Inf, xrange, Inf)))) != 2)) {
@@ -28,14 +31,17 @@
             check.vector[is.na(check.vector)] <- FALSE
             return(check.vector)
         }
+        
         if (!(length(thresholds) %in% c(3, 6))) {
             cat("\n")
             stop("For fuzzy data, thresholds should be of type:\n\"c(thEX, thCR, thIN)\"\nor\n\"c(thEX1, thCR1, thIN1, thIN2, thCR2, thEX2)\".\n\n", call. = FALSE)
         }
+        
         if (idm <= 0.5 | idm >= 1) {
             cat("\n")
             stop("The inclusion degree of membership has to be bigger than 0.5 and less than 1.\n\n", call. = FALSE)
         }
+        
          # needed because sometimes thresholds values inherit names, e.g. from being calculated with quantile() 
         thresholds <- as.vector(thresholds)
         
@@ -64,7 +70,9 @@
                     cat("\n")
                     warning("Some thresholds equal, that should not be equal.\n\n", call. = FALSE)
                 }
+                
                 increasing <- TRUE
+                
                 if (thIN < thCR & thCR < thEX) {
                     increasing <- FALSE
                 }      
@@ -133,18 +141,22 @@
                 cat("\n")
                 stop("First crossover threshold not between first exclusion and inclusion thresholds.\n\n", call. = FALSE)
             }
+            
             if (thCR2 < min(thEX2, thIN2) | thCR2 > max(thEX2, thIN2)) {
                 cat("\n")
                 stop("Second crossover threshold not between second exclusion and inclusion thresholds.\n\n", call. = FALSE)
             }
+            
             if (any(table(c(thEX1, thCR1, thIN1)) > 1) | any(table(c(thIN2, thCR2, thEX2)) > 1) | thCR1 == thCR2) {
                 cat("\n")
                 stop("Some thresholds equal, that should not be equal.\n\n", call. = FALSE)
-            }    
+            }  
+            
             increasing <- TRUE
             if (thIN1 < thCR1 & thCR1 < thEX1 & thEX1 <= thEX2 & thEX2 < thCR2 & thCR2 < thIN2) {
                 increasing <- FALSE
             }
+            
             if (increasing) {
                 if (thEX1 == thEX2) {
                     cat("\n")

Modified: pkg/R/eqmcc.R
===================================================================
--- pkg/R/eqmcc.R	2014-06-26 13:56:32 UTC (rev 17)
+++ pkg/R/eqmcc.R	2014-07-03 12:50:17 UTC (rev 18)
@@ -285,7 +285,7 @@
     
     expressions <- minExpressions(expressions)
     
-    # return(list(expressions=expressions, collapse=collapse, uplow=uplow, use.tilde=use.tilde, inputt=inputt, row.dom=row.dom, min.dis=min.dis))
+    #                 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)
     
     mbase <- rev(c(1, cumprod(rev(noflevels + 1))))[-1]
@@ -442,7 +442,7 @@
     
     
     prettyNums <- formatC(seq(length(p.sol$solution.list[[1]])), digits = nchar(length(p.sol$solution.list[[1]])) - 1, flag = 0)
-    names(output$SA) <- paste("S", prettyNums, sep="")
+    names(output$SA) <- paste("M", prettyNums, sep="")
     
     if (!is.null(dir.exp) & all(include != c(""))) {
         

Modified: pkg/R/solveChart.R
===================================================================
--- pkg/R/solveChart.R	2014-06-26 13:56:32 UTC (rev 17)
+++ pkg/R/solveChart.R	2014-07-03 12:50:17 UTC (rev 18)
@@ -37,8 +37,8 @@
          # 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) {
             cat("\n")
-            stop(paste(paste("Error: Too much memory needed (", round(mem, 1), " GB) to solve the PI chart using combinations of", sep=""),
-                             k, "PIs out of", nrow(chart), "minimised PIs.\n\n"), call. = FALSE)
+            stop(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.\n\n"), call. = FALSE)
         }
         
         if (!min.dis & k < nrow(chart)) {