Dane zaczerpnięte zostały z serwisu Kaggle[fn::https://www.kaggle.com/datasets/paradisejoy/top-hits-spotify-from-20002019]. Dotyczą one najpopularniejszych piosenek w serwisie Spotify w latach 2000-2019.
Dostępnymi kolumnami w tym zbiorze danych są
artist song duration_ms explicit year popularity danceability energy key loudness mode speechiness acousticness instrumentalness liveness valence tempo genre.
Jest jednak istotny problem — dany utwór może znajdować się w wielu kategoriach.
Na potrzeby zadania pierwszy gatunek przypisany do danego utworu został uznany za właściwy.
library(bnlearn)
df <- data.frame(read.csv("./songs_normalize.csv"))
colnames(df)
head(df[c("artist", "song", "genre")], 3)library(stringr)
library(forcats)
one_gen <- function(entry)
str_split(entry, ", ")[[1]][1]
df$genre <- as_factor(sapply(c(df$genre), one_gen))
df$explicit <- df$explicit == "True"
head(df[c("artist", "song", "genre")], 3)par(mfrow = c(2, 1))
hist(df$instrumentalness)
hist(log(df$instrumentalness))Większość danych ma charakter ciągły, w związku z tym należało je zdyskretyzować. Część danych należało przetworzyć:
- Wyłączyć artystów i tytuły z czynników
- Skonwertować liczby całkowite do zmiennoprzecinkowych
- W przypadku instrumentalności zlogarytmować i usunąć nieskończoności.
df$instrumentalness <- log(df$instrumentalness)
df$instrumentalness[df$instrumentalness == -Inf] <- min(df[df$instrumentalness != -Inf, ]$instrumentalness) - 1
explicit <- df$explicit
year <- df$year
key <- df$key
mode <- df$mode
instrumentalness <- df$instrumentalnessInstrumentalność została zdyskretyzowana używając metody interwałowej, ponieważ kwantylowa generowała przedziały o długości 0, co jest błędem.
df <- discretize(subset(df, select = -c(explicit, year, key, mode, instrumentalness)), breaks = 10)
df$explicit <- as.factor(explicit)
df$year <- as.factor(year)
df$key <- as.factor(key)
df$mode <- as.factor(mode)
tmp <- discretize(data.frame(instrumentalness), breaks = 10, method = "interval")
df$instrumentalness <- tmp$instrumentalness
gs_graph <- gs(df)
graphviz.plot(gs_graph, layout = "dot")pc_stable_graph <- pc.stable(df)
graphviz.plot(pc_stable_graph, layout = "dot")W tym celu skierowano odpowiednie krawędzie — algorytm GS jako jedyny miał wszystkie krawędzie skierowane.
# IAMB
iamb_graph <- set.arc(iamb_graph, "tempo", "speechiness")
iamb_graph <- set.arc(iamb_graph, "key", "mode")
iamb_graph <- set.arc(iamb_graph, "year", "popularity")
# PC.STABLE
pc_stable_graph <- set.arc(pc_stable_graph, "loudness", "energy")
pc_stable_graph <- set.arc(pc_stable_graph, "key", "mode")Chcemy uzyskać jak najniższą wartość straty w naszej sieci, dlatego wybieramy algorytm o najniższej jej wartości.
c(loss(bn.cv(df, iamb_graph)), loss(bn.cv(df, gs_graph)), loss(bn.cv(df, pc_stable_graph)))Najlepszym okazał się algorytm iamb
Uczenie parametrów z użyciem metody mle jest domyślną metodą — w praktyce nie jest konieczne użycie parametru method, jednak został wprowadzony dla dodatkowej czytelności.
fit_mle <- bn.fit(iamb_graph, df, method = "mle")library(gRain)
junc <- compile(as.grain(fit_mle))
querygrain(setEvidence(junc, evidence = list(explicit="yes")), nodes=c("genre", "speeciness"), type="conditional")
ev_explicit <- querygrain(setEvidence(junc, evidence=list(explicit="yes")))
plot(ev_explicit$genre)Okazuje się, że największą szansę na bycie niecenzuralnymi mają piosenki (w kolejności prawdopodobieństwa): a) pop, b) hip-hop, c) rock, natomiast pozostałe mają bardzo niską zależność.
Głośność w pewnym stopniu zależy od energii utworu, jednak są to wartości stosunkowo niskie.
ev_energy <- querygrain(setEvidence(junc, evidence=list(energy="(0.861,0.906]")))
plot(ev_energy$loudness)Niech
P(B)≈0.099\
P(A)≈ 0.4465 \
P(B|A)&= \frac{P(A|B)P(B)}{P(A)}\
&= \frac{0.33⋅ 0.099}{0.4465}=0.073169
\end{align*}
Wynik jest zgodny z obliczeniami sieci (