Приведем пример практического решения задачи поиска ассоциаливных правил применительно к данным сайта LastFM, сервиса прослушивания музыки, создающего подробный профиль музыкального вкуса пользователей. Это может быть реализовано через алгоритмы поиска ассоциативных правил - сайт рекомендует пользователям познакомиться с новыми исполнителями на основании уже прослушанных ими композиций. Попробуем разобраться, как это работает.

Исходные данные для анализа были представлены в виде файла lastfm.scv, содержащего следующую информацию о прослушиваниях на сайте: номер пользователя, исполнитель, пол пользователя и его страну. Откроем этот файл в RStudio:

setwd('C:/Users/^_^/Desktop/R')
lastfm <- read.csv("lastfm.csv")
lastfm$user <- factor(lastfm$user)

Описать исходные данные позволяют команды summary() и str() в R:

str(lastfm)
## 'data.frame':    289955 obs. of  4 variables:
##  $ user   : Factor w/ 15000 levels "1","3","4","5",..: 1 1 1 1 1 1 1 1 1 1 ...
##  $ artist : Factor w/ 1004 levels "...and you will know us by the trail of dead",..: 714 849 373 281 512 750 289 429 299 894 ...
##  $ sex    : Factor w/ 2 levels "f","m": 1 1 1 1 1 1 1 1 1 1 ...
##  $ country: Factor w/ 159 levels "Afghanistan",..: 58 58 58 58 58 58 58 58 58 58 ...
summary(lastfm)
##       user                          artist       sex       
##  17681  :    76   radiohead            :  2704   f: 78132  
##  15057  :    63   the beatles          :  2668   m:211823  
##  1208   :    55   coldplay             :  2378             
##  19558  :    55   red hot chili peppers:  1786             
##  13424  :    54   muse                 :  1711             
##  3288   :    52   metallica            :  1670             
##  (Other):289600   (Other)              :277038             
##            country      
##  United States : 59558  
##  United Kingdom: 27638  
##  Germany       : 24251  
##  Poland        : 17111  
##  Sweden        : 12379  
##  Brazil        : 11922  
##  (Other)       :137096

Таким образом, мы видим, что:

Тип каждой переменной представлен в таблице:

Код переменной Описание переменной Тип переменной
User Номер пользователя LastFM Количественная
Artist Имя/название исполнителя Качественная
Sex Пол пользователя Качественная
Country Страна пользователя Качественная

Воспользуемся библиотекой a-rules, предназначенной для построения ассоциативных правил:

library(arules)
## Warning: package 'arules' was built under R version 3.2.5
## Loading required package: Matrix
## 
## Attaching package: 'arules'
## The following objects are masked from 'package:base':
## 
##     abbreviate, write

Существует целая экосистема пакетов вокруг библиотеки a-rules. Сначала необходимо создать список так называемых потребительских корзин: векторы товаров различных покупателей (в терминологии анализа потребительской корзины). Форматирование производится следующим образом. Разобьем данные на списки исполнителей для каждого пользователя:

playlists <- split(x=lastfm$artist, f=lastfm$user)

затем удалим повторяющихся исполнителей из этих списков:

playlists <- lapply(playlists, unique)

Скажем R, чтобы он воспринимал переменную “playtrans” как особый класс, называющийся “transactions” - транзакции:

playtrans <- as(playlists, "transactions")

Теперь применим алгоритм поиска ассоциативных правил “Apriori”. Можно добавить аргументы, называемые “parameter”. Сейчас мы рассматриваем только правила с поддержкой > .01, достоверностью >.5 и длиной (количеством иполнителей) <= 3:

musicrules <- apriori(playtrans, 
                      parameter=list(support=.01, confidence=.5, maxlen=3))
## Apriori
## 
## Parameter specification:
##  confidence minval smax arem  aval originalSupport support minlen maxlen
##         0.5    0.1    1 none FALSE            TRUE    0.01      1      3
##  target   ext
##   rules FALSE
## 
## Algorithmic control:
##  filter tree heap memopt load sort verbose
##     0.1 TRUE TRUE  FALSE TRUE    2    TRUE
## 
## Absolute minimum support count: 150 
## 
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[1004 item(s), 15000 transaction(s)] done [0.07s].
## sorting and recoding items ... [655 item(s)] done [0.02s].
## creating transaction tree ... done [0.02s].
## checking subsets of size 1 2 3 done [0.06s].
## writing ... [50 rule(s)] done [0.00s].
## creating S4 object  ... done [0.01s].

