Sintaks Artikel Kelompok 2
Fadhilah Pratiwi (H051241039, Restika (H051241055), Khalilah Jannatul Azira (H051241031) Alfia Azzahra (H051241035)
2026-09-25
SINTAKS R ANALISIS KLASIFIKASI PEMBELIAN MOBIL
Analisis Klasifikasi Pembelian Mobil
Dataset : car_data.csv
Target : Purchased
Metode : K-NN dan Decision Tree
1. LOAD LIBRARY
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.1 ✔ readr 2.2.0
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.3 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(caret)## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## liftlibrary(class)
library(rpart)
library(rpart.plot)
library(corrplot)## corrplot 0.95 loadedlibrary(ggplot2)
library(dplyr)2. LOAD DAN PERSIAPAN DATA
data <- read.csv("D:/STATISTIKA/SEM 5/Modern Prediksi dan Machine Learning/Tugas pekan 4-5/car_data.csv")
# Melihat struktur dan ringkasan data
head(data)## User.ID Gender Age AnnualSalary Purchased
## 1 385 Male 35 20000 0
## 2 681 Male 40 43500 0
## 3 353 Male 49 74000 0
## 4 895 Male 40 107500 1
## 5 661 Male 25 79000 0
## 6 846 Female 47 33500 1str(data)## 'data.frame': 1000 obs. of 5 variables:
## $ User.ID : int 385 681 353 895 661 846 219 588 85 465 ...
## $ Gender : chr "Male" "Male" "Male" "Male" ...
## $ Age : int 35 40 49 40 25 47 46 42 30 41 ...
## $ AnnualSalary: int 20000 43500 74000 107500 79000 33500 132500 64000 84500 52000 ...
## $ Purchased : int 0 0 0 1 0 1 1 0 0 0 ...summary(data)## User.ID Gender Age AnnualSalary
## Min. : 1.0 Length :1000 Min. :18.00 Min. : 15000
## 1st Qu.: 250.8 N.unique : 2 1st Qu.:32.00 1st Qu.: 46375
## Median : 500.5 N.blank : 0 Median :40.00 Median : 72000
## Mean : 500.5 Min.nchar: 4 Mean :40.11 Mean : 72689
## 3rd Qu.: 750.2 Max.nchar: 6 3rd Qu.:48.00 3rd Qu.: 90000
## Max. :1000.0 Max. :63.00 Max. :152500
## Purchased
## Min. :0.000
## 1st Qu.:0.000
## Median :0.000
## Mean :0.402
## 3rd Qu.:1.000
## Max. :1.000# Memeriksa missing value
missing_data <- data.frame(
Variabel = names(data),
Jumlah_Missing = colSums(is.na(data))
)
missing_data## Variabel Jumlah_Missing
## User.ID User.ID 0
## Gender Gender 0
## Age Age 0
## AnnualSalary AnnualSalary 0
## Purchased Purchased 0# Memeriksa jumlah baris duplikat
sum(duplicated(data))## [1] 0# Memeriksa duplikasi User ID
sum(duplicated(data$User.ID))## [1] 0# Menghapus User ID dan mengubah variabel kategorik menjadi factor
data_clean <- data %>%
select(-User.ID) %>%
mutate(
Gender = as.factor(Gender),
Purchased = as.factor(Purchased)
)3. PEMBAGIAN DATA TRAINING DAN TESTING
set.seed(42)
train_index <- createDataPartition(
data_clean$Purchased,
p = 0.70,
list = FALSE
)
train_data <- data_clean[train_index, ]
test_data <- data_clean[-train_index, ]
cat("Jumlah Data Training :", nrow(train_data), "\n")## Jumlah Data Training : 701cat("Jumlah Data Testing :", nrow(test_data), "\n")## Jumlah Data Testing : 2994. EKSPLORASI DATA
4.1 Distribusi Status Pembelian
plot_data <- data %>%
mutate(
Purchased = factor(
Purchased,
levels = c(0, 1),
labels = c("Tidak Membeli", "Membeli")
)
) %>%
count(Purchased) %>%
mutate(
persen = n / sum(n) * 100,
label = paste0(n, " (", round(persen, 1), "%)")
)
ggplot(
plot_data,
aes(x = Purchased, y = n, fill = Purchased)
) +
geom_col(
width = 0.6,
show.legend = FALSE
) +
geom_text(
aes(label = label),
vjust = -0.5,
size = 4.5,
fontface = "bold"
) +
scale_fill_manual(
values = c(
"Tidak Membeli" = "#6C8EBF",
"Membeli" = "#E69F63"
)
) +
labs(
title = "Distribusi Status Pembelian Mobil",
subtitle = "Distribusi observasi berdasarkan variabel Purchased",
x = "Purchased",
y = "Jumlah Observasi"
) +
theme_minimal(base_size = 13) +
theme(
plot.title = element_text(
face = "bold",
size = 16,
hjust = 0.5
),
plot.subtitle = element_text(
size = 11,
hjust = 0.5,
color = "gray40"
),
axis.title = element_text(face = "bold"),
axis.text = element_text(color = "black"),
panel.grid.major.x = element_blank(),
panel.grid.minor = element_blank(),
plot.margin = margin(15, 20, 15, 20)
) +
expand_limits(y = max(plot_data$n) * 1.12)
4.2 Korelasi Age, Annual Salary, dan Purchased
data_cor_target <- data %>%
select(Age, AnnualSalary, Purchased)
cor_matrix_target <- cor(
data_cor_target,
use = "complete.obs",
method = "pearson"
)
cor_matrix_target## Age AnnualSalary Purchased
## Age 1.0000000 0.1660422 0.6160364
## AnnualSalary 0.1660422 1.0000000 0.3649744
## Purchased 0.6160364 0.3649744 1.0000000corrplot(
cor_matrix_target,
method = "color",
type = "upper",
addCoef.col = "black",
number.cex = 0.9,
tl.col = "black",
tl.srt = 0,
col = colorRampPalette(
c("#6C8EBF", "white", "#E69F63")
)(200),
mar = c(0, 0, 1, 0)
)
4.3 Statistik Deskriptif Variabel Numerik
stat_deskriptif <- data.frame(
Variabel = c("Age", "AnnualSalary"),
Minimum = c(
min(data$Age, na.rm = TRUE),
min(data$AnnualSalary, na.rm = TRUE)
),
Maksimum = c(
max(data$Age, na.rm = TRUE),
max(data$AnnualSalary, na.rm = TRUE)
),
Mean = c(
mean(data$Age, na.rm = TRUE),
mean(data$AnnualSalary, na.rm = TRUE)
),
`Standar Deviasi` = c(
sd(data$Age, na.rm = TRUE),
sd(data$AnnualSalary, na.rm = TRUE)
)
)
stat_deskriptif[, -1] <- round(
stat_deskriptif[, -1],
4
)
stat_deskriptif## Variabel Minimum Maksimum Mean Standar.Deviasi
## 1 Age 18 63 40.106 10.7071
## 2 AnnualSalary 15000 152500 72689.000 34488.34194.4 Statistik Deskriptif Variabel Kategorik
stat_gender <- data %>%
count(Gender) %>%
mutate(
Persentase = sprintf(
"%.4f",
n / sum(n) * 100
)
)
stat_gender## Gender n Persentase
## 1 Female 516 51.6000
## 2 Male 484 48.40005. ALGORITMA K-NEAREST NEIGHBORS (K-NN)
5.1 Standarisasi Variabel Numerik
train_scaled <- train_data
test_scaled <- test_data
scaling_params <- preProcess(
train_data[, c("Age", "AnnualSalary")],
method = c("center", "scale")
)
train_scaled[, c("Age", "AnnualSalary")] <- predict(
scaling_params,
train_data[, c("Age", "AnnualSalary")]
)
test_scaled[, c("Age", "AnnualSalary")] <- predict(
scaling_params,
test_data[, c("Age", "AnnualSalary")]
)5.2 Mengubah Gender Menjadi Numerik
train_knn_x <- train_scaled %>%
select(-Purchased) %>%
mutate(
Gender = ifelse(Gender == "Male", 1, 0)
)
test_knn_x <- test_scaled %>%
select(-Purchased) %>%
mutate(
Gender = ifelse(Gender == "Male", 1, 0)
)
train_knn_y <- train_scaled$Purchased
test_knn_y <- test_scaled$Purchased5.3 Menjalankan Model K-NN
set.seed(42)
knn_pred <- knn(
train = train_knn_x,
test = test_knn_x,
cl = train_knn_y,
k = 5
)5.4 Evaluasi Model K-NN
cat(
"\n=================== EVALUASI K-NN (k = 5) ===================\n"
)##
## =================== EVALUASI K-NN (k = 5) ===================cm_knn <- confusionMatrix(
knn_pred,
test_knn_y,
positive = "1"
)
print(cm_knn)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 172 13
## 1 7 107
##
## Accuracy : 0.9331
## 95% CI : (0.8986, 0.9587)
## No Information Rate : 0.5987
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.8596
##
## Mcnemar's Test P-Value : 0.2636
##
## Sensitivity : 0.8917
## Specificity : 0.9609
## Pos Pred Value : 0.9386
## Neg Pred Value : 0.9297
## Prevalence : 0.4013
## Detection Rate : 0.3579
## Detection Prevalence : 0.3813
## Balanced Accuracy : 0.9263
##
## 'Positive' Class : 1
## 5.5 Visualisasi Hasil Klasifikasi K-NN
knn_plot <- data.frame(
Age = test_data$Age,
AnnualSalary = test_data$AnnualSalary,
Actual = test_knn_y,
Predicted = knn_pred
)
ggplot(
knn_plot,
aes(
x = Age,
y = AnnualSalary,
color = Predicted,
shape = Actual
)
) +
geom_point(
size = 2.5,
alpha = 0.7
) +
labs(
title = "Visualisasi Hasil Klasifikasi K-NN",
subtitle = "Data uji dengan k = 5",
x = "Age",
y = "Annual Salary",
color = "Prediksi",
shape = "Aktual"
) +
theme_minimal()
6. ALGORITMA DECISION TREE
set.seed(42)
dt_model <- rpart(
Purchased ~ .,
data = train_data,
method = "class",
control = rpart.control(
cp = 0.01,
minsplit = 20
)
)6.1 Visualisasi Pohon Keputusan
options(scipen = 999)
rpart.plot(
dt_model,
type = 4,
extra = 104,
under = TRUE,
faclen = 0,
digits = -2,
roundint = TRUE,
main = "Pohon Keputusan Prediksi Keputusan Pembelian Mobil",
box.palette = "RdYlGn",
shadow.col = "gray",
cex = 0.8
)
6.2 Menyimpan Pohon Keputusan dalam Format PNG
png(
"pohon_keputusan_hd.png",
width = 3000,
height = 2000,
res = 300
)
rpart.plot(
dt_model,
type = 4,
extra = 104,
under = TRUE,
faclen = 0,
digits = -2,
roundint = TRUE,
main = "Pohon Keputusan Prediksi Keputusan Pembelian Mobil",
box.palette = "RdYlGn",
shadow.col = "gray",
cex = 0.8
)
dev.off()## png
## 26.3 Prediksi Data Testing
dt_pred <- predict(
dt_model,
test_data,
type = "class"
)6.4 Evaluasi Decision Tree
cat(
"\n=================== EVALUASI DECISION TREE ===================\n"
)##
## =================== EVALUASI DECISION TREE ===================cm_dt <- confusionMatrix(
dt_pred,
test_data$Purchased,
positive = "1"
)
print(cm_dt)## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 168 13
## 1 11 107
##
## Accuracy : 0.9197
## 95% CI : (0.8829, 0.9479)
## No Information Rate : 0.5987
## P-Value [Acc > NIR] : <0.0000000000000002
##
## Kappa : 0.8325
##
## Mcnemar's Test P-Value : 0.8383
##
## Sensitivity : 0.8917
## Specificity : 0.9385
## Pos Pred Value : 0.9068
## Neg Pred Value : 0.9282
## Prevalence : 0.4013
## Detection Rate : 0.3579
## Detection Prevalence : 0.3946
## Balanced Accuracy : 0.9151
##
## 'Positive' Class : 1
## 7. PERBANDINGAN PERFORMA MODEL
summary_table <- data.frame(
Model = c(
"K-Nearest Neighbors (k=5)",
"Decision Tree"
),
Accuracy = round(
c(
cm_knn$overall["Accuracy"],
cm_dt$overall["Accuracy"]
),
4
),
Precision = round(
c(
cm_knn$byClass["Precision"],
cm_dt$byClass["Precision"]
),
4
),
Recall = round(
c(
cm_knn$byClass["Recall"],
cm_dt$byClass["Recall"]
),
4
),
F1_Score = round(
c(
cm_knn$byClass["F1"],
cm_dt$byClass["F1"]
),
4
)
)
cat(
"\n=================== TABEL PERBANDINGAN PERFORMA ===================\n"
)##
## =================== TABEL PERBANDINGAN PERFORMA ===================print(summary_table)## Model Accuracy Precision Recall F1_Score
## 1 K-Nearest Neighbors (k=5) 0.9331 0.9386 0.8917 0.9145
## 2 Decision Tree 0.9197 0.9068 0.8917 0.89928. EVALUASI MANUAL DECISION TREE
cm <- table(
Prediksi = dt_pred,
Aktual = test_data$Purchased
)
TP <- cm["1", "1"]
TN <- cm["0", "0"]
FP <- cm["1", "0"]
FN <- cm["0", "1"]
accuracy <- (TP + TN) / sum(cm)
precision <- TP / (TP + FP)
recall <- TP / (TP + FN)
f1_score <- 2 * (
precision * recall
) / (
precision + recall
)8.1 Output Evaluasi Manual Decision Tree
cat(
"==========================================================================\n",
" HASIL EVALUASI MODEL DECISION TREE \n",
"==========================================================================\n\n",
"CONFUSION MATRIX:\n",
"-----------------\n",
" Aktual\n",
"Prediksi Tidak Membeli Membeli\n",
" Tidak Membeli ", TN, " ", FN, "\n",
" Membeli ", FP, " ", TP, "\n\n",
"METRIK KINERJA MODEL:\n",
"---------------------\n",
"Accuracy : ", round(accuracy * 100, 2), " %\n",
"Precision : ", round(precision * 100, 2), " %\n",
"Recall : ", round(recall * 100, 2), " %\n",
"F1-Score : ", round(f1_score * 100, 2), " %\n\n",
"==========================================================================\n",
sep = ""
)## ==========================================================================
## HASIL EVALUASI MODEL DECISION TREE
## ==========================================================================
##
## CONFUSION MATRIX:
## -----------------
## Aktual
## Prediksi Tidak Membeli Membeli
## Tidak Membeli 168 13
## Membeli 11 107
##
## METRIK KINERJA MODEL:
## ---------------------
## Accuracy : 91.97 %
## Precision : 90.68 %
## Recall : 89.17 %
## F1-Score : 89.92 %
##
## ==========================================================================