Github: https://github.com/gabrielerichsonmrp/gehm_classification_01

1 Intro

Menentukan jenis kelamin seseorang berdasarkan suara mereka merupakan hal yang mudah sebagian besar orang. Namun, bagaimana jika sebuah mesin dapat mengetahui orang yang sedang berbicara adalah laki-laki atau perempuan?

Pada kesempatan kali ini, kita akan mencoba melakukan pemodelan statistik untuk mengidentifikasi jenis kelamin seseorang berdasarkan suaranya. Data yang digunakan merupakan hasil analisis akustik oleh KORY BECKER yang menggunakan 3.168 sampel rekaman suara dan ucapan dari pria/wanita. Sampel suara pra-diproses menggunakan analisis akustik dalam R menggunakan paket seewave dan tuneR, dengan rentang frekuensi yang dianalisis dari 0 hz-280 hz (rentang vokal manusia). Untuk penjelasan mengenai analisis akustik yang dilakukan dan metode pemodelan lainnya, silahkan menggunjungi situs yang dipublish KORY BECKER

2 Read Data

dateset yang digunakan dapat didownload dari link ini dengan total 3168 obsevasi dan 21 variabel.

voice <-  read.csv("data_input/voice.csv")
setnames(voice, "label", "gender")
dim(voice)

#> [1] 3168   21

3 Data Inspection

3.1 10 top line

head(voice,10)

3.2 10 bottom line

tail(voice,10)

3.3 Variable Description

Data ini dibuat menggunakan Analisis Akustik yang dimana variabel yang dihasilkan sebagai berikut:

Variabel	deksripsi
duration	length of signal
meanfreq	mean frequency (in kHz)
sd	standard deviation of frequency
median	median frequency (in kHz)
Q25	first quantile (in kHz)
Q75	third quantile (in kHz)
IQR	interquantile range (in kHz)
skew	skewness (see note in specprop description)
kurt	kurtosis (see note in specprop description)
sp.ent	spectral entropy
sfm	spectral flatness
mode	mode frequency
centroid	frequency centroid (see specprop)
peakf	peak frequency (frequency with highest energy)
meanfun	average of fundamental frequency measured across acoustic signal
minfun	minimum fundamental frequency measured across acoustic signal
maxfun	maximum fundamental frequency measured across acoustic signal
meandom	average of dominant frequency measured across acoustic signal
mindom	minimum of dominant frequency measured across acoustic signal
maxdom	maximum of dominant frequency measured across acoustic signal
dfrange	range of dominant frequency measured across acoustic signal
modindx	modulation index. Calculated as the accumulated absolute difference between adjacent measurements of fundamental frequencies divided by the frequency range
gender	male or female (Target Prediksi)

4 Data Pre-Processing

4.1 Data Structure

Struktur data dibawah menunjukan bahwa tipe data yang dimiliki sudah sesuai dengan kebutuhan pemodelan.

glimpse(voice)

#> Observations: 3,168
#> Variables: 21
#> $ meanfreq <dbl> 0.05978098, 0.06600874, 0.07731550, 0.15122809, 0.13512039...
#> $ sd       <dbl> 0.06424127, 0.06731003, 0.08382942, 0.07211059, 0.07914610...
#> $ median   <dbl> 0.03202691, 0.04022873, 0.03671846, 0.15801119, 0.12465623...
#> $ Q25      <dbl> 0.015071489, 0.019413867, 0.008701057, 0.096581728, 0.0787...
#> $ Q75      <dbl> 0.09019344, 0.09266619, 0.13190802, 0.20795525, 0.20604493...
#> $ IQR      <dbl> 0.07512195, 0.07325232, 0.12320696, 0.11137352, 0.12732471...
#> $ skew     <dbl> 12.8634618, 22.4232854, 30.7571546, 1.2328313, 1.1011737, ...
#> $ kurt     <dbl> 274.402906, 634.613855, 1024.927705, 4.177296, 4.333713, 8...
#> $ sp.ent   <dbl> 0.8933694, 0.8921932, 0.8463891, 0.9633225, 0.9719551, 0.9...
#> $ sfm      <dbl> 0.4919178, 0.5137238, 0.4789050, 0.7272318, 0.7835681, 0.7...
#> $ mode     <dbl> 0.00000000, 0.00000000, 0.00000000, 0.08387819, 0.10426140...
#> $ centroid <dbl> 0.05978098, 0.06600874, 0.07731550, 0.15122809, 0.13512039...
#> $ meanfun  <dbl> 0.08427911, 0.10793655, 0.09870626, 0.08896485, 0.10639784...
#> $ minfun   <dbl> 0.01570167, 0.01582591, 0.01565558, 0.01779755, 0.01693122...
#> $ maxfun   <dbl> 0.2758621, 0.2500000, 0.2711864, 0.2500000, 0.2666667, 0.2...
#> $ meandom  <dbl> 0.007812500, 0.009014423, 0.007990057, 0.201497396, 0.7128...
#> $ mindom   <dbl> 0.0078125, 0.0078125, 0.0078125, 0.0078125, 0.0078125, 0.0...
#> $ maxdom   <dbl> 0.0078125, 0.0546875, 0.0156250, 0.5625000, 5.4843750, 2.7...
#> $ dfrange  <dbl> 0.0000000, 0.0468750, 0.0078125, 0.5546875, 5.4765625, 2.7...
#> $ modindx  <dbl> 0.00000000, 0.05263158, 0.04651163, 0.24711908, 0.20827389...
#> $ gender   <fct> male, male, male, male, male, male, male, male, male, male...

