library(readxl)
tissue <- read_excel("D:/RAKAN/Materi Perkuliahan/Semester 4/Analisis Multivariat/Assignments/data/BreastTissue.xls", sheet = "Data")
str(tissue)
## tibble [106 × 11] (S3: tbl_df/tbl/data.frame)
##  $ Case #: num [1:106] 1 2 3 4 5 6 7 8 9 10 ...
##  $ Class : chr [1:106] "car" "car" "car" "car" ...
##  $ I0    : num [1:106] 525 330 552 380 363 ...
##  $ PA500 : num [1:106] 0.187 0.227 0.232 0.241 0.201 ...
##  $ HFS   : num [1:106] 0.0321 0.2653 0.0635 0.2862 0.2443 ...
##  $ DA    : num [1:106] 229 121 265 138 125 ...
##  $ Area  : num [1:106] 6844 3163 11888 5402 3290 ...
##  $ A/DA  : num [1:106] 29.9 26.1 44.9 39.2 26.3 ...
##  $ Max IP: num [1:106] 60.2 69.7 77.8 88.8 69.4 ...
##  $ DR    : num [1:106] 220.7 99.1 253.8 105.2 103.9 ...
##  $ P     : num [1:106] 557 400 657 494 425 ...

Variabel Independen

I0 - (Nilai impedansi saat frekuensi = 0 Hz (frekuensi sangat rendah)) Menunjukkan tingkat resistansi jaringan. Tumor biasanya memiliki resistansi berbeda dibandingkan jaringan sehat.

PA500 - (Sudut fasa di 500 kHz) Membantu membedakan sifat dielektrik jaringan; tumor bisa memiliki lebih banyak air atau ion, sehingga berbeda sudut fasanya.

HFS - (High-Frequency Slope of phase angle) Menunjukkan perubahan dalam properti kapasitif jaringan; penting untuk mengenali jaringan abnormal

DA - (Jarak impedansi) Mengukur seberapa besar perubahan impedansi antara ujung-ujung frekuensi. Jaringan abnormal bisa punya rentang berbeda.

AREA - (Luas spektrum) Menunjukkan total reaktivitas dan resistansi — tumor bisa menyebabkan area spektrum lebih besar/kecil.

A/DA - (area normalized by DA) Memberi informasi efisiensi perubahan — bisa membantu normalisasi terhadap ukuran atau variasi jaringan.

MAX IP - (Maximum of the spectrum) Titik maksimum bisa menandai kehadiran sifat kapasitif abnormal dalam jaringan.

DR - (Jarak dari I0 ke puncak) Mencerminkan seberapa jauh jaringan berperilaku dari murni resistif — jaringan abnormal sering menunjukkan pola unik.

P - (Panjang kurva spektrum) Kompleksitas jaringan dapat meningkat pada jaringan kanker (lebih panjang kurva karena lebih banyak anomali).

Variabel Dependen

Class - Kelas kategori yang terdiri dari 6 class Car = Carcinoma Fad = Fibro-adenoma Mas = Mastopathy Gla = Glandular Con = Connective Adi = Adipose

Penggabungan Class

tissue <- tissue[, -1]
tissue$Class <- as.factor(tissue$Class)
levels(tissue$Class)[levels(tissue$Class) %in% c("fad", "gla", "mas")] <- "other"
levels(tissue$Class)
## [1] "adi"   "car"   "con"   "other"

Berdasarkan referensi kami, 3 class (fad, gla, mas) digabung menjadi satu yaitu class other. Jadi klasifikasi nanti akan ada 4 class (car, adi, con, other).

Splitting data

Data dipisah menjadi 70% data train dan 30% data test

library(caret)
## Warning: package 'caret' was built under R version 4.4.3
## Loading required package: ggplot2
## Loading required package: lattice
index <- createDataPartition(tissue$Class, p = .70, list = FALSE)
train <- tissue[index,]
test <- tissue[-index,]

Mengatur Kategori Referensi

Disini kategori adi menjadi kategori referensi

# Setting the reference
train$Class <- relevel(train$Class, ref = "adi")

Membuat Model

require(nnet)
## Loading required package: nnet
# Training the multinomial model
multinom_model <- multinom(Class ~ ., data = tissue)
## # weights:  44 (30 variable)
## initial  value 146.947202 
## iter  10 value 107.785951
## iter  20 value 71.796827
## iter  30 value 17.709626
## iter  40 value 11.374947
## iter  50 value 6.775079
## iter  60 value 5.795296
## iter  70 value 5.581883
## iter  80 value 4.868961
## iter  90 value 4.196407
## iter 100 value 4.147495
## final  value 4.147495 
## stopped after 100 iterations

Analisis Model

