Nothing
#' Conversion of \code{data.frame} to \code{rules} from \code{arules}
#'
#' @param model \code{data.frame} with rules
#' @return \code{arules} \code{rules} representation
#' @export
#' @examples
#' library("rCBA")
#'
#' model <- data.frame("rules" = c("{X=1} => {Y=1}","{X=0} => {Y=0}"),
#' "support" = c(0.5,0.5),
#' "confidence" = c(0.5,0.5),
#' "lift" = c(1.0,1.0))
#'
#' rules <- rCBA::frameToRules(model)
#' inspect(rules)
#'
#' @include init.R
frameToRules <- function(model){
# export quality measures
quality<-model[,2:4]
# parse text
rowItems <- lapply(model$rules,function(x) {
x <- as.character(x)
pattern <- "[[:space:]]*\\{(.*)\\}[[:space:]]*=>[[:space:]]*\\{(.*)\\}[[:space:]]*"
m <- regexec(pattern, x)
strRule <- regmatches(x, m)
ant <- strsplit(strRule[[1]][2],",")[[1]]
cons <- strsplit(strRule[[1]][3],",")[[1]]
list(ant=ant,cons=cons)
})
# unique lhs and rhs items
antItems <- unique(unlist(sapply(rowItems, function(x) x$ant)))
consItems <- unique(unlist(sapply(rowItems, function(x) x$cons)))
# all items
items <- c(antItems, consItems)
# prepare matrices for antecedents(lhs) and consequents(rhs)
antM <- matrix(0, ncol=length(items), nrow = nrow(model))
dimnames(antM) <- list(NULL, items)
consM <- matrix(0, ncol=length(items), nrow = nrow(model))
dimnames(consM) <- list(NULL, items)
# set presence of items in lhs and rhs
sapply(seq_len(nrow(model)), function(x){
row <- unname(rowItems[x])[[1]]
antM[x,match(row$ant,items)] <<- 1
consM[x,match(row$cons,items)] <<- 1
NULL
})
# convert to item matrix
antI <- as(antM, "itemMatrix")
consI <- as(consM, "itemMatrix")
# create rules
rules <- new("rules", lhs=antI, rhs=consI, quality = quality)
rules
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.