Удаление инвертированных (обратных / дублирующих) правил из Apriori приводит к R
Я реализовал алгоритм Apriori в моем наборе данных. Правила, которые я получаю, являются перевернутыми повторениями:
inspect(head(rules))
lhs rhs support confidence lift count
[1] {252-ON-OFF} => {L30-ATLANTIC} 0.04545455 1 22 1
[2] {L30-ATLANTIC} => {252-ON-OFF} 0.04545455 1 22 1
[3] {252-ON-OFF} => {M01-A molle biconiche} 0.04545455 1 22 1
[4] {M01-A molle biconiche} => {252-ON-OFF} 0.04545455 1 22 1
[5] {L30-ATLANTIC} => {M01-A molle biconiche} 0.04545455 1 22 1
[6] {M01-A molle biconiche} => {L30-ATLANTIC} 0.04545455 1 22 1
Как видно, правило 1 и правило 2 одинаковы, только LHS и RHS взаимозаменяемы. Есть ли способ удалить такие правила из конечного результата?
Я видел этот пост ссылку, но предлагаемое решение не является правильным. Я также видел эту ссылку, и я попробовал это 2 решения:
Решение А:
rules <- rules[!is.redundant(rules)]
но результат всегда один и тот же:
inspect(head(rules))
lhs rhs support confidence lift count
[1] {252-ON-OFF} => {L30-ATLANTIC} 0.04545455 1 22 1
[2] {L30-ATLANTIC} => {252-ON-OFF} 0.04545455 1 22 1
[3] {252-ON-OFF} => {M01-A molle biconiche} 0.04545455 1 22 1
[4] {M01-A molle biconiche} => {252-ON-OFF} 0.04545455 1 22 1
[5] {L30-ATLANTIC} => {M01-A molle biconiche} 0.04545455 1 22 1
[6] {M01-A molle biconiche} => {L30-ATLANTIC} 0.04545455 1 22 1
Решение Б:
# find redundant rules
subset.matrix <- is.subset(rules, rules)
subset.matrix[lower.tri(subset.matrix, diag=T)]
redundant <- colSums(subset.matrix, na.rm=T) > 1
which(redundant)
rules.pruned <- rules[!redundant]
inspect(rules.pruned)
lhs rhs support confidence lift count
[1] {} => {BRC-BRC} 0.04545455 0.04545455 1 1
[2] {} => {111-WINK} 0.04545455 0.04545455 1 1
[3] {} => {305-INGRAM HIGH} 0.04545455 0.04545455 1 1
[4] {} => {952-REVERS} 0.04545455 0.04545455 1 1
[5] {} => {002-LC2} 0.09090909 0.09090909 1 2
[6] {} => {252-ON-OFF} 0.04545455 0.04545455 1 1
[7] {} => {L30-ATLANTIC} 0.04545455 0.04545455 1 1
[8] {} => {M01-A molle biconiche} 0.04545455 0.04545455 1 1
[9] {} => {678-Portovenere} 0.04545455 0.04545455 1 1
[10] {} => {251-MET T.} 0.04545455 0.04545455 1 1
[11] {} => {324-D.S.3} 0.04545455 0.04545455 1 1
[12] {} => {L04-YUME} 0.04545455 0.04545455 1 1
[13] {} => {969-Lubekka} 0.04545455 0.04545455 1 1
[14] {} => {000-FUORI LISTINO} 0.04545455 0.04545455 1 1
[15] {} => {007-LC7} 0.04545455 0.04545455 1 1
[16] {} => {341-COS} 0.04545455 0.04545455 1 1
[17] {} => {601-ROBIE 1} 0.04545455 0.04545455 1 1
[18] {} => {608-TALIESIN 2} 0.04545455 0.04545455 1 1
[19] {} => {610-ROBIE 2} 0.04545455 0.04545455 1 1
[20] {} => {615-HUSSER} 0.04545455 0.04545455 1 1
[21] {} => {831-DAKOTA} 0.04545455 0.04545455 1 1
[22] {} => {997-997} 0.27272727 0.27272727 1 6
[23] {} => {412-CAB} 0.09090909 0.09090909 1 2
[24] {} => {S01-A doghe senza movimenti} 0.09090909 0.09090909 1 2
[25] {} => {708-Genoa} 0.09090909 0.09090909 1 2
[26] {} => {998-998} 0.54545455 0.54545455 1 12
У кого-нибудь была такая же проблема и знает, как ее решить? Спасибо за вашу помощь
2 ответа
Проблема в вашем наборе данных, а не в алгоритме. В результате вы видите, что число многих правил равно 1 (комбинация элементов встречается один раз в транзакциях), а доверие равно 1 для правила и его "обратного". Это означает, что вам нужно больше данных и увеличить минимальную поддержку.
Если вы все еще хотите эффективно избавиться от таких "дублирующих" правил, то вы можете сделать следующее:
> library(arules)
> data(Groceries)
> rules <- apriori(Groceries, parameter = list(support = 0.001))
> rules
set of 410 rules
> gi <- generatingItemsets(rules)
> d <- which(duplicated(gi))
> rules[-d]
set of 385 rules
Код содержит только первое правило каждого набора правил с одинаковыми элементами.
Вы можете сделать это с помощью грубой силы, преобразовав ваш объект правил в data.frame и итеративно сравнив векторы транзакций LHS/RHS. Вот пример использования набора данных grocery.csv:
inspect(head(groceryrules))
# convert rules object to data.frame
trans_frame <- data.frame(lhs = labels(lhs(groceryrules)), rhs = labels(rhs(groceryrules)), groceryrules@quality)
# loop through each row of trans_frame
rem_indx <- NULL
for(i in 1:nrow(trans_frame)) {
trans_vec_a <- c(as.character(trans_frame[i,1]), as.character(trans_frame[i,2]))
# for each row evaluated, compare to every other row in trans_frame
for(k in 1:nrow(trans_frame[-i,])) {
trans_vec_b <- c(as.character(trans_frame[-i,][k,1]), as.character(trans_frame[-i,][k,2]))
if(setequal(trans_vec_a, trans_vec_b)) {
# store the index to remove
rem_indx[i] <- i
}
}
}
Это дает вам вектор индексов, которые должны быть удалены (потому что они дублируются / инвертированы)
duped_trans <- trans_frame[rem_indx[!is.na(rem_indx)], ]
duped_trans
Мы можем видеть, что он идентифицировал 2 транзакции, которые были дубликатами / инвертированными.
Теперь мы можем хранить не повторяющиеся транзакции:
deduped_trans <- trans_frame[-rem_indx[!is.na(rem_indx)], ]
Вопрос, конечно, в том, что приведенный выше алгоритм крайне неэффективен. В наборе продуктовых данных всего 463 транзакции. Для любого разумного количества транзакций вам нужно будет векторизовать функцию.