Import Library

library(dplyr)
library(tidyr)
library(GGally)
library(gridExtra)
library(factoextra)
library(FactoMineR)
library(plotly)
library(purrr)

Read Data

spot <- read.csv("Data_Input/SpotifyFeatures.csv")
spot
names(spot) <-  c("genre","artist_name","track_name","track_id","popularity","acousticness","danceability","duration_ms","energy","instrumentalness","key","liveness","loudness","mode","speechiness","tempo","time_signature","valence")

Data Re-Processing

spot_clean <- spot %>%
  mutate(genre=as.factor(genre)) %>%
  mutate(key=as.factor(key)) %>%
  mutate(mode=as.factor(mode)) %>% 
  mutate(time_signature=as.factor(time_signature)) %>% 
  mutate(energy=as.factor(energy))

spot_clean

#Cek Missing Value

colSums(is.na(spot_clean))
##            genre      artist_name       track_name         track_id 
##                0                0                0                0 
##       popularity     acousticness     danceability      duration_ms 
##                0                0                0                0 
##           energy instrumentalness              key         liveness 
##                0                0                0                0 
##         loudness             mode      speechiness            tempo 
##                0                0                0                0 
##   time_signature          valence 
##                0                0

Tidak ada Missing Value

Data untuk PCA

memisahkan data yang bertipe numeric

spfy <- spot_clean %>% 
  select_if(is.numeric)

Cek skala data

summary(spfy)
##    popularity      acousticness     danceability     duration_ms     
##  Min.   :  0.00   Min.   :0.0000   Min.   :0.0569   Min.   :  15387  
##  1st Qu.: 29.00   1st Qu.:0.0376   1st Qu.:0.4350   1st Qu.: 182857  
##  Median : 43.00   Median :0.2320   Median :0.5710   Median : 220427  
##  Mean   : 41.13   Mean   :0.3686   Mean   :0.5544   Mean   : 235122  
##  3rd Qu.: 55.00   3rd Qu.:0.7220   3rd Qu.:0.6920   3rd Qu.: 265768  
##  Max.   :100.00   Max.   :0.9960   Max.   :0.9890   Max.   :5552917  
##  instrumentalness       liveness          loudness        speechiness    
##  Min.   :0.0000000   Min.   :0.00967   Min.   :-52.457   Min.   :0.0222  
##  1st Qu.:0.0000000   1st Qu.:0.09740   1st Qu.:-11.771   1st Qu.:0.0367  
##  Median :0.0000443   Median :0.12800   Median : -7.762   Median :0.0501  
##  Mean   :0.1483012   Mean   :0.21501   Mean   : -9.570   Mean   :0.1208  
##  3rd Qu.:0.0358000   3rd Qu.:0.26400   3rd Qu.: -5.501   3rd Qu.:0.1050  
##  Max.   :0.9990000   Max.   :1.00000   Max.   :  3.744   Max.   :0.9670  
##      tempo           valence      
##  Min.   : 30.38   Min.   :0.0000  
##  1st Qu.: 92.96   1st Qu.:0.2370  
##  Median :115.78   Median :0.4440  
##  Mean   :117.67   Mean   :0.4549  
##  3rd Qu.:139.05   3rd Qu.:0.6600  
##  Max.   :242.90   Max.   :1.0000

data perlu di caling karena memiliki skala yang berbeda-beda

Melakukan Scalling

spfy_scale <- scale(spfy)
summary(spfy_scale)
##    popularity       acousticness      danceability       duration_ms     
##  Min.   :-2.2610   Min.   :-1.0389   Min.   :-2.68019   Min.   :-1.8475  
##  1st Qu.:-0.6667   1st Qu.:-0.9329   1st Qu.:-0.64310   1st Qu.:-0.4394  
##  Median : 0.1029   Median :-0.3849   Median : 0.08963   Median :-0.1236  
##  Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.0000  
##  3rd Qu.: 0.7626   3rd Qu.: 0.9963   3rd Qu.: 0.74154   3rd Qu.: 0.2577  
##  Max.   : 3.2365   Max.   : 1.7686   Max.   : 2.34168   Max.   :44.7114  
##  instrumentalness     liveness          loudness        speechiness      
##  Min.   :-0.4898   Min.   :-1.0356   Min.   :-7.1500   Min.   :-0.53129  
##  1st Qu.:-0.4898   1st Qu.:-0.5932   1st Qu.:-0.3670   1st Qu.:-0.45314  
##  Median :-0.4897   Median :-0.4388   Median : 0.3014   Median :-0.38091  
##  Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.0000   Mean   : 0.00000  
##  3rd Qu.:-0.3716   3rd Qu.: 0.2471   3rd Qu.: 0.6784   3rd Qu.:-0.08498  
##  Max.   : 2.8097   Max.   : 3.9591   Max.   : 2.2196   Max.   : 4.56146  
##      tempo             valence        
##  Min.   :-2.82494   Min.   :-1.74924  
##  1st Qu.:-0.79963   1st Qu.:-0.83793  
##  Median :-0.06112   Median :-0.04198  
##  Mean   : 0.00000   Mean   : 0.00000  
##  3rd Qu.: 0.69217   3rd Qu.: 0.78858  
##  Max.   : 4.05310   Max.   : 2.09595