4.2 Missing Value?

Dataset ini bersih dari missing value.

colSums(is.na(voice))

#> meanfreq       sd   median      Q25      Q75      IQR     skew     kurt 
#>        0        0        0        0        0        0        0        0 
#>   sp.ent      sfm     mode centroid  meanfun   minfun   maxfun  meandom 
#>        0        0        0        0        0        0        0        0 
#>   mindom   maxdom  dfrange  modindx   gender 
#>        0        0        0        0        0

4.3 Duplicate Value

Dari 3168 observasi terdapat 3166 observasi yang unik. Terdapat 2 duplikat value, tidak banyak tapi akan lebih baik jika semua data bersifat unik, sehingga data duplikat perlu dibuang untuk mendapat data real.

voice_df <- voice
voice <- voice %>% distinct()
data.frame("jumlah.seluruh.data"=nrow(voice_df),
           "jumlah.data.unik" = nrow(distinct(voice_df)),
           "jumlah.data.real"= nrow(voice)
           )

5 EDA

Dataset yang dimiliki memiliki proporsi yang seimbang antara data suara laki-laki dan suara perempuan. Hal ini sangat membantu dalam membuat pemodelan. Mari lanjut ke proses Cross Validation.

voice %>% group_by(gender) %>% summarise(freq=n()) %>% 
ggplot( aes(x="", y=freq, fill=gender)) + geom_bar(stat="identity", width=1)+
coord_polar("y", start=0) + 
  geom_text(aes(label = paste0(round((freq/sum(freq))*100), "%")), position = position_stack(vjust = 0.5))+
  scale_fill_manual(values=c("pink", "deepskyblue3")) +
  labs(x = NULL, y = NULL, fill = NULL, title = "Data Proportion by Gender")+
  theme_classic() + 
  theme(axis.line = element_blank(),
        axis.text = element_blank(),
        axis.ticks = element_blank(),
        plot.title = element_text(hjust = 0.5),
        axis.title=element_text(size=9,face="bold"), 
        legend.position = "right"
        )

6 Cross Validation

Dari 3166 data observasi, saya membagi 80% sebagai data train dan 20% sebagai data test. Data train digunakan untuk melakukan pemodelan dan data test digunakan untuk menguji seberapa baik model yang dibuat jika dihadapkan dengan unseen data.

set.seed(1000)
idx <- sample(x=nrow(voice),size = nrow(voice)*0.8)
voice_train <- voice[idx,]
voice_test <- voice[-idx,]

data.frame("jumlah.data.train"=nrow(voice_train),
           "jumlah.data.test"=nrow(voice_test))

Data Proportion

Target variabel yang akan diprediksi : gender. Jika dilihat proporsi data tidak selisih jauh, sehingga bisa langsung dilanjutkan ke proses pemodelan.

prop.table(table(voice_train$gender))

#> 
#>    female      male 
#> 0.5051343 0.4948657

7 Modelling

Output yang diharapkan dari projek kali ini yaitu menghasilkan model yang terbaik untuk mengidentifikasi jenis kelamin berdasarkan suara. Dalam proses pembuatan model kali ini, kita akan mencoba menggunakan metode Logistic Regression dan K-Nearest Neighbour, kemudian membandingkan metode mana yang lebih baik?

