Data yang digunakan di UTS ini adalah https://www.kaggle.com/code/farzadnekouei/heart-disease-prediction/input
#Load library
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.4.3
library(tidyverse)
## Warning: package 'tidyverse' was built under R version 4.4.3
## Warning: package 'tidyr' was built under R version 4.4.3
## Warning: package 'readr' was built under R version 4.4.3
## Warning: package 'purrr' was built under R version 4.4.3
## Warning: package 'dplyr' was built under R version 4.4.3
## Warning: package 'stringr' was built under R version 4.4.3
## Warning: package 'forcats' was built under R version 4.4.3
## Warning: package 'lubridate' was built under R version 4.4.3
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ lubridate 1.9.4 ✔ tibble 3.2.1
## ✔ purrr 1.0.4 ✔ tidyr 1.3.1
## ── 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 errors
library(dplyr)
library(reshape2)
## Warning: package 'reshape2' was built under R version 4.4.3
##
## Attaching package: 'reshape2'
##
## The following object is masked from 'package:tidyr':
##
## smiths
library(corrplot)
## Warning: package 'corrplot' was built under R version 4.4.3
## corrplot 0.95 loaded
#Load data
data_heart <- read.csv("C:/Users/LENOVO/Downloads/heart.csv")
#Cek struktur dan summary awal
str(data_heart)
## 'data.frame': 303 obs. of 14 variables:
## $ age : int 63 37 41 56 57 57 56 44 52 57 ...
## $ sex : int 1 1 0 1 0 1 0 1 1 1 ...
## $ cp : int 3 2 1 1 0 0 1 1 2 2 ...
## $ trestbps: int 145 130 130 120 120 140 140 120 172 150 ...
## $ chol : int 233 250 204 236 354 192 294 263 199 168 ...
## $ fbs : int 1 0 0 0 0 0 0 0 1 0 ...
## $ restecg : int 0 1 0 1 1 1 0 1 1 1 ...
## $ thalach : int 150 187 172 178 163 148 153 173 162 174 ...
## $ exang : int 0 0 0 0 1 0 0 0 0 0 ...
## $ oldpeak : num 2.3 3.5 1.4 0.8 0.6 0.4 1.3 0 0.5 1.6 ...
## $ slope : int 0 0 2 2 2 1 1 2 2 2 ...
## $ ca : int 0 0 0 0 0 0 0 0 0 0 ...
## $ thal : int 1 2 2 2 2 1 2 3 3 2 ...
## $ target : int 1 1 1 1 1 1 1 1 1 1 ...
summary(data_heart)
## age sex cp trestbps
## Min. :29.00 Min. :0.0000 Min. :0.000 Min. : 94.0
## 1st Qu.:47.50 1st Qu.:0.0000 1st Qu.:0.000 1st Qu.:120.0
## Median :55.00 Median :1.0000 Median :1.000 Median :130.0
## Mean :54.37 Mean :0.6832 Mean :0.967 Mean :131.6
## 3rd Qu.:61.00 3rd Qu.:1.0000 3rd Qu.:2.000 3rd Qu.:140.0
## Max. :77.00 Max. :1.0000 Max. :3.000 Max. :200.0
## chol fbs restecg thalach
## Min. :126.0 Min. :0.0000 Min. :0.0000 Min. : 71.0
## 1st Qu.:211.0 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:133.5
## Median :240.0 Median :0.0000 Median :1.0000 Median :153.0
## Mean :246.3 Mean :0.1485 Mean :0.5281 Mean :149.6
## 3rd Qu.:274.5 3rd Qu.:0.0000 3rd Qu.:1.0000 3rd Qu.:166.0
## Max. :564.0 Max. :1.0000 Max. :2.0000 Max. :202.0
## exang oldpeak slope ca
## Min. :0.0000 Min. :0.00 Min. :0.000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.00 1st Qu.:1.000 1st Qu.:0.0000
## Median :0.0000 Median :0.80 Median :1.000 Median :0.0000
## Mean :0.3267 Mean :1.04 Mean :1.399 Mean :0.7294
## 3rd Qu.:1.0000 3rd Qu.:1.60 3rd Qu.:2.000 3rd Qu.:1.0000
## Max. :1.0000 Max. :6.20 Max. :2.000 Max. :4.0000
## thal target
## Min. :0.000 Min. :0.0000
## 1st Qu.:2.000 1st Qu.:0.0000
## Median :2.000 Median :1.0000
## Mean :2.314 Mean :0.5446
## 3rd Qu.:3.000 3rd Qu.:1.0000
## Max. :3.000 Max. :1.0000
#Cek Missing Values
colSums(is.na(data_heart))
## age sex cp trestbps chol fbs restecg thalach
## 0 0 0 0 0 0 0 0
## exang oldpeak slope ca thal target
## 0 0 0 0 0 0
#Cek duplikat
duplicates <- duplicated(data_heart)
sum(duplicates)
## [1] 1
#Cek outlier (menggunakan IQR)
numeric_cols <- sapply(data_heart, is.numeric)
outlier_counts <- sapply(data_heart[, numeric_cols], function(x) {
Q1 <- quantile(x, 0.25)
Q3 <- quantile(x, 0.75)
IQR <- Q3 - Q1
sum(x < (Q1 - 1.5 * IQR) | x > (Q3 + 1.5 * IQR))
})
outlier_counts
## age sex cp trestbps chol fbs restecg thalach
## 0 0 0 9 5 45 0 1
## exang oldpeak slope ca thal target
## 0 5 0 25 2 0
Setelah melakukan pengecekkan didapatkannya 1 data duplikat, dan juga
berbagai macam outlier di:
1. trestbps : 9 Outlier
2. chol : 5 Outlier
3. fbs : 45 Outlier
4. thalach : 1 Outlier
5. oldpeak : 5 Outlier
6. ca : 25 Outlier
7. thal : 2 Outlier
Penanganan yang tepat untuk data ini adalah dengan melakukan penghapusan
data yang berduplikat.
#Hapus data duplikat
data_heart <- data_heart[!duplicates, ]
Berikut adalah Statistika Deskriptif setelah melakukan penghapusan data duplikat.
#Statistik Deskriptif
summary(data_heart[, numeric_cols])
## age sex cp trestbps
## Min. :29.00 Min. :0.0000 Min. :0.0000 Min. : 94.0
## 1st Qu.:48.00 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:120.0
## Median :55.50 Median :1.0000 Median :1.0000 Median :130.0
## Mean :54.42 Mean :0.6821 Mean :0.9636 Mean :131.6
## 3rd Qu.:61.00 3rd Qu.:1.0000 3rd Qu.:2.0000 3rd Qu.:140.0
## Max. :77.00 Max. :1.0000 Max. :3.0000 Max. :200.0
## chol fbs restecg thalach
## Min. :126.0 Min. :0.000 Min. :0.0000 Min. : 71.0
## 1st Qu.:211.0 1st Qu.:0.000 1st Qu.:0.0000 1st Qu.:133.2
## Median :240.5 Median :0.000 Median :1.0000 Median :152.5
## Mean :246.5 Mean :0.149 Mean :0.5265 Mean :149.6
## 3rd Qu.:274.8 3rd Qu.:0.000 3rd Qu.:1.0000 3rd Qu.:166.0
## Max. :564.0 Max. :1.000 Max. :2.0000 Max. :202.0
## exang oldpeak slope ca
## Min. :0.0000 Min. :0.000 Min. :0.000 Min. :0.0000
## 1st Qu.:0.0000 1st Qu.:0.000 1st Qu.:1.000 1st Qu.:0.0000
## Median :0.0000 Median :0.800 Median :1.000 Median :0.0000
## Mean :0.3278 Mean :1.043 Mean :1.397 Mean :0.7185
## 3rd Qu.:1.0000 3rd Qu.:1.600 3rd Qu.:2.000 3rd Qu.:1.0000
## Max. :1.0000 Max. :6.200 Max. :2.000 Max. :4.0000
## thal target
## Min. :0.000 Min. :0.000
## 1st Qu.:2.000 1st Qu.:0.000
## Median :2.000 Median :1.000
## Mean :2.315 Mean :0.543
## 3rd Qu.:3.000 3rd Qu.:1.000
## Max. :3.000 Max. :1.000
#Ubah fbs dan target menjadi faktor dengan label
data_heart$fbs <- factor(data_heart$fbs, labels = c("≤120 mg/dl", ">120 mg/dl"))
data_heart$target <- factor(data_heart$target, labels = c("Tidak", "Ya"))
#Buat tabel frekuensi
table_fbs_hd <- table(data_heart$fbs, data_heart$target)
#Tampilkan tabel
table_fbs_hd
##
## Tidak Ya
## ≤120 mg/dl 116 141
## >120 mg/dl 22 23
#Hitung proporsi
prop.table(table_fbs_hd, margin = 1)
##
## Tidak Ya
## ≤120 mg/dl 0.4513619 0.5486381
## >120 mg/dl 0.4888889 0.5111111
#Visualisasi
ggplot(data_heart, aes(x = fbs, fill = target)) +
geom_bar(position ="fill", color ="black") +
labs(title = "Proporsi Heart Disease berdasarkan Gula Darah",
x = "Fasting Blood Sugar",
y = "Proporsi",
fill = "Heart Disease") +
theme_minimal()
Dari grafik ini dapat disimpulkan bahwa kadar gula darah >120 mg/dl tidak menunjukkan dominasi jumlah kasus penyakit jantung, sehingga kadar gula darah puasa tidak dapat dianggap sebagai faktor utama yang secara langsung berhubungan dengan tingginya kejadian penyakit jantung dalam data ini.
#Ubah cp menjadi faktor dengan label
data_heart$cp <- factor(data_heart$cp,
levels = 0:3,
labels = c("Typical Angina", "Atypical Angina", "Non-anginal Pain", "Asymptomatic"))
#Filter data penderita heart disease
penderita_hd <- subset(data_heart, target == "Ya")
#Buat tabel frekuensi jenis nyeri dada
table_cp <- table(penderita_hd$cp)
#Visualisasi
ggplot(penderita_hd, aes(x = cp)) +
geom_bar(fill = "#Fe2445", color = "black") +
labs(title = "Jenis Nyeri Dada pada Penderita Heart Disease",
x = "Jenis Nyeri Dada",
y = "Jumlah") +
theme_minimal()
Berdasarkan hasil identifikasi terhadap variabel chest pain type (cp) pada pasien yang mengalami Heart Disease (target == 1), ditemukan bahwa jenis nyeri dada yang paling banyak dialami adalah tipe Asymptomatic. Hal ini berarti bahwa sebagian besar pasien jantung dalam dataset ini tidak menunjukkan gejala nyeri dada yang khas, atau bahkan tidak mengalami nyeri dada sama sekali.
#Ubah target menjadi faktor agar bisa dibedakan proporsinya
data_heart$target <- factor(data_heart$target, labels = c("Tidak", "Ya"))
#Plot 1: cp vs target
ggplot(data_heart, aes(x = factor(cp), fill = target)) +
geom_bar(position ="fill", color="black") +
scale_y_continuous(labels = scales::percent) +
labs(title = "Proporsi Heart Disease berdasarkan Jenis Nyeri Dada (cp)",
x = "Tipe Nyeri Dada (cp)", y = "Proporsi", fill = "Heart Disease") +
theme_minimal()
# Plot 2: ca vs target
ggplot(data_heart, aes(x = factor(ca), fill = target)) +
geom_bar(position ="fill", color="black") +
scale_y_continuous(labels = scales::percent) +
labs(title = "Proporsi Heart Disease berdasarkan Jumlah Pembuluh Darah (ca)",
x = "Jumlah Pembuluh Darah (ca)", y = "Proporsi", fill = "Heart Disease") +
theme_minimal()
# Plot 3: thal vs target
ggplot(data_heart, aes(x = factor(thal), fill = target)) +
geom_bar(position ="fill", color="black") +
scale_y_continuous(labels = scales::percent) +
labs(title = "Proporsi Heart Disease berdasarkan Kondisi Thalassemia (thal)",
x = "Tipe Thal (thal)", y = "Proporsi", fill = "Heart Disease") +
theme_minimal()
Untuk cp, tipe nyeri dada sangat berpengaruh terhadap risiko penyakit
jantung. Tipe Atypical Angina, Non-anginal Pain, dan bahkan Asymptomatic
menunjukkan proporsi penderita yang tinggi, sedangkan Typical Angina
justru didominasi oleh yang tidak menderita penyakit jantung.
Untuk ca, terdapat hubungan negatif antara jumlah pembuluh darah yang
terlihat (ca) dengan kemungkinan menderita penyakit jantung: semakin
banyak pembuluh darah yang terlihat, semakin kecil risiko penyakit
jantung. Namun nilai ca = 4 perlu diselidiki lebih lanjut karena
menunjukkan tren yang menyimpang.
Untuk thal, tipe thal = 2 adalah yang paling banyak berasosiasi dengan
penyakit jantung, diikuti oleh thal = 0. Sementara itu, tipe thal = 3
dan thal = 1 cenderung memiliki risiko lebih rendah. Tipe thal ini bisa
digunakan sebagai indikator tambahan dalam prediksi risiko penyakit
jantung.
#Melihat struktur data
str(data_heart)
## 'data.frame': 302 obs. of 14 variables:
## $ age : int 63 37 41 56 57 57 56 44 52 57 ...
## $ sex : Factor w/ 2 levels "Perempuan","Pria": 2 2 1 2 1 2 1 2 2 2 ...
## $ cp : Factor w/ 4 levels "Typical Angina",..: 4 3 2 2 1 1 2 2 3 3 ...
## $ trestbps: int 145 130 130 120 120 140 140 120 172 150 ...
## $ chol : int 233 250 204 236 354 192 294 263 199 168 ...
## $ fbs : Factor w/ 2 levels "≤120 mg/dl",">120 mg/dl": 2 1 1 1 1 1 1 1 2 1 ...
## $ restecg : int 0 1 0 1 1 1 0 1 1 1 ...
## $ thalach : int 150 187 172 178 163 148 153 173 162 174 ...
## $ exang : int 0 0 0 0 1 0 0 0 0 0 ...
## $ oldpeak : num 2.3 3.5 1.4 0.8 0.6 0.4 1.3 0 0.5 1.6 ...
## $ slope : int 0 0 2 2 2 1 1 2 2 2 ...
## $ ca : int 0 0 0 0 0 0 0 0 0 0 ...
## $ thal : int 1 2 2 2 2 1 2 3 3 2 ...
## $ target : Factor w/ 2 levels "Tidak","Ya": 2 2 2 2 2 2 2 2 2 2 ...
#Ubah variabel target menjadi factor (untuk membedakan penderita dan non-penderita)
data_heart$target <- factor(data_heart$target, labels = c("Tidak", "Ya"))
#Plot scatter plot dengan garis tren untuk melihat hubungan antara age dan thalach
ggplot(data_heart, aes(x = age, y = thalach, color = target)) +
geom_point(alpha = 0.6) +
geom_smooth(method = "lm", se = FALSE, linetype = "dashed") +
geom_smooth(method = "loess", se = FALSE, linetype = "solid") +
labs(title = "Hubungan Age dan Thalach berdasarkan Status Penyakit Jantung",
x = "Age",
y = "Thalach (Maximum Heart Rate)",
color = "Penyakit Jantung") +
theme_minimal()
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
Terdapat arah negatif antara usia dan thalach: semakin tua usia, cenderung semakin rendah detak jantung maksimum (thalach), terutama pada kelompok yang memiliki penyakit jantung. Garis non-linear (LOESS) terlihat lebih mengikuti pola data dibanding garis linear, terutama pada kelompok penderita penyakit jantung (Ya). Hal ini menunjukkan bahwa hubungan antara age dan thalach cenderung non-linear, karena terdapat pola lengkungan (tidak lurus) yang tidak bisa dijelaskan dengan regresi linear.
#Pilih hanya variabel numerik
numeric_vars <- data_heart %>% select_if(is.numeric)
#Hitung matriks korelasi
cor_matrix <- cor(numeric_vars, use = "complete.obs")
#Visualisasi heatmap korelasi
corrplot(cor_matrix, method = "color", type = "upper",
tl.col = "black", tl.srt = 45, addCoef.col = "black",
number.cex = 0.7, col = colorRampPalette(c("red", "white", "blue"))(200))
Beberapa variabel seperti thalach, oldpeak, cp, dan exang memiliki korelasi yang cukup kuat terhadap variabel target. Ini menandakan bahwa variabel-variabel tersebut penting untuk prediksi atau klasifikasi penyakit jantung.
#Input Data
data <- data.frame(
Konsumsi_GWh = c(10, 20, 30, 50, 70, 90, 40, 80, 120, 200, 300, 400,
15, 25, 35, 50, 70, 5, 10, 15, 20, 25, 30, 40),
Biaya_per_kWh = c(1500, 1450, 1400, 1350, 1300, 1250, 1300, 1250, 1200, 1150, 1100, 1050,
1600, 1550, 1500, 1450, 1400, 1700, 1600, 1550, 1500, 1450, 1400, 1350),
Konsumen = c(rep("Rumah Tangga", 6),
rep("Industri", 6),
rep("Kantor Pemerintah", 5),
rep("UMKM", 7))
)
#Visualisasi dengan ggplot2 dan scales
library(ggplot2)
library(scales)
##
## Attaching package: 'scales'
## The following object is masked from 'package:purrr':
##
## discard
## The following object is masked from 'package:readr':
##
## col_factor
ggplot(data, aes(x = Konsumsi_GWh, y = Biaya_per_kWh, color = Konsumen)) +
geom_point(size = 3) +
geom_smooth(method = "lm", se = FALSE) +
labs(
title = "Biaya Listrik per kWh Menurun Seiring Kenaikan Konsumsi",
x = "Total Konsumsi Listrik (GWh)",
y = "Biaya per kWh (Rupiah)",
caption = "Data simulasi untuk keperluan edukasi"
) +
scale_y_continuous(labels = label_number(suffix = " Rp", big.mark = ".", decimal.mark = ",")) +
scale_x_log10(
breaks = c(10, 30, 100, 300), # Atur titik X seperti contoh
labels = label_number(big.mark = ".", decimal.mark = ",")
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title.x = element_text(size = 12),
axis.title.y = element_text(size = 12),
plot.caption = element_text(hjust = 1, size = 8, face = "italic"),
legend.title = element_blank()
)
## `geom_smooth()` using formula = 'y ~ x'