Melihat Variance yang dirangkum tiap PC

plot(prcomp(spfy_scale))

PCA

pca <- prcomp(spfy_scale)

# 1. Eigen Value
pca$sdev^2
##  [1] 2.9752019 1.6928840 1.1086311 0.9885280 0.8617223 0.6516720 0.6292261
##  [8] 0.4751446 0.3486991 0.2682910
# 2. Formula
data.frame(pca$rotation)
#3. Nilai hasil proyeksi titik ke PC untuk tiap baris
data.frame(pca$x)

Reduce Dimension

summary(pca)
## Importance of components:
##                           PC1    PC2    PC3     PC4     PC5     PC6     PC7
## Standard deviation     1.7249 1.3011 1.0529 0.99425 0.92829 0.80726 0.79324
## Proportion of Variance 0.2975 0.1693 0.1109 0.09885 0.08617 0.06517 0.06292
## Cumulative Proportion  0.2975 0.4668 0.5777 0.67652 0.76270 0.82786 0.89079
##                            PC8     PC9    PC10
## Standard deviation     0.68931 0.59051 0.51797
## Proportion of Variance 0.04751 0.03487 0.02683
## Cumulative Proportion  0.93830 0.97317 1.00000

Untuk mempertahanka informasi > 80% maka akan digunakan PC1 - PC6

pc_keep <- data.frame(pca$x[,1:6])
head(pc_keep)
spot_clean %>% 
  select_if(negate(is.integer)) %>% # ambil kolom selain integer
  cbind(pc_keep) # gabungkan dengan PC
fviz_contrib(X = pca,
             choice = "var",
             axes = 6)

Clustering

K-means

RNGkind(sample.kind = "Rounding")
set.seed(100)

spfy_km <- kmeans(spfy_scale, centers = 3) #x harus dataset yang semua bernilai numeric
spfy_km_4 <- kmeans(spfy_scale, centers = 4)
spfy_km_2 <- kmeans(spfy_scale, centers = 2)
spfy_km$iter
## [1] 4
spfy_km$centers
##   popularity acousticness danceability duration_ms instrumentalness    liveness
## 1 -1.1262570    1.1828396   0.04124892  0.06405249       -0.4838094  2.57233817
## 2  0.2607567   -0.4075209   0.30026631 -0.03861757       -0.2934934 -0.08849251
## 3 -0.7324284    1.2741123  -1.14344107  0.13150810        1.2170870 -0.24249796
##     loudness speechiness      tempo    valence
## 1 -0.4150644   3.9982637 -0.6212928 -0.1474691
## 2  0.4050556  -0.1361375  0.1423126  0.2657468
## 3 -1.4369475  -0.3822447 -0.3982520 -0.9707373

Goodness of Fit

Kebaikan hasil clustering dapat dilihat dari 3 nilai: - Within Sum of Squares ($withinss): jumlah jarak kuadrat dari tiap observasi ke centroid tiap cluster. - Between Sum of Squares ($betweenss): jumlah jarak kuadrat terbobot dari tiap centroid ke rata-rata global. Dibobotkan berdasarkan banyaknya observasi pada cluster. - Total Sum of Squares ($totss): jumlah jarak kuadrat dari tiap observasi ke rata-rata global.

spfy_km$withinss # wss
## [1]  107317.5 1009347.5  428633.9
spfy_km$betweenss
## [1] 781941.1
spfy_km$betweenss / spfy_km$totss # rasio BSS/TSS
## [1] 0.335995

Evaluasi

# 3 Cluster
spfy_km$betweenss / spfy_km$totss
## [1] 0.335995
# 4 Cluster
spfy_km_4$betweenss / spfy_km_4$totss
## [1] 0.3935287
# 2 Cluster
spfy_km_2$betweenss / spfy_km_2$totss
## [1] 0.2158933

Clustering dengan 4 kategori menunjukan hasil yang lebih baik

#spfy_km_4$cluster

Data Profiling

spot$cluster <- as.factor(spfy_km_4$cluster)
spot

Cluster Profiling

spot %>%
  group_by(cluster) %>% 
  summarise_all(.funs = "mean") %>% 
  select(-c(genre,artist_name,track_name,track_id,key,mode,time_signature))

Profiling: 1. Cluster 1: energy,tempo,loudness 2. Cluster 2: Liveness,Speechiness 3. Cluster 3: popularity,danceability,valence 4. Cluster 4: acousticness,duration_ms,instrumentalness

Visualisasi

fviz_cluster(object = spfy_km_4,
             data = spot %>% select(-c(genre,artist_name,track_name,track_id,key,mode,time_signature,cluster))) #seluruh data numerik yang mau dimasukan