Postive Class of Target Variable
Dalam melakukan pemodelan regresi logistik, salah satu hal penting yang perlu diketahui sebelum membuat model klasifikasi ini adalah positive class dari target yang akan kita prediksi. Hal ini bisa diketahui berdasarkan posisi paling terakhir dari level variabel target. Berdasarkan dataset yang kita miliki, Positive Class dari variabel target yaitu male

levels(voice$gender)

#> [1] "female" "male"

7.1 Logistic Regression

7.1.1 Model Fitting: Logistic Regression

Sama seperti regresi linear, feature selection atau pemilihan variabel prediktor untuk pemodelan regresi logistik bisa berdasarkan business wise atau dapat menggunakan pendekatan stepwise. Pada pemodelan ini, saya putuskan menggunakan pendekatan step-wise : backward.

voice_glm <- glm(gender~.,data = voice_train, family = "binomial")

model_backward <- step(
  voice_glm,
  direction = "backward"
)

#> Start:  AIC=494.16
#> gender ~ meanfreq + sd + median + Q25 + Q75 + IQR + skew + kurt + 
#>     sp.ent + sfm + mode + centroid + meanfun + minfun + maxfun + 
#>     meandom + mindom + maxdom + dfrange + modindx
#> 
#> 
#> Step:  AIC=494.16
#> gender ~ meanfreq + sd + median + Q25 + Q75 + IQR + skew + kurt + 
#>     sp.ent + sfm + mode + centroid + meanfun + minfun + maxfun + 
#>     meandom + mindom + maxdom + modindx
#> 
#> 
#> Step:  AIC=494.16
#> gender ~ meanfreq + sd + median + Q25 + Q75 + IQR + skew + kurt + 
#>     sp.ent + sfm + mode + meanfun + minfun + maxfun + meandom + 
#>     mindom + maxdom + modindx
#> 
#> 
#> Step:  AIC=494.16
#> gender ~ meanfreq + sd + median + Q25 + Q75 + skew + kurt + sp.ent + 
#>     sfm + mode + meanfun + minfun + maxfun + meandom + mindom + 
#>     maxdom + modindx
#> 
#>            Df Deviance     AIC
#> - meandom   1   458.17  492.17
#> - maxdom    1   458.17  492.17
#> - sd        1   458.23  492.23
#> - maxfun    1   458.26  492.26
#> - meanfreq  1   458.29  492.29
#> - mindom    1   458.41  492.41
#> - median    1   458.58  492.58
#> - skew      1   459.81  493.81
#> - mode      1   460.10  494.10
#> <none>          458.16  494.16
#> - modindx   1   461.20  495.20
#> - kurt      1   461.77  495.77
#> - Q75       1   464.41  498.41
#> - minfun    1   470.04  504.04
#> - sfm       1   477.19  511.19
#> - sp.ent    1   477.33  511.33
#> - Q25       1   482.66  516.66
#> - meanfun   1  1811.33 1845.33
#> 
#> Step:  AIC=492.17
#> gender ~ meanfreq + sd + median + Q25 + Q75 + skew + kurt + sp.ent + 
#>     sfm + mode + meanfun + minfun + maxfun + mindom + maxdom + 
#>     modindx
#> 
#>            Df Deviance     AIC
#> - maxdom    1   458.17  490.17
#> - sd        1   458.23  490.23
#> - maxfun    1   458.26  490.26
#> - meanfreq  1   458.29  490.29
#> - mindom    1   458.41  490.41
#> - median    1   458.58  490.58
#> - skew      1   459.85  491.85
#> - mode      1   460.10  492.10
#> <none>          458.17  492.17
#> - modindx   1   461.85  493.85
#> - kurt      1   461.87  493.87
#> - Q75       1   464.43  496.43
#> - minfun    1   470.44  502.44
#> - sfm       1   477.31  509.31
#> - sp.ent    1   477.36  509.36
#> - Q25       1   482.85  514.85
#> - meanfun   1  1811.37 1843.37
#> 
#> Step:  AIC=490.17
#> gender ~ meanfreq + sd + median + Q25 + Q75 + skew + kurt + sp.ent + 
#>     sfm + mode + meanfun + minfun + maxfun + mindom + modindx
#> 
#>            Df Deviance     AIC
#> - sd        1   458.24  488.24
#> - maxfun    1   458.27  488.27
#> - meanfreq  1   458.31  488.31
#> - mindom    1   458.42  488.42
#> - median    1   458.61  488.61
#> - skew      1   459.85  489.85
#> - mode      1   460.11  490.11
#> <none>          458.17  490.17
#> - kurt      1   461.88  491.88
#> - modindx   1   462.48  492.48
#> - Q75       1   464.43  494.43
#> - minfun    1   471.14  501.14
#> - sp.ent    1   477.37  507.37
#> - sfm       1   477.43  507.43
#> - Q25       1   483.11  513.11
#> - meanfun   1  1811.65 1841.65
#> 
#> Step:  AIC=488.24
#> gender ~ meanfreq + median + Q25 + Q75 + skew + kurt + sp.ent + 
#>     sfm + mode + meanfun + minfun + maxfun + mindom + modindx
#> 
#>            Df Deviance     AIC
#> - meanfreq  1   458.31  486.31
#> - maxfun    1   458.32  486.32
#> - mindom    1   458.48  486.48
#> - median    1   458.62  486.62
#> - mode      1   460.13  488.13
#> - skew      1   460.14  488.14
#> <none>          458.24  488.24
#> - kurt      1   462.33  490.33
#> - modindx   1   462.69  490.69
#> - minfun    1   471.45  499.45
#> - Q75       1   476.90  504.90
#> - sp.ent    1   477.56  505.56
#> - sfm       1   480.36  508.36
#> - Q25       1   483.28  511.28
#> - meanfun   1  1811.74 1839.74
#> 
#> Step:  AIC=486.31
#> gender ~ median + Q25 + Q75 + skew + kurt + sp.ent + sfm + mode + 
#>     meanfun + minfun + maxfun + mindom + modindx
#> 
#>           Df Deviance     AIC
#> - maxfun   1   458.40  484.40
#> - mindom   1   458.54  484.54
#> - median   1   458.78  484.78
#> - skew     1   460.17  486.17
#> <none>         458.31  486.31
#> - mode     1   460.40  486.40
#> - kurt     1   462.34  488.34
#> - modindx  1   462.70  488.70
#> - minfun   1   472.38  498.38
#> - sp.ent   1   478.16  504.16
#> - sfm      1   487.51  513.51
#> - Q75      1   534.27  560.27
#> - Q25      1   569.14  595.14
#> - meanfun  1  1818.56 1844.56
#> 
#> Step:  AIC=484.4
#> gender ~ median + Q25 + Q75 + skew + kurt + sp.ent + sfm + mode + 
#>     meanfun + minfun + mindom + modindx
#> 
#>           Df Deviance     AIC
#> - mindom   1   458.58  482.58
#> - median   1   458.85  482.85
#> - skew     1   460.31  484.31
#> <none>         458.40  484.40
#> - mode     1   460.43  484.43
#> - kurt     1   462.52  486.52
#> - modindx  1   463.70  487.70
#> - minfun   1   472.84  496.84
#> - sp.ent   1   478.65  502.65
#> - sfm      1   488.24  512.24
#> - Q75      1   534.69  558.69
#> - Q25      1   570.33  594.33
#> - meanfun  1  1907.07 1931.07
#> 
#> Step:  AIC=482.58
#> gender ~ median + Q25 + Q75 + skew + kurt + sp.ent + sfm + mode + 
#>     meanfun + minfun + modindx
#> 
#>           Df Deviance     AIC
#> - median   1   459.02  481.02
#> <none>         458.58  482.58
#> - skew     1   460.66  482.66
#> - mode     1   460.79  482.79
#> - kurt     1   462.92  484.92
#> - modindx  1   463.71  485.71
#> - minfun   1   472.85  494.85
#> - sp.ent   1   478.89  500.89
#> - sfm      1   488.64  510.64
#> - Q75      1   535.12  557.12
#> - Q25      1   573.11  595.11
#> - meanfun  1  1912.49 1934.49
#> 
#> Step:  AIC=481.02
#> gender ~ Q25 + Q75 + skew + kurt + sp.ent + sfm + mode + meanfun + 
#>     minfun + modindx
#> 
#>           Df Deviance     AIC
#> - mode     1   460.86  480.86
#> <none>         459.02  481.02
#> - skew     1   461.04  481.04
#> - kurt     1   463.34  483.34
#> - modindx  1   464.01  484.01
#> - minfun   1   473.34  493.34
#> - sp.ent   1   479.39  499.39
#> - sfm      1   488.78  508.78
#> - Q75      1   552.65  572.65
#> - Q25      1   602.74  622.74
#> - meanfun  1  1936.50 1956.50
#> 
#> Step:  AIC=480.86
#> gender ~ Q25 + Q75 + skew + kurt + sp.ent + sfm + meanfun + minfun + 
#>     modindx
#> 
#>           Df Deviance     AIC
#> - skew     1   462.19  480.19
#> <none>         460.86  480.86
#> - kurt     1   464.42  482.42
#> - modindx  1   466.73  484.73
#> - minfun   1   478.57  496.57
#> - sp.ent   1   479.82  497.82
#> - sfm      1   489.38  507.38
#> - Q75      1   566.44  584.44
#> - Q25      1   603.62  621.62
#> - meanfun  1  1945.68 1963.68
#> 
#> Step:  AIC=480.19
#> gender ~ Q25 + Q75 + kurt + sp.ent + sfm + meanfun + minfun + 
#>     modindx
#> 
#>           Df Deviance     AIC
#> <none>         462.19  480.19
#> - modindx  1   468.00  484.00
#> - kurt     1   470.83  486.83
#> - minfun   1   478.59  494.59
#> - sp.ent   1   481.72  497.72
#> - sfm      1   490.17  506.17
#> - Q75      1   566.48  582.48
#> - Q25      1   604.64  620.64
#> - meanfun  1  1978.55 1994.55