Посмотрим на результат:

inspect(musicrules)
##    lhs                                    rhs            support   
## 1  {t.i.}                              => {kanye west}   0.01040000
## 2  {the pussycat dolls}                => {rihanna}      0.01040000
## 3  {the fray}                          => {coldplay}     0.01126667
## 4  {sonata arctica}                    => {nightwish}    0.01346667
## 5  {judas priest}                      => {iron maiden}  0.01353333
## 6  {the kinks}                         => {the beatles}  0.01360000
## 7  {travis}                            => {coldplay}     0.01373333
## 8  {the flaming lips}                  => {radiohead}    0.01306667
## 9  {megadeth}                          => {metallica}    0.01626667
## 10 {simon & garfunkel}                 => {the beatles}  0.01540000
## 11 {broken social scene}               => {radiohead}    0.01506667
## 12 {blur}                              => {radiohead}    0.01753333
## 13 {keane}                             => {coldplay}     0.02226667
## 14 {snow patrol}                       => {coldplay}     0.02646667
## 15 {beck}                              => {radiohead}    0.02926667
## 16 {snow patrol,the killers}           => {coldplay}     0.01040000
## 17 {radiohead,snow patrol}             => {coldplay}     0.01006667
## 18 {death cab for cutie,the shins}     => {radiohead}    0.01006667
## 19 {the beatles,the shins}             => {radiohead}    0.01066667
## 20 {led zeppelin,the doors}            => {pink floyd}   0.01066667
## 21 {pink floyd,the doors}              => {led zeppelin} 0.01066667
## 22 {pink floyd,the doors}              => {the beatles}  0.01000000
## 23 {the beatles,the strokes}           => {radiohead}    0.01046667
## 24 {oasis,the killers}                 => {coldplay}     0.01113333
## 25 {oasis,the beatles}                 => {coldplay}     0.01060000
## 26 {oasis,radiohead}                   => {coldplay}     0.01273333
## 27 {beck,the beatles}                  => {radiohead}    0.01300000
## 28 {bob dylan,the rolling stones}      => {the beatles}  0.01146667
## 29 {david bowie,the rolling stones}    => {the beatles}  0.01000000
## 30 {led zeppelin,the rolling stones}   => {the beatles}  0.01066667
## 31 {radiohead,the rolling stones}      => {the beatles}  0.01060000
## 32 {coldplay,the smashing pumpkins}    => {radiohead}    0.01093333
## 33 {the beatles,the smashing pumpkins} => {radiohead}    0.01146667
## 34 {radiohead,u2}                      => {coldplay}     0.01140000
## 35 {coldplay,sigur rГіs}               => {radiohead}    0.01206667
## 36 {sigur rГіs,the beatles}            => {radiohead}    0.01046667
## 37 {bob dylan,pink floyd}              => {the beatles}  0.01033333
## 38 {bob dylan,radiohead}               => {the beatles}  0.01386667
## 39 {bloc party,the killers}            => {coldplay}     0.01106667
## 40 {david bowie,pink floyd}            => {the beatles}  0.01006667
## 41 {david bowie,radiohead}             => {the beatles}  0.01393333
## 42 {placebo,radiohead}                 => {muse}         0.01366667
## 43 {led zeppelin,radiohead}            => {the beatles}  0.01306667
## 44 {death cab for cutie,the killers}   => {coldplay}     0.01086667
## 45 {death cab for cutie,the beatles}   => {radiohead}    0.01246667
## 46 {muse,the killers}                  => {coldplay}     0.01513333
## 47 {red hot chili peppers,the killers} => {coldplay}     0.01086667
## 48 {the beatles,the killers}           => {coldplay}     0.01253333
## 49 {radiohead,the killers}             => {coldplay}     0.01506667
## 50 {muse,the beatles}                  => {radiohead}    0.01380000
##    confidence lift     
## 1  0.5672727   8.854413
## 2  0.5777778  13.415893
## 3  0.5168196   3.260006
## 4  0.5101010   8.236292
## 5  0.5075000   8.562992
## 6  0.5298701   2.979030
## 7  0.5628415   3.550304
## 8  0.5297297   2.938589
## 9  0.5281385   4.743759
## 10 0.5238095   2.944956
## 11 0.5472155   3.035589
## 12 0.5228628   2.900496
## 13 0.6374046   4.020634
## 14 0.5251323   3.312441
## 15 0.5092807   2.825152
## 16 0.5954198   3.755802
## 17 0.6344538   4.002021
## 18 0.5033333   2.792160
## 19 0.5673759   3.147425
## 20 0.5970149   5.689469
## 21 0.5387205   6.802027
## 22 0.5050505   2.839489
## 23 0.5607143   3.110471
## 24 0.6626984   4.180183
## 25 0.5196078   3.277594
## 26 0.5876923   3.707058
## 27 0.5909091   3.277972
## 28 0.5910653   3.323081
## 29 0.5703422   3.206572
## 30 0.5776173   3.247474
## 31 0.5638298   3.169958
## 32 0.6283525   3.485683
## 33 0.6209386   3.444556
## 34 0.5213415   3.288529
## 35 0.5801282   3.218167
## 36 0.6434426   3.569393
## 37 0.6150794   3.458092
## 38 0.5730028   3.221530
## 39 0.5236593   3.303150
## 40 0.5741445   3.227949
## 41 0.5225000   2.937594
## 42 0.5137845   4.504247
## 43 0.5283019   2.970213
## 44 0.5884477   3.711823
## 45 0.5013405   2.781105
## 46 0.5089686   3.210483
## 47 0.5093750   3.213047
## 48 0.5340909   3.368950
## 49 0.5243619   3.307582
## 50 0.5073529   2.814458