# Checking the model
summary(multinom_model)
## Call:
## multinom(formula = Class ~ ., data = tissue)
## 
## Coefficients:
##       (Intercept)          I0      PA500        HFS         DA         Area
## car      86.65480 -0.79403171  35.275016 -29.648022 -2.9858650 -0.005336180
## con      65.21129 -0.05346424   3.500523   5.173689  0.5178402 -0.007723664
## other    94.25185 -0.30964931 -10.412464  45.974072 -0.4529376 -0.006945636
##           `A/DA` `Max IP`         DR           P
## car   -0.6481944 2.397151  3.1372432  0.56462240
## con    1.3702187 0.235453 -0.2360684 -0.05475034
## other  1.5880465 0.184137  0.6775140  0.17258281
## 
## Std. Errors:
##       (Intercept)         I0        PA500         HFS        DA       Area
## car   0.036514467 0.08768679 0.0181194343 0.037044850 0.5931611 0.02683088
## con   0.002715077 0.15057377 0.0005871443 0.001053489 0.1383584 0.01954106
## other 0.037254613 0.08768937 0.0180140924 0.036945045 0.6368373 0.02686235
##           `A/DA`  `Max IP`        DR         P
## car   0.54206717 0.4694295 0.5700255 0.1611824
## con   0.09923463 0.6957180 0.2394520 0.1857129
## other 0.54099224 0.4729145 0.5408590 0.1577801
## 
## Residual Deviance: 8.29499 
## AIC: 68.29499

Insight

Berdasarkan hasil pemodelan menggunakan multinomial logistic regression terhadap data tissue, diperoleh beberapa insight:

Variabel PA500 memiliki pengaruh yang sangat besar, terutama dalam meningkatkan peluang untuk masuk ke kelas car. Koefisiennya jauh lebih tinggi dibandingkan variabel lain. Variabel HFS juga menunjukkan pengaruh besar, namun dengan arah yang berbeda: penurunan HFS meningkatkan peluang masuk ke car, sementara kenaikan HFS meningkatkan peluang masuk ke other.

Area dan P memiliki koefisien kecil di semua kelas, menunjukkan bahwa perubahan pada kedua variabel ini tidak banyak memengaruhi prediksi kelas. Dengan kata lain, Area dan P relatif tidak penting dalam membedakan kelas dalam data ini.

Untuk kelas car, banyak variabel seperti PA500, HFS, Max IP, dan DR yang memiliki koefisien besar, baik positif maupun negatif. Ini menunjukkan bahwa pola untuk car sangat dipengaruhi oleh kombinasi faktor yang kompleks.

Kualitas Model

Residual deviance sebesar 8.29499 relatif kecil, menunjukkan bahwa model cukup baik dalam memodelkan data. AIC sebesar 68.29499 juga mendukung bahwa model ini cukup efisien tanpa kompleksitas berlebih.

Konversi koefisien ke bentok odds

exp(coef(multinom_model))
##        (Intercept)        I0        PA500          HFS         DA      Area
## car   4.302318e+37 0.4520187 2.088069e+15 1.330539e-13 0.05049581 0.9946780
## con   2.093644e+28 0.9479398 3.313279e+01 1.765650e+02 1.67839877 0.9923061
## other 8.571498e+40 0.7337042 3.005553e-05 9.253065e+19 0.63575780 0.9930784
##          `A/DA`  `Max IP`         DR         P
## car   0.5229892 10.991818 23.0402622 1.7587835
## con   3.9362114  1.265482  0.7897267 0.9467215
## other 4.8941786  1.202181  1.9689768 1.1883702
head(round(fitted(multinom_model), 2))
##   adi  car con other
## 1   0 0.97   0  0.03
## 2   0 1.00   0  0.00
## 3   0 1.00   0  0.00
## 4   0 1.00   0  0.00
## 5   0 1.00   0  0.00
## 6   0 0.96   0  0.04

Validasi Model

# Memprediksi data Train
train$ClassPredicted <- predict(multinom_model, newdata = train, "class")

# Membuat tabel klasifikasi
tab <- table(train$Class, train$ClassPredicted)
print(tab)
##        
##         adi car con other
##   adi    16   0   0     0
##   car     0  15   0     0
##   con     0   0  10     0
##   other   0   1   0    34
# Menghitung akurasi model
round((sum(diag(tab))/sum(tab))*100,2)
## [1] 98.68

Nilai akurasi 100 yang berarti model merepresentasikan data train dengan tepat

Testing Model

# Memprediksi kelas pada data test
test$ClassPredicted <- predict(multinom_model, newdata = test, "class")

# Membuat tabel klasifikasi
tab_test <- table(test$Class, test$ClassPredicted)
print(tab_test)
##        
##         adi car con other
##   adi     6   0   0     0
##   car     0   6   0     0
##   con     0   0   4     0
##   other   0   0   0    14
round((sum(diag(tab_test))/sum(tab_test))*100,2)
## [1] 100

Pada hasil test, model mampu memprediksi dengan tingkat akurasi yang tinggi yaitu 96.67%.

Referensi: “Jossinet, J. Variability of impedivity in normal and pathological breast tissue. Med. Biol. Eng. Comput. 34, 346–350 (1996). https://doi.org/10.1007/BF02520002”

“https://www.r-bloggers.com/2020/05/multinomial-logistic-regression-with-r/”