Berdasarkan proses Backward step-wise diatas, formula dengan nilai AIC paling kecil adalah formula yang paling optimal. Sehingga variabel yang digunakan untuk memprediksi gender berdasarkan suara pada pemodelan regresi logistik ini yaitu Q25, Q75, kurt, sp.ent, sfm, meanfun, minfun dan modindx

# Fitted Model
voice_glm_model <- glm(
                        formula = gender ~ Q25 + Q75 + kurt + sp.ent + sfm +meanfun + minfun + modindx, 
                        data = voice_train,
                        family = "binomial"
                       )

summary(voice_glm_model)

#> 
#> Call:
#> glm(formula = gender ~ Q25 + Q75 + kurt + sp.ent + sfm + meanfun + 
#>     minfun + modindx, family = "binomial", data = voice_train)
#> 
#> Deviance Residuals: 
#>     Min       1Q   Median       3Q      Max  
#> -2.9792  -0.0408  -0.0006   0.1124   4.3023  
#> 
#> Coefficients:
#>                Estimate  Std. Error z value             Pr(>|z|)    
#> (Intercept)  -13.077407    7.459464  -1.753              0.07958 .  
#> Q25          -58.121688    5.470603 -10.624 < 0.0000000000000002 ***
#> Q75           58.556484    5.925530   9.882 < 0.0000000000000002 ***
#> kurt          -0.003804    0.001171  -3.249              0.00116 ** 
#> sp.ent        38.121227    9.152315   4.165           0.00003111 ***
#> sfm          -10.518213    2.154508  -4.882           0.00000105 ***
#> meanfun     -162.936839    9.125032 -17.856 < 0.0000000000000002 ***
#> minfun        35.166160    8.533890   4.121           0.00003776 ***
#> modindx       -3.471088    1.428139  -2.430              0.01508 *  
#> ---
#> Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
#> 
#> (Dispersion parameter for binomial family taken to be 1)
#> 
#>     Null deviance: 3509.83  on 2531  degrees of freedom
#> Residual deviance:  462.19  on 2523  degrees of freedom
#> AIC: 480.19
#> 
#> Number of Fisher Scoring iterations: 8

