[Qca-commits] r21 - pkg/R

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

Author: dusadrian
Date: 2014-07-23 18:07:09 +0200 (Wed, 23 Jul 2014)
New Revision: 21

Modified:
   pkg/R/eqmcc.R
Log:
Added a match call item for objects of class qca (request by Juraj Medzihorsky)

Modified: pkg/R/eqmcc.R
===================================================================
--- pkg/R/eqmcc.R	2014-07-08 14:24:27 UTC (rev 20)
+++ pkg/R/eqmcc.R	2014-07-23 16:07:09 UTC (rev 21)
@@ -7,6 +7,8 @@
     
     m2 <- FALSE
     
+    metacall <- match.call()
+    
     other.args <- list(...)
     
     if ("rowdom" %in% names(other.args)) {
@@ -285,7 +287,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))
+    #                 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]
@@ -297,43 +299,46 @@
             ttdata <- as.data.frame(cbind(ttdata, OUT = c(rep(1, nrow(expl.matrix)), rep(0, nrow(excl.matrix)))))
             colnames(ttdata)[ncol(ttdata)] <- outcome
             rownames(ttdata) <- seq(nrow(ttdata))
-            valents <- lapply(ttdata[, conditions], function(x) sort(unique(x)))
-            realnoflevels <- unlist(lapply(valents, length))
+            values <- lapply(ttdata[, conditions], function(x) sort(unique(x)))
+            realnoflevels <- unlist(lapply(values, length))
             
             gb <- vector(mode="list", length=nofconditions)
             names(gb) <- conditions
             for (i in seq(nofconditions)) {
                 gb[[i]] <- vector(mode="list", length=realnoflevels[i])
-                names(gb[[i]]) <- valents[[i]]
-                for (j in seq(length(valents[[i]]))) {
+                names(gb[[i]]) <- values[[i]]
+                for (j in seq(length(values[[i]]))) {
                     gb[[i]][[j]] <- vector(mode="list", length=2)
-                    gb[[i]][[j]][[1]] <- which(ttdata[, i] == valents[[i]][j] & ttdata[, outcome] == 1)
-                    gb[[i]][[j]][[2]] <- which(ttdata[, i] == valents[[i]][j] & ttdata[, outcome] == 0)
+                    gb[[i]][[j]][[1]] <- which(ttdata[, i] == values[[i]][j] & ttdata[, outcome] == 1)
+                    gb[[i]][[j]][[2]] <- which(ttdata[, i] == values[[i]][j] & ttdata[, outcome] == 0)
                 }
             }
             
-            valents <- lapply(valents, function(x) x + 1) # +1 to raise the valents in the implicant matrix
-            realnoflevels <- realnoflevels + 1            # +1 same reason
+            values <- lapply(values, "+", 1)     # +1 to raise the values in the implicant matrix
+            realnoflevels <- realnoflevels + 1   # +1 same reason
             
             t1g <- seq(nrow(expl.matrix))
             t1b <- seq(nrow(excl.matrix)) + nrow(expl.matrix)
             
             mvector <- c(rev(cumprod(rev(realnoflevels))), 1)[-1]
             
-            expressions <- .Call("m2", gb, valents, mvector, mbase, t1g, t1b, realnoflevels)
+            expressions <- .Call("m2", gb, values, mvector, mbase, t1g, t1b, realnoflevels)
             expressions <- .Call("removeRedundants", expressions, noflevels, mbase, PACKAGE="QCA")
             
         }
         else {
+            print(expressions)
             expressions <- sort(setdiff(findSupersets(noflevels + 1, expl.matrix), findSupersets(noflevels + 1, excl.matrix)))
+            print(expressions)
             expressions <- .Call("removeRedundants", expressions, noflevels, mbase, PACKAGE="QCA")
+            print(expressions)
         }
         
         expressions <- getRow(noflevels + 1, expressions)
         
         colnames(expressions) <- colnames(inputt)
         
-        # return(list(expressions=expressions, collapse=collapse, uplow=uplow, use.tilde=use.tilde, inputt=inputt, row.dom=row.dom, initial=initial, 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, ...=...))
         
         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, ...=...)
         
@@ -674,6 +679,7 @@
     }
     
     output$relation <- relation
+    output at call <- metacall
     
     return(structure(output, class="qca"))
 }