Improved APappearance code.

NEWS.md

@@ -2,6 +2,8 @@
 
 ## New Features
 * Improved speed for read.transactions with format = "single" significantly.
+* Appearance for apriori now guesses the default parameter automatically and 
+  does some more checking, making the specification of templates easier.
 
 ## Bug Fixes
 * Fixed null pointer in error message code.

R/appearance.R

@@ -41,8 +41,31 @@ setAs("list", "APappearance",
         stop(paste(names(from)[!names(from) %in% c(args, other)], 
                 "is an unknown appearance indicator, use:", 
                 paste(args, collapse=" "), collapse=", "))
-        if (is.null(from$default)) from$default = "both"
-
+
+        ## cannot set items and lhs, rhs or both
+        if(!is.null(from$items) && 
+            (!is.null(from$lhs) || !is.null(from$rhs) || !is.null(from$both))) {
+          stop("Cannot set appearance for mining association rules (lhs, rhs, both) and frequent itemset mining (items) at the same time!")
+        }
+
+        ## guess default
+        if (is.null(from$default)) {
+          if(is.null(from$lhs) 
+            && is.null(from$rhs)) from$default = "both"
+          if(!is.null(from$lhs) 
+            && is.null(from$rhs)) from$default = "rhs"
+          if(is.null(from$lhs) 
+            && !is.null(from$rhs)) from$default = "lhs"
+
+          if(!is.null(from$rhs)
+            && !is.null(from$lhs)) from$default = "none"
+
+          if(!is.null(from$both)) from$default = "none"
+
+          ## for itemsets
+          if(!is.null(from$items)) from$default = "none"
+        }
+
         set <- c()
         items <- c()
         for (i in 1:length(args)) {
@@ -57,6 +80,11 @@ setAs("list", "APappearance",
             set <- c(set, length(add_items))
         }
 
+        ## check for items in multiple positions (crashes C code!)
+        if(any(dup <- duplicated(items))) 
+          stop("The following items cannot be specified in multiple appearance locations: ",
+          paste(from$labels[items[dup]+1L], collapse = ", "))
+
         ## check NA's
         return(new("APappearance", default = from$default, 
                 items = as.integer(items),

R/apriori.R

@@ -46,7 +46,7 @@ apriori <-  function(data, parameter = NULL, appearance = NULL, control = NULL)
       cat("\nAlgorithmic control:\n")
       print(control)
     }
-    
+
     ## sanity check for support (abs. support >1)
     abs_supp <- as.integer(parameter@support * length(data))
     if(control@verbose) {

man/APappearance-class.Rd

@@ -28,12 +28,17 @@
       character vectors giving the labels of the items
 	    which can appear in the specified place
         (rhs, lhs or both for rules and items for itemsets).
-      The special place none specifies, that the items mentioned there cannot
-      appear in the rule/itemset.}
-    \item{\code{default}:}{one of \code{"both"}, \code{"lhs"},
-      \code{"rhs"}, \code{"none"} (the default is \code{"both"}). 
+      none specifies, that the items mentioned there cannot
+      appear anywhere in the rule/itemset. Note that items cannot be specified
+in more than one place (i.e., you cannot specify an item in lhs and rhs, but have 
+to specify it as both).}
+    \item{\code{default}:}{
+      one of \code{"both"}, \code{"lhs"},
+      \code{"rhs"}, \code{"none"}. 
       Specified the default appearance for all items not 
-      explicitly mentioned in the other elements of the list.}
+      explicitly mentioned in the other elements of the list.
+      Leave unspecified and the code will guess the correct setting.
+      }
   }
 
   Objects can also be created by calls of the form 
@@ -70,28 +75,26 @@
 \examples{
 data("Adult")
 
-## find only frequent itemsets which do not contain  small or large income
+## find only frequent itemsets which do not contain small or large income
 is <- apriori(Adult, parameter = list(support= 0.1, target="frequent"), 
-  appearance = list(none = c("income=small", "income=large"),
-  default="both"))
+  appearance = list(none = c("income=small", "income=large")))
 itemFrequency(items(is))["income=small"]
 itemFrequency(items(is))["income=large"]
 
-## find itemsets that only contain small or large income and young age
+## find itemsets that only contain small or large income, or young age
 is <- apriori(Adult, parameter = list(support= 0.1, target="frequent"), 
-  appearance = list(items = c("income=small", "income=large", "age=Young"),
-  default="none"))
+  appearance = list(items = c("income=small", "income=large", "age=Young")))
 inspect(head(is))
   
 ## find only rules with income-related variables in the right-hand-side.
 incomeItems <- grep("^income=", itemLabels(Adult), value = TRUE)
 incomeItems
 rules <- apriori(Adult, parameter = list(support=0.2, confidence = 0.5), 
-  appearance = list(rhs = incomeItems, default="lhs"))
+  appearance = list(rhs = incomeItems))
 inspect(head(rules))
 
-## for more complicated restrictions you have to mine all rules/itemsets and
-## then filter the results afterwards
+## Note: For more complicated restrictions you have to mine all rules/itemsets and
+## then filter the results afterwards.
 }
 \seealso{
   \code{\link{apriori}}

tests/testthat/test-apriori.R

@@ -33,12 +33,25 @@ expect_identical(length(r), 18L)
 
 ### test appearance
 r <- apriori(trans, parameter=list(supp=0.25, conf=0),
-  appearance=list(rhs=c("a","b"), default= "lhs"), 
-  control=list(verb=FALSE))
+  appearance=list(rhs=c("a","b")), control=list(verb=FALSE))
 
 expect_identical(length(r), 6L)
 #inspect(r)
 
+r <- apriori(trans, parameter=list(supp=0.25, conf=0),
+  appearance=list(lhs= c("a", "b"), rhs="c"), 
+  control=list(verb=FALSE))
+expect_identical(length(r), 2L)
+
+r <- apriori(trans, parameter=list(supp=0.25, conf=0),
+  appearance=list(none= c("a", "b")), 
+  control=list(verb=FALSE))
+expect_identical(length(r), 3L)
+
+expect_error(as(list(rhs=c("a","b"), lhs = "a", 
+  labels=itemLabels(trans)), "APappearance"))
+
+
 ### test lhs.support
 r <- apriori(trans, parameter=list(supp=0.25, conf=0, 
   originalSupp=FALSE, ext=TRUE),