Pada hasil summary model regresi logistik diatas, nilai pada kolom Estimate menunjukan koefiesiennya. Dari nilai koefisien ini bisa diketahui pengaruh dari variabel tersebut bersifat postif atau negatif terhadap positive class. Beirkut lebih jelasnya:

data.frame("coef" = coef(voice_glm_model),
           "Odds_ratio" = exp(coef(voice_glm_model)))

Data diatas merupakan nilai dari koefisien dan Odds Ratio dari setiap variabel yang kita gunakan sebagai prediktor pada model ini. Jika dilihat variabel yang memiliki pengaruh positif terhadap positive class yaitu Q75, sp.ent dan minfun dan variabel yang berpengaruh negatif terhdap positive class yaitu Q25, kurt, sfm, meanfun dan modindx. Hal yang unik disini, variabel yang berpengaruh positif memiliki andil yang sangat besar dalam menentukan gender. Misalnya, setiap kenaikan 1 satuan nilai Q75 maka peluang suara tersebut merupakan suara laki-laki sebesar 2696235877273962377442830000% . Wow, seriusan nih? mari kita cek apakah terdapat Perfect Separator pada model kita?

7.1.2 Perfect Seperator

Perfect Seperator adalah kejadian dimana terdapat variabel yang memiliki nilai koefisien sangat besar. Apabila terdapat kejadian seperti ini, nilai dari variabel tersebut akan menjadi sangat dominan dan mampu memisahkan variabel targetnya dengan pasti.

