UTS Pengantar Sains Dta A
Nurcahaya Omega
2025-04-21
Soal
- Pada data heart desease yang terdapat di link berikut :
Data : https://www.kaggle.com/code/farzadnekouei/heart-disease-prediction/input. Lakukan visualisasi yang efektif untuk menjawab pertanyaan berikut tuliskan informasi tentang variabel (pengertian dari variabel tersebut, skala data variabel), sintag, output yang dihasilkan serta interpretasi.
- Lakukan pengecekan apakah terdapat:
Nilai yang hilang (missing values)
Data yang tercatat ganda (duplicate records)
Nilai ekstrim (outlier) pada variabel numerik
Jika ada masalah tersebut, lakukan penanganan yang sesuai. Jelaskan mengapa menggunakan penanganan tersebut. Setelah pembersihan data, lakukan analisis statistika deskriptif untuk semua variabel numberik.
- Lakukan visualisasi untuk menunjukkan jenis kelamin apa yang paling banyak mengalami Heart desease, dan usia berapa yang paling banyak mengalami heart desease, dan usia berapa yang memiliki gula darah lebih besar dari 120 mg/dl.
- Lakukan analisis untuk mengetahui, apakah kadar gula darah seseorang yang lebih besar dari 120 paling banyak mengalami Heart desease?
- Lakukan identifikasi untuk mengetahui jenis nyeri dada yang paling banyak terjadi pada seseorang mengalami Heart desease
- Buat visualisasi Bar plot proporsi heart desease terhadap variabel kategorikal cp, ca, dan thal. Interpretasikan.
- Lakukan eksplorasi untuk mengetahui arah hubungan antara variabel age dan thalach yang dibedakan untuk seseorang yang memiliki penyakit jantung dan tidak. Apakah hubungan itu linear atau non-linear? Bagaimana cara mengetahuinya?
- Buat heatmap korelasi antar variabel yang berskala interval atau rasio kemudian interpretasukan hasil yang didapat
- Buat summary hasil analisis yang telah dilakukan. Menurut kalian apa apa saja hal-hal yang dapat mencegah penyakit jantung dan aspek apa saja yang merupakan indikasi penyakit jantung.
- Dari data berikut, Buat diagram yang sama dengan contoh. Serta jelaskan maksud setiap dari bagian sintag tersebut. Kemudian interpretasikan.
Jawaban
- Berikut adalah Data Dictionary (column description) :
- age : Age of the patient in years → Skala Rasio
- sex : Gender of the patient (0 = male, 1 = female) → Skala Nominal
- cp : Chest pain type:0 = Typical angina, 1 = Atypical angina, 2 = Non-anginal pain dan 3 = Asymptomatic → Skala Ordinal
- trestbps : Resting blood pressure in mm Hg → Skala Rasio
- chol : Serum cholesterol in mg/dl → Skala Rasio
- fbs: Fasting blood sugar level, categorized as above 120 mg/dl (1 = true, 0 = false) → Skala Nominal
- restecg : Resting electrocardiographic results:0: Normal, 1 = Having ST-T wave abnormality, 2 = Showing probable or definite left ventricular hypertrophy → Skala Nominal
- thalach : Maximum heart rate achieved during a stress test → Skala Rasio
- exang : Exercise-induced angina (1 = yes, 0 = no) → Skala Nominal
- oldpeak : ST depression induced by exercise relative to rest → Skala Rasio
- slope : Slope of the peak exercise ST segment:0 = Upsloping, 1 = Flat, 2 = Downsloping → Skala Ordinal
- ca : Number of major vessels (0-4) colored by fluoroscopy → Skala Rasio
- thal : Thalium stress test result:0 = Normal, 1 = Fixed defect, 2 = Reversible defect, 3 = Not described → Skala Nominal
- target Heart disease status (0 = no disease, 1 = presence of disease) → Skala Nominal
library(readxl)
Data1 <- read_excel("C:/Users/ASUS/Documents/SEMESTER 4/Pengantar Sains Data A/Uts psd/heart.xlxs.xlsx")
head(Data1)## # A tibble: 6 × 14
## age sex cp trestbps chol fbs restecg thalach exang oldpeak slope
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr> <dbl>
## 1 63 1 3 145 233 1 0 150 0 2.3 0
## 2 37 1 2 130 250 0 1 187 0 3.5 0
## 3 41 0 1 130 204 0 0 172 0 1.4 2
## 4 56 1 1 120 236 0 1 178 0 0.8 2
## 5 57 0 0 120 354 0 1 163 1 0.6 2
## 6 57 1 0 140 192 0 1 148 0 0.4 1
## # ℹ 3 more variables: ca <dbl>, thal <dbl>, target <dbl>- ✓ Nilai yang hilang (missing values)
colSums(is.na(Data1))## 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 0Diliat pada output di atas tiap variabel adalah 0 maka tidak ada nilai yang hilang(missing values) dan tidak perlu ada penanganan
✓ Data yang tercatat ganda (duplicate records)
sum(duplicated(Data1))## [1] 1Diliat pada output di atas tiap variabel adalah 1 maka Data yang tercatat ganda (duplicate records) adalah 1
Penanganan yang sesuai adalah dengan menghapus data yang tercatat ganda, berikut adalah penanngananya dengan menggunakan R
Data1 <- Data1[!duplicated(Data1), ]✓ Nilai ekstrim (outlier) pada variabel numerik
numeric_vars <- sapply(Data1, is.numeric)
numerics <- Data1[, numeric_vars]
detect_outliers <- function(x) {
Q1 <- quantile(x, 0.25, na.rm = TRUE)
Q3 <- quantile(x, 0.75, na.rm = TRUE)
IQR <- Q3 - Q1
outliers <- which(x < (Q1 - 1.5 * IQR) | x > (Q3 + 1.5 * IQR))
return(outliers)
}
sapply(names(numerics), function(col) {
length(detect_outliers(numerics[[col]]))
})## age sex cp trestbps chol fbs restecg thalach
## 0 0 0 9 5 45 0 1
## exang slope ca thal target
## 0 0 24 2 0Dapat diliat pada output di atas yang memiliki outlier adalah variabel trestbps = 9, chol = 5, fbs = 45, thalach = 1, ca = 25 dan thal = 2. Hal ini berarti harus dilakukan penanganan lanjut, penanganan yang sesuai adalah dengan penghapusan entri yang memiliki outlier. Berikut adalah penanngananya dengan menggunakan R :
all_outliers <- unique(unlist(lapply(numerics, detect_outliers)))
data_clean <- Data1[-all_outliers, ]
cat("Data awal:", nrow(Data1), "baris | Data bersih:", nrow(data_clean), "baris")## Data awal: 302 baris | Data bersih: 229 barissuppressMessages(library(dplyr))
suppressMessages(library(psych))
numeric_vars <- Data1 %>%
select(where(is.numeric))
desc_stats <- describe(numeric_vars)[, c("mean", "sd", "min", "max", "median", "skew")]
print(desc_stats)## mean sd min max median skew
## age 54.42 9.05 29 77 55.5 -0.20
## sex 0.68 0.47 0 1 1.0 -0.78
## cp 0.96 1.03 0 3 1.0 0.49
## trestbps 131.60 17.56 94 200 130.0 0.71
## chol 246.50 51.75 126 564 240.5 1.14
## fbs 0.15 0.36 0 1 0.0 1.96
## restecg 0.53 0.53 0 2 1.0 0.17
## thalach 149.57 22.90 71 202 152.5 -0.53
## exang 0.33 0.47 0 1 0.0 0.73
## slope 1.40 0.62 0 2 1.0 -0.50
## ca 0.72 1.01 0 4 0.0 1.28
## thal 2.31 0.61 0 3 2.0 -0.48
## target 0.54 0.50 0 1 1.0 -0.17- Visualisasi
- Jenis kelamin apa yang paling banyak mengalami Heart desease
suppressMessages(library(dplyr))
suppressMessages(library(ggplot2))
library(readxl)
Data1 <- read_excel("C:/Users/ASUS/Documents/SEMESTER 4/Pengantar Sains Data A/Uts psd/heart.xlxs.xlsx")
#Membuat label
Data1 <- Data1 %>%
mutate(sex_label = ifelse(sex == 0, "Male", "Female"))
# Presentasi
sex_heart_disease <- Data1 %>%
group_by(sex_label, target) %>%
summarise(count = n()) %>%
mutate(percentage = count / sum(count) * 100) %>%
filter(target == 1) ## `summarise()` has grouped output by 'sex_label'. You can override using the
## `.groups` argument.# Visualisasi
ggplot(sex_heart_disease, aes(x = sex_label, y = percentage, fill = sex_label)) +
geom_bar(stat = "identity") +
labs(
title = "Jenis Kelamin apa yang paling banyak
Mengalami Heart desease",
x = "Jenis Kelamin",
y = "Persentase (%)",
fill = "Jenis Kelamin"
) +
theme_minimal()
Dapat dilihat pada visualisasi diatas jenis kelamin apa yang paling banyak mengalami Heart desease adalah Male(Laki-laki)
- Usia Paling Banyak Mengalami Heart Desease
age_heart <- Data1 %>%
filter(target == 1) %>%
count(age) %>%
top_n(10, n)
# Visualisasi
ggplot(age_heart, aes(x = reorder(factor(age), n), y = n, fill = n)) +
geom_bar(stat = "identity", fill = "#88CCEE") +
geom_text(aes(label = n), hjust = -0.2, size = 3) +
labs(title = "Usia Paling Banyak Mengalami Heart Desease",
x = "Age",
y = "Jumlah Kasus") +
coord_flip() +
theme_minimal() +
theme(panel.grid.major.y = element_blank())
Jika diliat dari visualisasi di atas menunjukkn Age Paling Banyak Mengalami Heart Desease adalah usia 54 tahun.
- Usia yang memiliki gula darah lebih besar dari >120 mg/dl
# Jumlah usia dengan FBS >120 mg/dl
age_fbs <- Data1 %>%
filter(fbs == 1) %>%
count(age) %>%
arrange(desc(n))
# Visualisasi
ggplot(age_fbs, aes(x = factor(age), y = n, fill = factor(age))) +
geom_bar(stat = "identity") +
labs(
title = "Usia yang memiliki gula darah lebih besar dari >120 mg/dl.",
x = "Usia (Tahun)",
y = "Jumlah Kasus",
fill = "Usia"
) +
theme_minimal()
Jika diliat dari visualisasi di atas menunjukkn Usia yang memiliki gula darah lebih besar dari >120 mg/dl adalah usia 42, 43, 46, 51, 52, 53, 54, 56, 57, 58, 59, 60, 61, 62, 63, 65, 66, 67, 68, 69 dan 71. Pada visualisasi di atas juga menunjukkan usia paling banyak yang menunjukkn Usia yang memiliki gula darah lebih besar dari >120 mg/dl adalah usia 52 tahun.
- Kadar gula darah seseorang yang lebih besar dari 120 paling banyak mengalami Heart desease
suppressMessages(library(dplyr))
Data1 <- Data1 %>%
mutate(
fbs_label = case_when(
fbs == 0 ~ "≤120 mg/dL",
fbs == 1 ~ ">120 mg/dL",
TRUE ~ "Unknown"
),
heart_disease = ifelse(target == 1, "Yes", "No")
)
# tabel kontingensi
contingency_table <- table(
"Fasting Blood Sugar" = Data1$fbs_label,
"Heart Disease" = Data1$heart_disease
)
print(contingency_table)## Heart Disease
## Fasting Blood Sugar No Yes
## >120 mg/dL 22 23
## ≤120 mg/dL 116 142Dari hasil output di atas maka dapat disimpulkn jika Kadar gula darah seseorang yang >120 mengalami Heart desease tidak lebih banyak daripada Kadar gula darah seseorang yang ≤ 120 mengalami Heart desease
- Identifikasi jenis nyeri dada yang paling banyak terjadi pada seseorang mengalami Heart desease
suppressMessages(library(dplyr))
suppressMessages(library(ggplot2))
# kode cp jadi label
Data1 <- Data1 %>%
mutate(
cp_type = case_when(
cp == 0 ~ "Typical angina",
cp == 1 ~ "Atypical angina",
cp == 2 ~ "Non-anginal pain",
cp == 3 ~ "Asymptomatic",
TRUE ~ "Unknown"
),
heart_disease = ifelse(target == 1, "Yes", "No")
)
# Hitung distribusi jenis nyeri dada pada seseorang mengalami Heart desease
cp_distribution <- Data1 %>%
filter(heart_disease == "Yes") %>%
count(cp_type) %>%
mutate(
percentage = n / sum(n) * 100,
cp_type = factor(cp_type,
levels = c("Typical angina", "Atypical angina",
"Non-anginal pain", "Asymptomatic"))
)
print(cp_distribution)## # A tibble: 4 × 3
## cp_type n percentage
## <fct> <int> <dbl>
## 1 Asymptomatic 16 9.70
## 2 Atypical angina 41 24.8
## 3 Non-anginal pain 69 41.8
## 4 Typical angina 39 23.6Dari hasil output yang dihasilkan di atas menunjukkan bahwa jenis nyeri dada yang paling banyak terjadi pada seseorang mengalami Heart desease adalah Non-anginal pain yaitu 41.46%.
- Visualisasi Bar plot proporsi heart desease terhadap variabel kategorikal cp, ca, dan thal.
suppressMessages(library(ggplot2))
suppressMessages(library(dplyr))
library(readxl)
Data1 <- read_excel("C:/Users/ASUS/Documents/SEMESTER 4/Pengantar Sains Data A/Uts psd/heart.xlxs.xlsx")
Data1 <- Data1 %>%
mutate(
cp = factor(cp, levels = c(0, 1, 2, 3),
labels = c("Typical angina", "Atypical angina", "Non-anginal", "Asymptomatic")),
ca = factor(ca),
thal = factor(thal, levels = c(0, 1, 2, 3),
labels = c("Normal", "Fixed defect", "Reversible defect", "Not described")),
target = factor(target, levels = c(0, 1), labels = c("No Disease", "Disease"))
)#Proporsi heart desease dengan cp
ggplot(Data1, aes(x = cp, fill = target)) +
geom_bar(position = "fill") +
labs(
title = "Proporsi heart desease dengan cp",
x = "cp",
y = "Proporsi",
fill = "Status Penyakit"
) +
scale_fill_manual(values = c("No Disease" = "#1f77b4", "Disease" = "#ff7f0e")) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) 
Dari visualisasi di atas menunjukkan Proporsi heart desease dengan cp dengan Diesasi tertinggi pada cp Atypical angina dan terendah pada cp Typical angina, sedangkan No Diesasi tertinggi pada cp Typical angina dan terendah pada cp Atypical angina.
#Proporsi heart desease dengan ca
ggplot(Data1, aes(x = ca, fill = target)) +
geom_bar(position = "fill") +
labs(
title = "Proporsi heart desease dengan ca",
x = "ca",
y = "Proporsi"
) +
scale_fill_manual(values = c("No Disease" = "#1f77b4", "Disease" = "#ff7f0e")) +
theme_minimal()
Dari visualisasi di atas menunjukkan Proporsi heart desease dengan ca dengan Diesasi tertinggi pada cp 4 dan terendah pada ca 3, sedangkan No Diesasi tertinggi pada ca 3 dan terendah pada ca 4.
#Proporsi heart desease dengan thal
ggplot(Data1, aes(x = thal, fill = target)) +
geom_bar(position = "fill") +
labs(
title = "Proporsi heart desease dengan thal",
x = "thal",
y = "Proporsi"
) +
scale_fill_manual(values = c("No Disease" = "#1f77b4", "Disease" = "#ff7f0e")) +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Dari visualisasi di atas menunjukkan Proporsi heart desease dengan thal dengan Diesasi tertinggi pada thal Reversible defect dan terendah pada thal Not described, sedangkan No Diesasi tertinggi pada thal Not described dan terendah pada thal Reversible defect.
- Eksplorasi untuk mengetahui arah hubungan antara variabel age dan thalach yang dibedakan untuk seseorang yang memiliki penyakit jantung dan tidak
suppressMessages(library(ggplot2))
ggplot(Data1, aes(x = age, y = thalach, color = target)) +
geom_point(alpha = 0.5) +
geom_smooth(method = "loess", se = TRUE) +
labs(
title = "Hubungan Age vs Thalach Berdasarkan Status heart disease",
x = "age",
y = "thalach",
color = "heart disease"
) +
scale_color_manual(values = c("No Disease" = "blue", "Disease" = "red")) +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
Data1 %>%
group_by(target) %>%
summarise(
Correlation = cor(age, thalach, method = "pearson", use = "complete.obs")
)## # A tibble: 2 × 2
## target Correlation
## <fct> <dbl>
## 1 No Disease -0.133
## 2 Disease -0.526# Model linear
lm_linear <- lm(thalach ~ age, data = Data1)
# Model non-linear (polynomial degree 2)
lm_poly <- lm(thalach ~ poly(age, 2), data = Data1)
# Bandingkan R-squared
summary(lm_linear)$r.squared## [1] 0.1588197summary(lm_poly)$r.squared## [1] 0.1619489library(ggplot2)
ggplot(Data1, aes(x = age, y = thalach)) +
geom_point(alpha = 0.5) +
geom_smooth(method = "lm", color = "red", se = FALSE) +
geom_smooth(method = "lm", formula = y ~ poly(x, 2), color = "blue", se = FALSE) +
labs(
title = "Perbandingan Model Linear (Merah) vs Polynomial (Biru)",
subtitle = paste("Linear R² =", round(summary(lm_linear)$r.squared, 3),
" | Polynomial R² =", round(summary(lm_poly)$r.squared, 3)),
x = "age",
y = "thalach"
) +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
Untuk mengetahui apakah hubungan itu linear atau non-linear bisa dilihat dari output di atas, output di atas menunjukkan bawah garis merah dan biru hampir tumpang tindih yang berarti linier.
- Heatmap korelasi antar variabel yang berskala interval atau rasio
suppressMessages(library(ggplot2))
suppressMessages(library(dplyr))
suppressMessages(library(corrplot))
numeric_data <- Data1 %>%
select(where(is.numeric))
names(numeric_data)## [1] "age" "sex" "trestbps" "chol" "fbs" "restecg" "thalach"
## [8] "exang" "slope"cor_matrix <- cor(numeric_data, use = "complete.obs")
print(cor_matrix)## age sex trestbps chol fbs
## age 1.00000000 -0.09844660 0.27935091 0.213677957 0.121307648
## sex -0.09844660 1.00000000 -0.05676882 -0.197912174 0.045031789
## trestbps 0.27935091 -0.05676882 1.00000000 0.123174207 0.177530542
## chol 0.21367796 -0.19791217 0.12317421 1.000000000 0.013293602
## fbs 0.12130765 0.04503179 0.17753054 0.013293602 1.000000000
## restecg -0.11621090 -0.05819627 -0.11410279 -0.151040078 -0.084189054
## thalach -0.39852194 -0.04401991 -0.04669773 -0.009939839 -0.008567107
## exang 0.09680083 0.14166381 0.06761612 0.067022783 0.025665147
## slope -0.16881424 -0.03071057 -0.12147458 -0.004037770 -0.059894178
## restecg thalach exang slope
## age -0.11621090 -0.398521938 0.09680083 -0.16881424
## sex -0.05819627 -0.044019908 0.14166381 -0.03071057
## trestbps -0.11410279 -0.046697728 0.06761612 -0.12147458
## chol -0.15104008 -0.009939839 0.06702278 -0.00403777
## fbs -0.08418905 -0.008567107 0.02566515 -0.05989418
## restecg 1.00000000 0.044123444 -0.07073286 0.09304482
## thalach 0.04412344 1.000000000 -0.37881209 0.38678441
## exang -0.07073286 -0.378812094 1.00000000 -0.25774837
## slope 0.09304482 0.386784410 -0.25774837 1.00000000corrplot(cor_matrix,
method = "color",
type = "upper",
tl.col = "black",
addCoef.col = "black",
number.cex = 0.7)
Berdasarkan visualisasi di atas dapat disimpulkan bahwa variabel age menunjukkan korelasi negatif moderat dengan thalach (-0.40), maka dapat disimpulkan bahwa semakin tua usia seseorang, thalach maksimumnya cenderung menurun. Di sisi lain, thalach memiliki korelasi negatif moderat dengan exang (-0.38), yang berarti orang dengan thalach maksimum lebih tinggi cenderung tidak mengalami angina akibat exang. Korelasi positif moderat antara thalach dan slope (0.39) menunjukkan bahwa thalach maksimum yang lebih tinggi terkait dengan slope yang lebih curam selama aktivitas fisik. Sementara itu, variabel seperti trestbps dan chol menunjukkan korelasi yang sangat lemah dengan sebagian besar variabel lain (nilai absolut <0.20), menandakan bahwa trestbps dan chol tidak memiliki hubungan linier yang kuat dengan faktor-faktor lain dalam dataset ini. Secara keseluruhan, thalach muncul sebagai variabel yang paling berkorelasi dengan variabel lain, sementara kebanyakan hubungan lainnya tergolong lemah atau tidak signifikan.
- Summary hasil analisis
age memiliki korelasi negatif moderat dengan denyut thalach, menunjukkan penurunan kapasitas jantung seiring bertambahnya usia.
thalach berkorelasi negatif dengan angina akibat exang dan positif dengan slope, menunjukkan peran penting kebugaran kardiovaskular.
trestbps dan chol tidak menunjukkan korelasi kuat dengan variabel lain.
cp dan thal terbukti berpengaruh signifikan dalam analisis sebelumnya.
Hal yang dapat mencegah penyakit jantung :
- Hindari rokok
- Perbanyak aktifivas fisik seperti olahraga
- Jaga pola makan yang sehat
- Melakukan diet jika berat badan sudah lewat batas normal
Aspek indikasi penyakit jantung :
- Sesak nafas
- Nyeri dada
- Mudah lelah
- Pingsan atau pusing
- Keringat dingin
- Pembengkakan
- Membuat visualisasi Biaya Listrik per kWh Menurun Seiring Kenaikan Konsumsi
suppressMessages(library(ggplot2))
#Membuat data frame
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))
)
# Plot
ggplot(data, aes(x = Konsumsi_GWh, y = Biaya_per_kWh, color = Konsumen)) + #Menyusun kerangka plot
geom_point(size = 3) + #Menampilkan titik-titik data sebagai scatter plot
geom_smooth(method = "lm", se = FALSE) + #Ini menambahkan garis tren linear untuk masing-masing kelompok Konsumen
scale_y_continuous(labels = function(x) paste0(format(x, big.mark = ".", decimal.mark = ","), " Rp")) + #Ini mengatur label sumbu Y agar tampil sebagai format Rupiah
scale_x_continuous(trans = "log10") + #Untuk mengubah skala X ke logaritmik
labs(
title = "Biaya Listrik per kWh Menurun Seiring Kenaikan Konsumsi",
x = "Total Konsumsi Listrik (GWh)",
y = "Biaya per kWh (Rupiah)"
) + #Untuk memberi judul dan label
theme_minimal() + #Untuk mengatur gaya grafik ke tema yang tidak berlebihan
theme(
plot.title = element_text(size = 14, face = "bold"),
legend.title = element_text(face = "bold")
) #Untuk styling reks## `geom_smooth()` using formula = 'y ~ x'