на самом деле, можно выбрать подмножество с любыми параметрами поддержки, достоверности и лифта. Вот некоторые примеры:

inspect(subset(musicrules, subset=lift > 5))
##    lhs                         rhs            support    confidence
## 1  {t.i.}                   => {kanye west}   0.01040000 0.5672727 
## 2  {the pussycat dolls}     => {rihanna}      0.01040000 0.5777778 
## 4  {sonata arctica}         => {nightwish}    0.01346667 0.5101010 
## 5  {judas priest}           => {iron maiden}  0.01353333 0.5075000 
## 20 {led zeppelin,the doors} => {pink floyd}   0.01066667 0.5970149 
## 21 {pink floyd,the doors}   => {led zeppelin} 0.01066667 0.5387205 
##    lift     
## 1   8.854413
## 2  13.415893
## 4   8.236292
## 5   8.562992
## 20  5.689469
## 21  6.802027
inspect(subset(musicrules, subset=confidence > 0.6))
##    lhs                                    rhs           support   
## 13 {keane}                             => {coldplay}    0.02226667
## 17 {radiohead,snow patrol}             => {coldplay}    0.01006667
## 24 {oasis,the killers}                 => {coldplay}    0.01113333
## 32 {coldplay,the smashing pumpkins}    => {radiohead}   0.01093333
## 33 {the beatles,the smashing pumpkins} => {radiohead}   0.01146667
## 36 {sigur rГіs,the beatles}            => {radiohead}   0.01046667
## 37 {bob dylan,pink floyd}              => {the beatles} 0.01033333
##    confidence lift    
## 13 0.6374046  4.020634
## 17 0.6344538  4.002021
## 24 0.6626984  4.180183
## 32 0.6283525  3.485683
## 33 0.6209386  3.444556
## 36 0.6434426  3.569393
## 37 0.6150794  3.458092
inspect(subset(musicrules, subset=support > .02 & confidence > 0.6))
##    lhs        rhs        support    confidence lift    
## 13 {keane} => {coldplay} 0.02226667 0.6374046  4.020634
inspect(subset(musicrules, subset=lhs%in%"t.i."))
##   lhs       rhs          support confidence lift    
## 1 {t.i.} => {kanye west} 0.0104  0.5672727  8.854413