glm(
    formula = gender ~ Q25 + Q75 + kurt + sp.ent + sfm +meanfun + minfun + modindx, 
    data = voice_train,
    family = "binomial",
    method = "detect_separation"
   )

#> Separation: FALSE 
#> Existence of maximum likelihood estimates
#> (Intercept)         Q25         Q75        kurt      sp.ent         sfm 
#>           0           0           0           0           0           0 
#>     meanfun      minfun     modindx 
#>           0           0           0 
#> 0: finite value, Inf: infinity, -Inf: -infinity

Jika dilihat dari hasil diatas, model yang kita buat tidak memiliki Perfect Seperator. Dapat dilihat, nilai 0 menandakan variabel terkait memiliki porsi nilai yang terbatas dalam menentukan target prediksi. Dengan begitu, model ini dapat dilanjutkan ke proses prediksi.

7.1.3 Predict

Berikut hasil prediksi menggunakan model voice_glm_model ke data test voice_test menggunakan threshold 0.5. Variabel gender merupakan data test, predict_probability merupakan nilai peluang terhadap kelas positif dan predict_gender merupakan hasil prediksi gender.

hint: Jika peluang > 0.5 maka male.

voice_predict <- voice_test %>% 
  mutate(
    predict_probability = predict(object = voice_glm_model, newdata=voice_test, type = "response"),
    predict_gender= case_when(
                              predict_probability>0.5~"male",
                              predict_probability<=0.5~"female"
                            ),
    predict_gender = factor(predict_gender,levels = c("female","male")),
    
  )


voice_predict[,
              c("gender","predict_probability","predict_gender",
                "meanfreq","sd","median","Q25","Q75","IQR","skew","kurt", 
                "sp.ent", "sfm", "mode", "centroid", "meanfun",
                "minfun","maxfun", "meandom","mindom","maxdom","dfrange","modindx")
              ]

7.2 K-Nearest Neighbour

7.2.1 Split Target - Predictor

Sebelumnya kita sudah membuat data Train dan data Test. Namun, dalam melakukan pemodelan K-Nearest Neighbour perlu dilakukan pemisahan data variabel Target dan variabel Predictor baik pada data Train maupun data Test. Berikut prosesnya:

voice_train_x <- voice_train %>% select(-gender)
voice_test_x <- voice_test %>% select(-gender)

voice_train_y <- voice_train %>% select(gender)
voice_test_y <- voice_test %>% select(gender)

7.2.2 Feature Scalling

Proses prediksi KNN berdasarkan jarak sesuai nilai dari variabel yang digunakan, sehinnga perlu dilakukan scalling atas semua variabel predictor-nya untuk memperkecil kemungkinan error yang terjadi. Dalam case ini, setiap variabel memiliki range yang tidak sama dan tidak memiliki range nilai yang pasti sehinga saya memutuskan menggunakan Z-score Standarization.

voice_train_x <- scale(voice_train_x)

voice_test_x <- scale(voice_test_x,
                     center = attr(voice_train_x, "scaled:center"),
                     scale = attr(voice_train_x,"scaled:scale")
                     )

7.2.3 Model Fitting : KNN

Proses pemodelan menggunakan KNN tidak perlu melakukan pemilihan variabel prediktor seperti pemodelan regresi logistik. Jika hendak melakukan pemilihan variabel, maka bisa dilakukan proses PCA sebelum masuk ke tahap split train-test. Berikut pemodelan dan prediksi menggunakan KNN:

