R/mergeRules2trans.R

In brooksandrew/Rsenal: Rsenal (arsenal) of assorted R functions developed over the years

#' @title Link transactions/observations to association rules
#' 
#' @description Creates a matrix of transactions/observations (rows) by association rules (columns).
#' 1 in the matrix indicates that the observation/transaction is eligible for and follows a given rule (LHS & RHS of rule are in the obs/transaction).
#' -1 in the matrix indicates that obs/transaction is eligible for, but does violates the rule (LHS of rule, but not RHS of rule are in obs/transaction).
#' 0 in the matrix indicates that the rule does not apply (LHS of rule not in obs/tranaction).
#'
#' @param trans list of transactions
#' @param rhs list of RHS of association rules
#' @param lhs list of LHS of association rules
#' @return matrix tying obs/transactions to association rules
#' @import BBmisc
#' @export
#' @examples
#' library('arules')
#' library('BBmisc')
#' data(Adult)
#' rules <- apriori(Adult, parameter=list(support=0.5, confidence=0.95))
#' rdf <- rules2df(rules, list=T)

#' trdf <- as(Adult, 'data.frame')
#' trdf$items <- gsub('\\{', '', trdf$items)
#' trdf$items <- gsub('\\}', '', trdf$items)
#' trdf$items2 <- strsplit(as.character(trdf$items), split=',')

#' M <- mergeRules2trans(trans=trdf$items2[1:1000], rhs=rdf$rhs, lhs=rdf$lhs)

mergeRules2trans <- function(trans, rhs, lhs){
  M <- data.frame(matrix(0, nrow=length(trans), ncol=length(lhs)))
  for(i in 1:ncol(M)) M[sapply(trans, function(x) isSubset(c(lhs[[i]], rhs[[i]]), x)), i] <- 1
  for(i in 1:ncol(M)) M[sapply(trans, function(x) isSubset(lhs[[i]], x) & isSubset(rhs[[i]], x)==F), i] <- -1
  return(M)
}