Celem niniejszego projektu jest zastosowanie metod uczenia maszynowego nienadzorowanego do odkrywania reguł asocjacyjnych w danych filmowych. W analizie wykorzystano zbiór MovieLens, zawierający informacje o ocenach filmów wystawianych przez użytkowników. Po odpowiednim przetworzeniu danych oraz wyodrębnieniu pozytywnych ocen, zastosowano algorytm Apriori w celu identyfikacji zależności pomiędzy filmami. Jakość uzyskanych reguł oceniono przy użyciu miar wsparcia, ufności oraz współczynnika lift. Otrzymane wyniki wskazują na istnienie istotnych powiązań pomiędzy preferencjami użytkowników i mogą znaleźć zastosowanie w systemach rekomendacyjnych.
Reguły asocjacyjne stanowią jedną z podstawowych technik eksploracji danych w ramach uczenia maszynowego nienadzorowanego. Ich celem jest identyfikacja współwystępujących elementów w zbiorach danych transakcyjnych. Metody te znajdują szerokie zastosowanie m.in. w analizie koszykowej oraz systemach rekomendacyjnych.
W projekcie wykorzystano zbiór MovieLens (ml-latest-small), udostępniony przez GroupLens Research. Zawiera on dane dotyczące ocen filmów wystawianych przez użytkowników w skali od 0.5 do 5.
ratings <- read.csv("ratings.csv")
movies <- read.csv("movies.csv")
#Połączenie ocen z tytułami filmów (żeby reguły były czytelne)
data <- merge(ratings, movies, by = "movieId")if(!require(arulesViz)) install.packages("arulesViz") ## Ładowanie wymaganego pakietu: arulesViz## Warning: pakiet 'arulesViz' został zbudowany w wersji R 4.5.2## Ładowanie wymaganego pakietu: arules## Warning: pakiet 'arules' został zbudowany w wersji R 4.5.2## Ładowanie wymaganego pakietu: Matrix##
## Dołączanie pakietu: 'arules'## Następujące obiekty zostały zakryte z 'package:base':
##
## abbreviate, writelibrary(dplyr) ##
## Dołączanie pakietu: 'dplyr'## Następujące obiekty zostały zakryte z 'package:arules':
##
## intersect, recode, setdiff, setequal, union## Następujące obiekty zostały zakryte z 'package:stats':
##
## filter, lag## Następujące obiekty zostały zakryte z 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(arules)
library(arulesViz)
#Filtrowanie pozytywnych ocen
pos_ratings <- data %>% filter(rating >= 4)
#Tworzenie transakcji
movie_list <- split(pos_ratings$title, pos_ratings$userId)
transactions <- as(movie_list, "transactions")## Warning in asMethod(object): removing duplicated items in transactions#Podstawowe informacje
summary(transactions)## transactions as itemMatrix in sparse format with
## 609 rows (elements/itemsets/transactions) and
## 6297 columns (items) and a density of 0.01266769
##
## most frequent items:
## Shawshank Redemption, The (1994) Forrest Gump (1994)
## 274 249
## Pulp Fiction (1994) Silence of the Lambs, The (1991)
## 244 225
## Matrix, The (1999) (Other)
## 222 47365
##
## element (itemset/transaction) length distribution:
## sizes
## 1 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17
## 1 3 2 4 7 4 4 5 9 7 6 14 12 14 16 16
## 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
## 9 11 6 15 9 11 12 7 13 14 6 10 4 6 4 4
## 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49
## 5 7 10 2 5 8 5 9 9 6 6 3 5 3 5 1
## 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
## 5 2 2 5 3 4 2 2 3 3 3 3 5 2 2 3
## 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81
## 1 3 2 2 5 1 2 1 2 2 1 2 1 2 1 2
## 82 83 84 85 86 87 88 89 90 91 92 94 95 96 97 98
## 3 1 4 3 4 3 1 1 1 2 1 1 3 2 2 2
## 99 100 102 103 104 105 107 109 110 111 112 113 114 116 121 122
## 1 1 1 1 1 2 2 4 2 1 1 1 1 2 3 1
## 124 125 127 128 129 130 131 132 133 134 136 137 139 140 141 142
## 1 1 2 1 1 1 1 2 1 1 1 2 1 2 1 1
## 143 146 148 152 154 157 159 165 166 170 175 176 177 178 179 182
## 3 1 1 1 1 1 1 2 1 1 2 1 1 1 1 2
## 183 184 185 187 188 189 190 192 193 194 198 199 200 202 207 210
## 1 1 1 1 1 2 1 1 1 1 1 2 1 1 1 1
## 211 214 216 218 222 223 229 233 234 238 239 241 243 245 246 248
## 1 1 2 2 1 1 1 1 1 1 1 1 2 1 1 1
## 249 251 254 255 259 265 266 270 272 274 275 276 279 280 285 300
## 1 1 1 1 1 1 1 1 2 1 1 1 1 1 2 1
## 309 312 317 321 327 351 352 376 381 418 446 455 488 511 554 563
## 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## 613 614 669 787 1227
## 1 1 1 1 1
##
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 21.00 40.00 79.77 92.00 1227.00
##
## includes extended item information - examples:
## labels
## 1 '71 (2014)
## 2 'burbs, The (1989)
## 3 'Hellboy': The Seeds of Creation (2004)
##
## includes extended transaction information - examples:
## transactionID
## 1 1
## 2 2
## 3 3#Liczba transakcji i elementów
length(transactions) ## [1] 609nitems(transactions)## [1] 6297#Algorytm Apriori umożliwia generowanie reguł asocjacyjnych na podstawie zadanych progów wsparcia oraz ufności. \# supp: wsparcie (np. film musi wystąpić w 5% "koszyków")
#conf: ufność (np. 60% pewności, że po filmie A wystąpi film B) minlen: minimalna liczba przedmiotów w regule (2, aby uniknąć pustych reguł)
rules <- apriori(transactions, parameter = list(supp = 0.05, conf = 0.6, minlen = 2))## Apriori
##
## Parameter specification:
## confidence minval smax arem aval originalSupport maxtime support minlen
## 0.6 0.1 1 none FALSE TRUE 5 0.05 2
## maxlen target ext
## 10 rules TRUE
##
## Algorithmic control:
## filter tree heap memopt load sort verbose
## 0.1 TRUE TRUE FALSE TRUE 2 TRUE
##
## Absolute minimum support count: 30
##
## set item appearances ...[0 item(s)] done [0.00s].
## set transactions ...[6297 item(s), 609 transaction(s)] done [0.01s].
## sorting and recoding items ... [353 item(s)] done [0.00s].
## creating transaction tree ... done [0.00s].
## checking subsets of size 1 2 3 4 5 6 7 done [0.03s].
## writing ... [88945 rule(s)] done [0.01s].
## creating S4 object ... done [0.01s].#W celu usunięcia reguł nadmiarowych zastosowano funkcję is.redundant(). Czasami algorytm generuje zbyt ogólne reguły, warto je wyczyścić:
rules <- rules[!is.redundant(rules)]#Sortujemy po 'lift' (przyroście), co pokazuje najsilniejsze zależności
rules_sorted <- sort(rules, by = "lift", decreasing = TRUE)
#Wyświetlenie 10 najlepszych reguł w konsoli
inspect(rules_sorted[1:10])## lhs rhs support confidence coverage lift count
## [1] {Hot Fuzz (2007)} => {Shaun of the Dead (2004)} 0.05254516 0.7619048 0.06896552 8.754717 32
## [2] {Shaun of the Dead (2004)} => {Hot Fuzz (2007)} 0.05254516 0.6037736 0.08702791 8.754717 32
## [3] {Harry Potter and the Chamber of Secrets (2002)} => {Harry Potter and the Sorcerer's Stone (a.k.a. Harry Potter and the Philosopher's Stone) (2001)} 0.06239737 0.7916667 0.07881773 8.312500 38
## [4] {Harry Potter and the Sorcerer's Stone (a.k.a. Harry Potter and the Philosopher's Stone) (2001)} => {Harry Potter and the Chamber of Secrets (2002)} 0.06239737 0.6551724 0.09523810 8.312500 38
## [5] {Spider-Man 2 (2004)} => {Spider-Man (2002)} 0.05254516 0.7804878 0.06732348 8.056222 32
## [6] {Kill Bill: Vol. 1 (2003),
## Matrix, The (1999),
## Star Wars: Episode VI - Return of the Jedi (1983)} => {Kill Bill: Vol. 2 (2004)} 0.05747126 0.9459459 0.06075534 8.001126 35
## [7] {Kill Bill: Vol. 1 (2003),
## Matrix, The (1999),
## Star Wars: Episode IV - A New Hope (1977),
## Star Wars: Episode V - The Empire Strikes Back (1980)} => {Kill Bill: Vol. 2 (2004)} 0.05747126 0.9459459 0.06075534 8.001126 35
## [8] {Crouching Tiger, Hidden Dragon (Wo hu cang long) (2000),
## Kill Bill: Vol. 1 (2003)} => {Kill Bill: Vol. 2 (2004)} 0.05254516 0.9411765 0.05582923 7.960784 32
## [9] {Kill Bill: Vol. 1 (2003),
## Star Wars: Episode VI - Return of the Jedi (1983)} => {Kill Bill: Vol. 2 (2004)} 0.06239737 0.9268293 0.06732348 7.839431 38
## [10] {Kill Bill: Vol. 1 (2003),
## Star Wars: Episode IV - A New Hope (1977),
## Star Wars: Episode V - The Empire Strikes Back (1980)} => {Kill Bill: Vol. 2 (2004)} 0.06239737 0.9268293 0.06732348 7.839431 38rules_df <- as(rules_sorted, "data.frame")
write.csv(rules_df, "wyniki_reguly.csv", row.names = FALSE)# A. Wykres rozrzutu (Scatter plot) - Pokazuje zależność między wsparciem a ufnością.
plot( rules, method = "scatterplot", engine = "htmlwidget", measure = c("support", "confidence"), shading = "lift" )## Warning: Too many rules supplied. Only plotting the best 1000 using 'lift'
## (change control parameter max if needed).## To reduce overplotting, jitter is added! Use jitter = 0 to prevent jitter.# B. Wykres sieciowy (Graph) - Wybieramy top 30 reguł, żeby wykres był czytelny
sub_rules <- head(rules_sorted, 30)
plot(sub_rules, method = "graph", engine = "htmlwidget")Wykres punktowy wskazuje na wysoką jakość wygenerowanych reguł asocjacyjnych, z których większość charakteryzuje się ufnością powyżej 70%. Dominujące wysokie wartości współczynnika Lift potwierdzają istnienie silnych, nielosowych zależności pomiędzy filmami, co czyni model użytecznym w systemie rekomendacji.
Interaktywny wykres sieciowy przedstawia reguły asocjacyjne między filmami. Kolor węzła odzwierciedla siłę reguł (np. support, confidence, lift), a interaktywność umożliwia eksplorację i filtrowanie powiązań.
Przeprowadzona analiza umożliwiła identyfikację istotnych zależności pomiędzy filmami ocenianymi pozytywnie przez użytkowników. Uzyskane reguły asocjacyjne mogą zostać wykorzystane w systemach rekomendacyjnych, np. do sugerowania filmów na podstawie wcześniejszych preferencji użytkowników. Algorytm Apriori okazał się skutecznym narzędziem eksploracji danych w kontekście uczenia maszynowego nienadzorowanego. *AI użyte do pomocy z kodowaniem i redakcją tekstu