Logistic Regression and KNN for Predict Breast Cancer
ygdwtm
2023-03-23
Breast cancer adalah jenis kanker yang umum terjadi pada wanita di seluruh dunia. Ini merupakan penyebab kematian kedua tertinggi akibat kanker. Biasanya, kanker payudara didiagnosis saat ditemukan benjolan atau bintik yang tidak normal selama pemeriksaan sendiri atau x-ray. Jika ditemukan benjolan yang mencurigakan, dokter akan melakukan diagnosis untuk menentukan apakah itu kanker dan apakah sudah menyebar ke bagian tubuh lain.
Dataset tentang kanker payudara ini dikumpulkan dari Rumah Sakit Universitas Wisconsin, Madison oleh Dr. William H. Wolberg. Dataset ini memiliki 6 kolom yaitu mean_radius, mean_texture, mean_perimeter, mean_area, mean_smoothness, dan diagnosis. Kolom-kolom ini menggambarkan atribut dari benjolan pada payudara. Kolom diagnosis adalah parameter biner di mana 1 berarti hasil diagnosis negatif (tidak ada kanker) dan 0 berarti positif (sel kanker terdeteksi).
1. Preparation Data
1.1 Import Library
# Import packages and load data
library(dplyr)
library(ggplot2)
library(gridExtra)
library(grid)
library(kknn)
library(kernlab)
library(plotly)
library(GGally)
# Set ggplot theme
theme_set(theme_bw())1.2 Read Data
# Load Data
df_raw <- read.csv("Breast_cancer_data.csv", header = T, stringsAsFactors = F)
str(df_raw)#> 'data.frame': 569 obs. of 6 variables:
#> $ mean_radius : num 18 20.6 19.7 11.4 20.3 ...
#> $ mean_texture : num 10.4 17.8 21.2 20.4 14.3 ...
#> $ mean_perimeter : num 122.8 132.9 130 77.6 135.1 ...
#> $ mean_area : num 1001 1326 1203 386 1297 ...
#> $ mean_smoothness: num 0.1184 0.0847 0.1096 0.1425 0.1003 ...
#> $ diagnosis : int 0 0 0 0 0 0 0 0 0 0 ...1.2 Summary Data
summary(df_raw)#> mean_radius mean_texture mean_perimeter mean_area
#> Min. : 6.981 Min. : 9.71 Min. : 43.79 Min. : 143.5
#> 1st Qu.:11.700 1st Qu.:16.17 1st Qu.: 75.17 1st Qu.: 420.3
#> Median :13.370 Median :18.84 Median : 86.24 Median : 551.1
#> Mean :14.127 Mean :19.29 Mean : 91.97 Mean : 654.9
#> 3rd Qu.:15.780 3rd Qu.:21.80 3rd Qu.:104.10 3rd Qu.: 782.7
#> Max. :28.110 Max. :39.28 Max. :188.50 Max. :2501.0
#> mean_smoothness diagnosis
#> Min. :0.05263 Min. :0.0000
#> 1st Qu.:0.08637 1st Qu.:0.0000
#> Median :0.09587 Median :1.0000
#> Mean :0.09636 Mean :0.6274
#> 3rd Qu.:0.10530 3rd Qu.:1.0000
#> Max. :0.16340 Max. :1.0000Insight • mean radius berkisar antara 6,981 hingga 28,110, dengan rata-rata sebesar 14,127. Ini berarti bahwa sebagian besar pengamatan memiliki radius antara 11,7 hingga 15,78.
• mean tekstur berkisar antara 9,71 hingga 39,28, dengan rata-rata sebesar 19,29. Ini berarti bahwa sebagian besar pengamatan memiliki tekstur antara 16,17 hingga 21,80.
• mean perimeter benjolan payudara berkisar antara 43,79 hingga 188,50, dengan rata-rata sebesar 91,97. Ini berarti bahwa sebagian besar pengamatan memiliki keliling antara 75,17 hingga 104,10.
• mean area benjolan payudara berkisar antara 143,5 hingga 2501,0, dengan rata-rata sebesar 654,9. Ini berarti bahwa sebagian besar pengamatan memiliki luas antara 420,3 hingga 782,7.
• mean smoothness permukaan benjolan payudara berkisar antara 0,05263 hingga 0,16340, dengan rata-rata sebesar 0,09636. Ini berarti bahwa sebagian besar pengamatan memiliki kehalusan antara 0,08637 hingga 0,10530.
• Mayoritas pengamatan (62,74%) pada kolom diagnosis menunjukkan diagnosis positif, yang berarti bahwa sel-sel kanker terdeteksi. 37,26% sisanya menunjukkan diagnosis negatif, yang berarti tidak terdeteksi sel kanker.
• Secara keseluruhan, dataset ini memberikan informasi tentang atribut benjolan payudara dan diagnosis yang terkait, yang dapat berguna untuk memprediksi kanker payudara dan mengembangkan rencana perawatan.
1.3 Cleaning Data
colSums(is.na(df_raw))#> mean_radius mean_texture mean_perimeter mean_area mean_smoothness
#> 0 0 0 0 0
#> diagnosis
#> 02. EDA
2.1 Box Plot
b_radius <- ggplotly(ggplot(data = df_raw, aes(x = factor(diagnosis), y = mean_radius)) +
geom_boxplot(fill = "steelblue", color = "black") +
ggtitle("Boxplot of Mean Radius by Diagnosis") +
xlab("Diagnosis") +
ylab("Mean Radius"))
b_texture <- ggplotly(ggplot(data = df_raw, aes(x = factor(diagnosis), y = mean_texture)) +
geom_boxplot(fill = "steelblue", color = "black") +
ggtitle("Boxplot of Mean Texture by Diagnosis") +
xlab("Diagnosis") +
ylab("Mean Texture"))
b_perimeter <- ggplotly(ggplot(data = df_raw, aes(x = factor(diagnosis), y = mean_perimeter)) +
geom_boxplot(fill = "steelblue", color = "black") +
ggtitle("Boxplot of Mean Perimeter by Diagnosis") +
xlab("Diagnosis") +
ylab("Mean Perimeter"))
b_area <- ggplotly(ggplot(data = df_raw, aes(x = factor(diagnosis), y = mean_area)) +
geom_boxplot(fill = "steelblue", color = "black") +
ggtitle("Boxplot of Mean Area by Diagnosis") +
xlab("Diagnosis") +
ylab("Mean Area"))
b_smoothness <- ggplotly(ggplot(data = df_raw, aes(x = factor(diagnosis), y = mean_smoothness)) +
geom_boxplot(fill = "steelblue", color = "black") +
ggtitle("Boxplot of Mean Smoothness by Diagnosis") +
xlab("Diagnosis") +
ylab("Mean Smoothness"))
subplot(b_radius, b_texture, b_perimeter, b_area, b_smoothness, nrows = 2, margin = 0.05, titleX = TRUE, titleY = TRUE)2.2 Heatmap
ggplotly(ggcorr(df_raw, label=TRUE))Insight Grafik menunjukkan bahwa radius, perimeter, dan area memiliki korelasi yang tinggi. Ini masuk akal secara logis. Untuk menghindari redundansi, saya akan mengabaikan perimeter dan area dari analisis.
2.3 Dividing the Data
df_truncated <- df_raw %>%
dplyr::select(-mean_perimeter, -mean_area)Sebelum memulai analisis, data akan menjadi set pelatihan (~80%) dan set pengujian (~20%).
# Label
lab <- rep(seq(1, 5), 570 / 5)[1:569]
df_marked <- df_truncated %>%
mutate(label = lab,
category = ifelse(label == 5, "test", "train"))
# Divide
df_train <- df_marked %>%
filter(category == "train") %>%
dplyr::select(-label, -category)
df_test <- df_marked %>%
filter(category == "test") %>%
dplyr::select(-label, -category)# Summary
summary(df_train)#> mean_radius mean_texture mean_smoothness diagnosis
#> Min. : 6.981 Min. : 9.71 Min. :0.05263 Min. :0.0000
#> 1st Qu.:11.707 1st Qu.:16.33 1st Qu.:0.08640 1st Qu.:0.0000
#> Median :13.460 Median :18.90 Median :0.09573 Median :1.0000
#> Mean :14.199 Mean :19.32 Mean :0.09646 Mean :0.6272
#> 3rd Qu.:16.080 3rd Qu.:21.68 3rd Qu.:0.10540 3rd Qu.:1.0000
#> Max. :28.110 Max. :33.81 Max. :0.14470 Max. :1.0000summary(df_test)#> mean_radius mean_texture mean_smoothness diagnosis
#> Min. : 7.691 Min. :11.28 Min. :0.07115 Min. :0.0000
#> 1st Qu.:11.620 1st Qu.:15.68 1st Qu.:0.08583 1st Qu.:0.0000
#> Median :13.150 Median :18.32 Median :0.09687 Median :1.0000
#> Mean :13.838 Mean :19.17 Mean :0.09598 Mean :0.6283
#> 3rd Qu.:15.270 3rd Qu.:21.91 3rd Qu.:0.10390 3rd Qu.:1.0000
#> Max. :23.510 Max. :39.28 Max. :0.16340 Max. :1.0000# Plot Distributions
p <- ggplot(df_marked, aes(fill = category)) +
labs(fill = "")
p_radius <- p +
geom_density(aes(x = mean_radius), alpha = 0.5)
p_texture <- p +
geom_density(aes(x = mean_texture), alpha = 0.5)
p_smoothness <- p +
geom_density(aes(x = mean_smoothness), alpha = 0.5)
p_diagnosis <- p +
geom_bar(aes(x = category, y = diagnosis), stat = "summary", fun.y = "mean")
# Grid
subplot(p_radius, p_texture,p_diagnosis, p_smoothness, nrows = 2, margin = 0.05, titleX = TRUE, titleY = TRUE)Insight Dari output di atas, kita dapat melihat statistik deskriptif dari dataset pelatihan (df_train) dan dataset uji (df_test). Secara khusus, kita dapat melihat bahwa rata-rata mean_radius dan mean_texture dari dataset pelatihan lebih besar dibandingkan dengan dataset uji. Selain itu, kita juga dapat melihat bahwa nilai maksimum mean_texture dari dataset uji jauh lebih besar dibandingkan dengan dataset pelatihan. Insight ini dapat membantu kita memahami perbedaan karakteristik antara kedua dataset dan bagaimana perbedaan tersebut dapat mempengaruhi hasil analisis.
3. Train Model
3.1 KNN
Pertama mencari nilai K terbaik
# Change diagnosis to factor
df_train <- df_train %>%
mutate(diagnosis = as.factor(diagnosis))
# Train
model_knn_train <- train.kknn(
diagnosis ~ .,
data = df_train,
kmax = 30,
scale = TRUE)
# Plot
plot(model_knn_train)
model_knn_train#>
#> Call:
#> train.kknn(formula = diagnosis ~ ., data = df_train, kmax = 30, scale = TRUE)
#>
#> Type of response variable: nominal
#> Minimal misclassification: 0.08114035
#> Best kernel: optimal
#> Best k: 16Insight Grafik dan ringkasan model menunjukkan bahwa k = 16 adalah jumlah optimal yang digunakan pada set pelatihan. Sekarang, mari jalankan model ini pada set pengujian untuk memeriksa akurasi.
model_knn <- kknn(
diagnosis ~ .,
train = df_train,
test = df_test,
k = 16,
scale = TRUE)
accuracy_knn <- sum(df_test$diagnosis == model_knn$fitted.values) / nrow(df_test)
round(100*accuracy_knn, 2)#> [1] 92.92Insight Dengan menggunakan k = 16 pada dataset uji, terlihat bahwa model dapat mengklasifikasikan 93% data uji dengan benar.
3.2 Log Regression
model_lr <- glm(
diagnosis ~ .,
data = df_train,
family = binomial(link = "logit"))
pred_lr <- predict(model_lr, df_test)
pred_lr[pred_lr > 0.5] <- 1
pred_lr[pred_lr <= 0.5] <- 0
accuracy_lr <- sum(pred_lr == df_test$diagnosis) / nrow(df_test)
round(accuracy_lr*100, 2)#> [1] 93.81Insight Model dapat mengklasifikaiskan 94% secara benar
3.3 Visualisazion
df_all <- df_test %>%
mutate(knn = model_knn$fitted.values,
logreg = pred_lr)Radius vs. Texture
p <- ggplot(df_all, aes(x = mean_radius, y = mean_texture))
p_knn <- p +
geom_point(aes(color = as.factor(knn))) +
labs(color = "", title = "KNN")
p_lr <- p +
geom_point(aes(color = as.factor(logreg))) +
labs(color = "", title = "Log Reg")
p_actual <- p +
geom_point(aes(color = as.factor(diagnosis))) +
labs(color = "", title = "Actual")
grid.arrange(p_actual, p_knn, p_lr, ncol = 2)
Radius vs. Smoothness
p <- ggplot(df_all, aes(x = mean_radius, y = mean_smoothness))
p_knn <- p +
geom_point(aes(color = as.factor(knn))) +
labs(color = "", title = "KNN")
p_lr <- p +
geom_point(aes(color = as.factor(logreg))) +
labs(color = "", title = "Log Reg")
p_actual <- p +
geom_point(aes(color = as.factor(diagnosis))) +
labs(color = "", title = "Actual")
grid.arrange(p_actual, p_knn, p_lr, ncol = 2)
Texture vs. Smoothness
p <- ggplot(df_all, aes(x = mean_texture, y = mean_smoothness))
p_knn <- p +
geom_point(aes(color = as.factor(knn))) +
labs(color = "", title = "KNN")
p_lr <- p +
geom_point(aes(color = as.factor(logreg))) +
labs(color = "", title = "Log Reg")
p_actual <- p +
geom_point(aes(color = as.factor(diagnosis))) +
labs(color = "", title = "Actual")
grid.arrange(p_actual, p_knn, p_lr, ncol = 2)
Insight Melihat dari plot-plot, jelas terlihat
bahwa semakin besar radius, semakin besar kemungkinan bahwa massa di
payudara bersifat kanker. Namun, hubungan antara tekstur dan kehalusan
(smoothness) tidak begitu jelas.
3.4 Confusion Matric
3.4.1 KNN
df_cm_knn <- df_all %>%
mutate(tag = case_when(
diagnosis == 0 & knn == 0 ~ "TP",
diagnosis == 0 & knn == 1 ~ "FN",
diagnosis == 1 & knn == 1 ~ "TN",
diagnosis == 1 & knn == 0 ~ "FP")) %>%
group_by(tag) %>%
summarize(count = n())
df_cm_knn#> # A tibble: 3 × 2
#> tag count
#> <chr> <int>
#> 1 FN 8
#> 2 TN 71
#> 3 TP 343.4.2 Log Rgression
df_cm_lr <- df_all %>%
mutate(tag = case_when(
diagnosis == 0 & logreg == 0 ~ "TP",
diagnosis == 0 & logreg == 1 ~ "FN",
diagnosis == 1 & logreg == 1 ~ "TN",
diagnosis == 1 & logreg == 0 ~ "FP")) %>%
group_by(tag) %>%
summarize(count = n())
df_cm_lr#> # A tibble: 4 × 2
#> tag count
#> <chr> <int>
#> 1 FN 4
#> 2 FP 3
#> 3 TN 68
#> 4 TP 384. Conclusions
Semua model (KNN dan Regresi Logistik) memberikan akurasi yang cukup tinggi dalam memprediksi set pengujian.
Visualisasi menunjukkan hubungan yang jelas antara radius yang lebih besar dengan diagnosis positif.