k_value <- round(sqrt(nrow(voice_train)),0)
k_value

#> [1] 50

knn_predict <-  class::knn(
    train = voice_train_x,
    test = voice_test_x, 
    cl = voice_train_y$gender,
    k=50,
    prob = TRUE
  )

Pada script prediksi KNN diatas terdapat beberapa variabel sebagai berikut:

train : Objek prediktor (variabel x) di data train.
test : Objek prediktor (variabel x) di data test.
cl : label untuk data train k: integer untuk menentukan berapa banyak k tetangga. Menggunakan.
k : dari hasil sqrt(jumlah observasi dari data train). Dalam case ini sqrt(2532).

7.2.4 Predict

Pada R, proses pemodelan hingga prediksi langsung menggunakan fungsi knn dan sudah dilakukan pada proses diatas. Berikut hasil prediksinya:

Hasil Prediksi KNN:

voice_predict_knn <- cbind(voice_test, predict_probability=attr(knn_predict,"prob"), predict_gender= knn_predict)
voice_predict_knn[,
              c("gender","predict_probability","predict_gender",
                "meanfreq","sd","median","Q25","Q75","IQR","skew","kurt", 
                "sp.ent", "sfm", "mode", "centroid", "meanfun",
                "minfun","maxfun", "meandom","mindom","maxdom","dfrange","modindx")
              ]

8 Model Evaluation

8.1 Data Test VS Prediction

predict_proportion <- voice_test %>% 
  select(gender) %>% 
  mutate(
    glm_probability = voice_predict$predict_probability,
    glm_gender = voice_predict$predict_gender,
    knn_probability = attr(knn_predict,"prob"),
    knn_gender = knn_predict
  )

plot_predict_proportion <- gather(data=predict_proportion, 
                                  key=type, 
                                  value=gender, gender,glm_gender, knn_gender, 
                                  factor_key=T)

plot_predict_proportion %>% 
  group_by(type,gender) %>% 
  summarise(freq=n()) %>% 
  ggplot(aes(x=gender,y=freq,fill=type),group=type,color = type)+
  geom_col(position = "dodge")+
  geom_text(aes(label=freq, y=freq+5), vjust = -0.5, size=4, position = position_dodge(width = 0.9)) +
  labs(
    title = "Gender Proportion by Prediction",
    subtitle = "Gender Proportion of Data Test VS Logistic Regression VS KNN",
    x="Gender",
    y="Total",
    fill = ""
  )+
  theme_minimal()+
  theme(
      axis.title=element_text(size=9,face="bold"), 
      axis.text.x=element_text(size=10,margin = margin(b=10)),
      axis.text.y.left = element_text(margin = margin(l=10)),
      legend.position = "bottom",
      legend.margin=margin(t = 0,l=0,r=0, unit='pt')
  ) +
  scale_fill_manual(labels = c("Data Test", "GLM Predict", "KNN Predict"),
                    values = alpha(c("dodgerblue3", "goldenrod2","forestgreen"), .8))

Jika dilihat dari selisih proporsi antara data gender di data test dan data gender di data hasil prediksi cenderung kecil. Namun, secara proporsi datanya, metode Logistic Regression lebih baik daripada metode K-Nearest Neighbour karena selisih jumlah data prediksi terhadap data test sangat kecil. Tapi meskipun begitu, chart tersebut tidak dapat merepresentasikan ketepatan hasil prediksi. Mari kita evaluasi menggunakan Confussion Matrix.

8.2 Confusion Matrix

Untuk mengevaluasi model Logistic Regression dan K-Nearest Neighbour dapat menggunakan Confusion Matrix. Pada Confusion Matrix terdapat beberapa value yang digunakan untuk mengevaluasi, yaitu:

Accuracy : seberapa mampu model saya menebak dengan benar target Y.
Re-call/Sensitivity : dari semua data aktual yang positif, seberapa mampu proporsi model saya menebak benar.
Specificity : dari semua data aktual yang negatif, seberapa mampu proporsi model saya menebak yang benar.
Precision/Pos Pred Value : dari semua hasil prediksi, seberapa mampu model dapat menebak tepat kelas positif.

Pada pemodelan ini, saya lebih mengutamakan nilai Precision/Pos Pred Value karena saya ingin model ini benar-benar tepat menebak jenis kelamin seseorang. Berikut hasil evaluasinya:

8.2.1 Logistic Regression