Рассмотрим больший набор попарных ассоциативных связей исполнителей:

artrules <- apriori(playtrans, 
                    parameter=list(support=.001, confidence=.1, maxlen=2))
## Apriori
## 
## Parameter specification:
##  confidence minval smax arem  aval originalSupport support minlen maxlen
##         0.1    0.1    1 none FALSE            TRUE   0.001      1      2
##  target   ext
##   rules FALSE
## 
## Algorithmic control:
##  filter tree heap memopt load sort verbose
##     0.1 TRUE TRUE  FALSE TRUE    2    TRUE
## 
## Absolute minimum support count: 15 
## 
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[1004 item(s), 15000 transaction(s)] done [0.07s].
## sorting and recoding items ... [1004 item(s)] done [0.02s].
## creating transaction tree ... done [0.02s].
## checking subsets of size 1 2 done [0.05s].
## writing ... [42981 rule(s)] done [0.02s].
## creating S4 object  ... done [0.03s].

извлечем ассоциативные правила как строки, а затем переведем их в вид матрицы смежности ребер. Мы будем выводить пары на каждом шаге, чтобы понимать, что происходит:

pairs <- labels(artrules)
pairs <- gsub("\\{|\\}","",pairs)
pairs <- strsplit(pairs," => ")
pairs <- do.call(rbind,pairs)
pairs <- pairs[pairs[,1]!="",]

Теперь воспользуемся библиотекой igraph, позволяющей строить графы в R:

library(igraph)
## 
## Attaching package: 'igraph'
## The following object is masked from 'package:arules':
## 
##     union
## The following objects are masked from 'package:stats':
## 
##     decompose, spectrum
## The following object is masked from 'package:base':
## 
##     union
musicnet <- graph.edgelist(pairs)
musicnet <- as.undirected(musicnet)

Отрисовка нашего графа займет некоторое время.

V(musicnet)$color <- "cyan"

Расстояния на графе пропорциональны силе связи между исполнителями.Представьте, что вы тянете узлы, связанные резинками, в направлении друг от друга. Можно задать параметры цвета/размера и т.п. для самого графа, либо только для его изображения. edge.curved ставит прямые линии между вершинами; это хорошо выглядит и строится быстрее:

plot(musicnet, vertex.label=NA, vertex.size=3, edge.curved=FALSE)

Рассмотрим некоторые характеристики силы связи:

mbetween <- betweenness(musicnet)
mdegree <- degree(musicnet)
which.max(mbetween)
## the beatles 
##          60

Оценим популярность:

playcount <- table(lastfm$artist)[names(mdegree)]

Они все тесно связаны между собой, о чем свидетельствуют следующие графики:

plot(mdegree,mbetween,log="xy")

plot(playcount,mbetween,log="xy")

хотя некоторые точки выбиваются. Давайте выделим их на графике:

plot(playcount,mbetween,log="xy",ylab="betweenness",col="grey50",bty="n")
points(playcount["pidЕјama porno"],mbetween["pidЕјama porno"],col=2)
text(playcount["pidЕјama porno"],
     mbetween["pidЕјama porno"]*2,labels="pidЕјama porno",col=2) 
points(playcount["[unknown]"],mbetween["[unknown]"],col=4)
text(playcount["[unknown]"],
     mbetween["[unknown]"]*1/2,labels="[unknown]",col=4)

Как мы видим, выбивается польская группа “PidEjama porno” и один неизвестный исполнитель.

Мы также можем показать в виде графа всех исполнителей, связанных с определенной группой, например с группой “Rush”:

band <- "rush" 
nei <- graph.neighborhood(musicnet, 1, V(musicnet)[band])[[1]]
V(nei)[band]$color <- "gold"
V(nei)$label.color = "black"
V(nei)$frame.color = NA
plot(nei, edge.curved=FALSE)

На полученном графе показано, каких исполнителей обычно слушают пользователи LastFM, увлекающиеся творчеством группы “Rush”. Причем чем ближе название исполнителя к центру, тем более вероятно, что его песни придутся по вкусу любителю “Rush”.

Выполнили студентки группы 13709 Дмитриева А., Максимова Е. и Мягкова Е.