# Confusion Matrix : Logistic Regression
caret::confusionMatrix(data = as.factor(voice_predict$predict_gender),
                reference = as.factor(voice_predict$gender),
                positive = "male")

#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction female male
#>     female    295    7
#>     male        9  323
#>                                              
#>                Accuracy : 0.9748             
#>                  95% CI : (0.9593, 0.9855)   
#>     No Information Rate : 0.5205             
#>     P-Value [Acc > NIR] : <0.0000000000000002
#>                                              
#>                   Kappa : 0.9494             
#>                                              
#>  Mcnemar's Test P-Value : 0.8026             
#>                                              
#>             Sensitivity : 0.9788             
#>             Specificity : 0.9704             
#>          Pos Pred Value : 0.9729             
#>          Neg Pred Value : 0.9768             
#>              Prevalence : 0.5205             
#>          Detection Rate : 0.5095             
#>    Detection Prevalence : 0.5237             
#>       Balanced Accuracy : 0.9746             
#>                                              
#>        'Positive' Class : male               
#>

Berdasarkan hasil evaluasi Confussion Matrix diatas, model Logistic Regression yang mendapat nilai Accuracy sebesar 97%, Sensitivity sebesar 98% dan Specificity sebesar 97% dan Precision sebesar 97%. Dengan kata lain, model ini juga sudah sangat baik. Dengan kata lain, model ini sangat baik untuk mengindentifikasi jenis kelamin seseorang berdasarkan suaranya.

8.2.2 K-Nearest Neighbour

# Confusion Matrix: K-Nearest Neighbour
confusionMatrix(data = as.factor(voice_predict_knn$predict_gender), 
                reference = as.factor(voice_predict_knn$gender), 
                positive = "male")

#> Confusion Matrix and Statistics
#> 
#>           Reference
#> Prediction female male
#>     female    279    7
#>     male       25  323
#>                                                
#>                Accuracy : 0.9495               
#>                  95% CI : (0.9295, 0.9652)     
#>     No Information Rate : 0.5205               
#>     P-Value [Acc > NIR] : < 0.00000000000000022
#>                                                
#>                   Kappa : 0.8986               
#>                                                
#>  Mcnemar's Test P-Value : 0.002654             
#>                                                
#>             Sensitivity : 0.9788               
#>             Specificity : 0.9178               
#>          Pos Pred Value : 0.9282               
#>          Neg Pred Value : 0.9755               
#>              Prevalence : 0.5205               
#>          Detection Rate : 0.5095               
#>    Detection Prevalence : 0.5489               
#>       Balanced Accuracy : 0.9483               
#>                                                
#>        'Positive' Class : male                 
#>

Berdasarkan hasil evaluasi Confussion Matrix diatas, model K-Nearest Neighbour yang sudah dibuat mendapat nilai Accuracy sebesar 95%, Sensitivity sebesar 98% dan Specificity sebesar 92% dan Precision sebesar 93%. Dengan kata lain, model ini juga sudah sangat baik. Namun, karena nilai Precision pada metode Logistic Regression lebih tinggi dari pada K-Nearest Neighbour maka model Logistic Regression yang sudah dibuat lebih baik untuk mengidentifikasi jenis kelamin berdasarkan suaranya.

9 Summary

Menentukan jenis kelamin sesorang berdasarkan suara memang terdengar mudah. Namun, akan menjadi berbeda jika sebuah mesin dapat mengetahui jenis kelamin seseorang berdasarkan suaranya. Saat ini terdapat 5 mesin asisten virtual yang umum diketahui, yaitu:

Akan sangat baik apabila sebuah mesin virtual dapat mengetahui gender seseorang untuk menentukan pendekatan, gaya berbicaranya hingga mencari topik yang sedang tren berdasarkan gendernya. Berdasarkan pemodelan dan evaluasi yang sudah dilakukan menunjukan bahwa model Logistic Regression lebih baik untuk mengidentifikasi jenis kelamin seseorang berdasarkan suara karena menghasilkan nilai Precision sebesar 97%, sedangkan model K-Nearest Neighbour hanya menghasilkan nilai Precision sebesar 93%. Info penting lainnya, jika hendak menerapkan model logistic regression ini maka harus melakukan analisis akustik terlebih dahulu.

Gender Recognition by Voice

Using Logistic Regression and K-Nearest Neighbour

by Gabriel Erichson