TUBES DATMIN
ANITA 16231008
2025-11-23
Life_Expectancy_Data <- read_excel("C:/Users/USER/Downloads/Life Expectancy Data.xlsx")
str(Life_Expectancy_Data)## tibble [2,938 × 22] (S3: tbl_df/tbl/data.frame)
## $ Country : chr [1:2938] "Afghanistan" "Afghanistan" "Afghanistan" "Afghanistan" ...
## $ Year : num [1:2938] 2015 2014 2013 2012 2011 ...
## $ Status : chr [1:2938] "Developing" "Developing" "Developing" "Developing" ...
## $ Life expectancy : num [1:2938] 65 59.9 59.9 59.5 59.2 58.8 58.6 58.1 57.5 57.3 ...
## $ Adult Mortality : num [1:2938] 263 271 268 272 275 279 281 287 295 295 ...
## $ infant deaths : num [1:2938] 62 64 66 69 71 74 77 80 82 84 ...
## $ Alcohol : num [1:2938] 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.03 0.02 0.03 ...
## $ percentage expenditure : num [1:2938] 71.3 73.5 73.2 78.2 7.1 ...
## $ Hepatitis B : num [1:2938] 65 62 64 67 68 66 63 64 63 64 ...
## $ Measles : num [1:2938] 1154 492 430 2787 3013 ...
## $ BMI : num [1:2938] 19.1 18.6 18.1 17.6 17.2 16.7 16.2 15.7 15.2 14.7 ...
## $ under-five deaths : num [1:2938] 83 86 89 93 97 102 106 110 113 116 ...
## $ Polio : num [1:2938] 6 58 62 67 68 66 63 64 63 58 ...
## $ Total expenditure : num [1:2938] 8.16 8.18 8.13 8.52 7.87 9.2 9.42 8.33 6.73 7.43 ...
## $ Diphtheria : num [1:2938] 65 62 64 67 68 66 63 64 63 58 ...
## $ HIV/AIDS : num [1:2938] 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 ...
## $ GDP : num [1:2938] 584.3 612.7 631.7 670 63.5 ...
## $ Population : num [1:2938] 33736494 327582 31731688 3696958 2978599 ...
## $ thinness 1-19 years : num [1:2938] 17.2 17.5 17.7 17.9 18.2 18.4 18.6 18.8 19 19.2 ...
## $ thinness 5-9 years : num [1:2938] 17.3 17.5 17.7 18 18.2 18.4 18.7 18.9 19.1 19.3 ...
## $ Income composition of resources: num [1:2938] 0.479 0.476 0.47 0.463 0.454 0.448 0.434 0.433 0.415 0.405 ...
## $ Schooling : num [1:2938] 10.1 10 9.9 9.8 9.5 9.2 8.9 8.7 8.4 8.1 ...View(Life_Expectancy_Data)Dataset Life Expectancy dari WHO yang tersedia di Kaggle merupakan kumpulan data yang memuat informasi kesehatan, ekonomi, dan demografi dari berbagai negara pada tahun 2000–2015. Sumber utama dataset ini adalah World Health Organization (WHO) dan United Nations. Dataset ini terdiri dari 22 variabel yang mencakup indikator harapan hidup, angka kematian dewasa, kematian bayi, imunisasi, prevalensi penyakit, kondisi gizi, pendidikan, pengeluaran kesehatan, hingga GDP setiap negara. Setiap baris data merepresentasikan suatu negara pada tahun tertentu sehingga dataset ini dapat digunakan untuk mempelajari perkembangan kesehatan global dari waktu ke waktu.
describe(Life_Expectancy_Data)## vars n mean sd median
## Country* 1 2938 96.10 56.24 94.00
## Year 2 2938 2007.52 4.61 2008.00
## Status* 3 2938 1.83 0.38 2.00
## Life expectancy 4 2928 69.22 9.52 72.10
## Adult Mortality 5 2928 164.80 124.29 144.00
## infant deaths 6 2938 30.30 117.93 3.00
## Alcohol 7 2744 4.60 4.05 3.76
## percentage expenditure 8 2938 738.25 1987.91 64.91
## Hepatitis B 9 2385 80.94 25.07 92.00
## Measles 10 2938 2419.59 11467.27 17.00
## BMI 11 2904 38.32 20.04 43.50
## under-five deaths 12 2938 42.04 160.45 4.00
## Polio 13 2919 82.55 23.43 93.00
## Total expenditure 14 2712 5.94 2.50 5.76
## Diphtheria 15 2919 82.32 23.72 93.00
## HIV/AIDS 16 2938 1.74 5.08 0.10
## GDP 17 2490 7483.16 14270.17 1766.95
## Population 18 2286 12753375.12 61012096.51 1386542.00
## thinness 1-19 years 19 2904 4.84 4.42 3.30
## thinness 5-9 years 20 2904 4.87 4.51 3.30
## Income composition of resources 21 2771 0.63 0.21 0.68
## Schooling 22 2775 11.99 3.36 12.30
## trimmed mad min max
## Country* 95.90 72.65 1.00 1.930000e+02
## Year 2007.52 5.93 2000.00 2.015000e+03
## Status* 1.91 0.00 1.00 2.000000e+00
## Life expectancy 69.91 8.60 36.30 8.900000e+01
## Adult Mortality 150.51 112.68 1.00 7.230000e+02
## infant deaths 10.20 4.45 0.00 1.800000e+03
## Alcohol 4.23 4.81 0.01 1.787000e+01
## percentage expenditure 230.74 96.24 0.00 1.947991e+04
## Hepatitis B 86.89 8.90 1.00 9.900000e+01
## Measles 286.08 25.20 0.00 2.121830e+05
## BMI 39.05 24.17 1.00 8.730000e+01
## under-five deaths 14.15 5.93 0.00 2.500000e+03
## Polio 88.05 8.90 3.00 9.900000e+01
## Total expenditure 5.85 2.36 0.37 1.760000e+01
## Diphtheria 87.99 8.90 2.00 9.900000e+01
## HIV/AIDS 0.54 0.00 0.10 5.060000e+01
## GDP 3751.73 2360.98 1.68 1.191727e+05
## Population 3953693.58 2012347.06 34.00 1.293859e+09
## thinness 1-19 years 4.14 3.41 0.10 2.770000e+01
## thinness 5-9 years 4.15 3.41 0.10 2.860000e+01
## Income composition of resources 0.65 0.19 0.00 9.500000e-01
## Schooling 12.17 3.11 0.00 2.070000e+01
## range skew kurtosis se
## Country* 1.920000e+02 0.03 -1.22 1.04
## Year 1.500000e+01 -0.01 -1.21 0.09
## Status* 1.000000e+00 -1.72 0.95 0.01
## Life expectancy 5.270000e+01 -0.64 -0.24 0.18
## Adult Mortality 7.220000e+02 1.17 1.74 2.30
## infant deaths 1.800000e+03 9.78 115.76 2.18
## Alcohol 1.786000e+01 0.59 -0.81 0.08
## percentage expenditure 1.947991e+04 4.65 26.51 36.68
## Hepatitis B 9.800000e+01 -1.93 2.76 0.51
## Measles 2.121830e+05 9.43 114.58 211.56
## BMI 8.630000e+01 -0.22 -1.29 0.37
## under-five deaths 2.500000e+03 9.49 109.49 2.96
## Polio 9.600000e+01 -2.10 3.76 0.43
## Total expenditure 1.723000e+01 0.62 1.15 0.05
## Diphtheria 9.700000e+01 -2.07 3.55 0.44
## HIV/AIDS 5.050000e+01 5.39 34.80 0.09
## GDP 1.191711e+05 3.20 12.29 285.98
## Population 1.293859e+09 15.90 297.09 1276079.80
## thinness 1-19 years 2.760000e+01 1.71 3.96 0.08
## thinness 5-9 years 2.850000e+01 1.78 4.34 0.08
## Income composition of resources 9.500000e-01 -1.14 1.38 0.00
## Schooling 2.070000e+01 -0.60 0.88 0.06Statistika deskriptif menunjukkan bahwa variabel-variabel dalam dataset memiliki rentang nilai yang sangat beragam, terutama pada indikator kesehatan seperti kematian bayi, kematian balita, measles, GDP, dan populasi yang memiliki sebaran sangat lebar. Variabel harapan hidup memiliki rata-rata 69 tahun dengan variasi cukup tinggi, menandakan perbedaan kondisi kesehatan antar negara. Variabel imunisasi (Polio, DPT, Hepatitis B) rata-rata tinggi tetapi memiliki nilai minimum rendah, sehingga dapat menjadi pembeda kuat antara negara dengan kesehatan baik dan buruk. Demikian pula indikator sosial ekonomi seperti GDP, schooling, dan income composition menunjukkan ketimpangan besar. Variasi tinggi ini membuat variabel-variabel tersebut sangat potensial sebagai prediktor dalam model klasifikasi, karena mampu membantu membedakan kategori negara berdasarkan tingkat harapan hidup atau kelompok kesehatan lainnya.
colSums(is.na(Life_Expectancy_Data))## Country Year
## 0 0
## Status Life expectancy
## 0 10
## Adult Mortality infant deaths
## 10 0
## Alcohol percentage expenditure
## 194 0
## Hepatitis B Measles
## 553 0
## BMI under-five deaths
## 34 0
## Polio Total expenditure
## 19 226
## Diphtheria HIV/AIDS
## 19 0
## GDP Population
## 448 652
## thinness 1-19 years thinness 5-9 years
## 34 34
## Income composition of resources Schooling
## 167 163sum(is.na(Life_Expectancy_Data))## [1] 2563names(Life_Expectancy_Data)[colSums(is.na(Life_Expectancy_Data)) > 0]## [1] "Life expectancy" "Adult Mortality"
## [3] "Alcohol" "Hepatitis B"
## [5] "BMI" "Polio"
## [7] "Total expenditure" "Diphtheria"
## [9] "GDP" "Population"
## [11] "thinness 1-19 years" "thinness 5-9 years"
## [13] "Income composition of resources" "Schooling"Hasil pengecekan missing value menunjukkan beberapa variabel memiliki jumlah hilang cukup besar, terutama Hepatitis B (553), GDP (448), Population (652), Total expenditure (226), dan beberapa variabel gizi. Oleh karena itu, tahap pembersihan data perlu dilakukan, baik dengan imputasi atau menghapus variabel yang terlalu banyak missing.
Life_Expectancy_Clean <- na.omit(Life_Expectancy_Data)
sum(is.na(Life_Expectancy_Clean))## [1] 0Karena jumlah missing cukup signifikan, saya melakukan pembersihan data dengan na.omit(), dan hasil akhir menunjukkan 0 missing value. Artinya, dataset Life_Expectancy_Clean sudah siap digunakan untuk klasifikasi tanpa nilai kosong.
Jumlah data setelah pembersihan adalah 2563 observasi, dan variabel predictor yang tersisa meliputi 14 variabel seperti Life expectancy, Adult Mortality, Alcohol, Polio, GDP, Schooling, dll.
data_num <- Life_Expectancy_Clean %>% select_if(is.numeric)
detect_outlier <- function(x) {
Q1 <- quantile(x, 0.25, na.rm = TRUE)
Q3 <- quantile(x, 0.75, na.rm = TRUE)
IQR <- Q3 - Q1
lower <- Q1 - 1.5 * IQR
upper <- Q3 + 1.5 * IQR
return(which(x < lower | x > upper))
}
outlier_before <- sapply(data_num, function(x) length(detect_outlier(x)))
cat("Jumlah outlier sebelum pembersihan:\n")## Jumlah outlier sebelum pembersihan:print(outlier_before)## Year Life expectancy
## 0 39
## Adult Mortality infant deaths
## 54 199
## Alcohol percentage expenditure
## 2 187
## Hepatitis B Measles
## 165 297
## BMI under-five deaths
## 0 222
## Polio Total expenditure
## 142 7
## Diphtheria HIV/AIDS
## 134 299
## GDP Population
## 208 233
## thinness 1-19 years thinness 5-9 years
## 77 78
## Income composition of resources Schooling
## 48 16data_long_before <- data_num %>%
pivot_longer(cols = everything(), names_to = "Variabel", values_to = "Nilai")
ggplot(data_long_before, aes(x = "", y = Nilai)) +
geom_boxplot(fill = "skyblue", color = "darkblue", outlier.color = "red", outlier.size = 1) +
facet_wrap(~ Variabel, scales = "free", ncol = 4) +
theme_minimal(base_size = 11) +
theme(
strip.text = element_text(face = "bold"),
axis.text.x = element_blank(),
axis.ticks.x = element_blank()
) +
labs(title = "Boxplot Sebelum Pembersihan Outlier", x = NULL, y = "Nilai")
“Boxplot menunjukkan bahwa hampir semua variabel, seperti Adult
Mortality dengan nilai ekstrem di atas 600, infant deaths
dan under-five deaths yang mencapai lebih dari 1500,
Measles yang memiliki outlier hingga ratusan ribu, serta
GDP dan Population dengan nilai sangat besar, memiliki
outlier dalam jumlah banyak dan distribusi menceng ke kanan, sedangkan
variabel seperti Life expectancy (50–80), BMI (20–60),
dan Schooling (8–15) relatif lebih stabil dengan sedikit
outlier, sehingga keseluruhan data menunjukkan ketimpangan nilai yang
tinggi antar negara dan memerlukan pembersihan outlier sebelum analisis
lanjutan.”
replace_outlier <- function(x) {
Q1 <- quantile(x, 0.25, na.rm = TRUE)
Q3 <- quantile(x, 0.75, na.rm = TRUE)
IQR <- Q3 - Q1
lower <- Q1 - 1.5 * IQR
upper <- Q3 + 1.5 * IQR
x[x < lower | x > upper] <- median(x, na.rm = TRUE)
return(x)
}
data_num_clean <- as.data.frame(lapply(data_num, replace_outlier))
outlier_after <- sapply(data_num_clean, function(x) length(detect_outlier(x)))
cat("\nJumlah outlier setelah pembersihan:\n")##
## Jumlah outlier setelah pembersihan:print(outlier_after)## Year Life.expectancy
## 0 20
## Adult.Mortality infant.deaths
## 21 258
## Alcohol percentage.expenditure
## 0 131
## Hepatitis.B Measles
## 113 297
## BMI under.five.deaths
## 0 246
## Polio Total.expenditure
## 59 0
## Diphtheria HIV.AIDS
## 85 386
## GDP Population
## 81 205
## thinness..1.19.years thinness.5.9.years
## 19 19
## Income.composition.of.resources Schooling
## 0 8data_long_after <- data_num_clean %>%
pivot_longer(cols = everything(), names_to = "Variabel", values_to = "Nilai")
ggplot(data_long_after, aes(x = "", y = Nilai)) +
geom_boxplot(fill = "lightgreen", color = "darkgreen", outlier.color = "red", outlier.size = 1) +
facet_wrap(~ Variabel, scales = "free", ncol = 4) +
theme_minimal(base_size = 11) +
theme(
strip.text = element_text(face = "bold"),
axis.text.x = element_blank(),
axis.ticks.x = element_blank()
) +
labs(title = "Boxplot Setelah Pembersihan Outlier", x = NULL, y = "Nilai")
Setelah pembersihan outlier, persebaran nilai pada hampir semua variabel
menjadi jauh lebih rapat dan stabil, misalnya Adult Mortality kini
berada pada kisaran sekitar 0–300, infant deaths dan under-five deaths
turun menjadi sekitar 0–50, Measles berada pada rentang 0–750, GDP
menyempit pada kisaran 0–10.000, Population berada di bawah 1.5×10⁷,
serta variabel lain seperti Life expectancy (50–85), BMI (20–60),
Schooling (8–15), dan imunisasi (70–100) menunjukkan distribusi lebih
konsisten sehingga dataset menjadi lebih bersih, tidak terlalu menceng,
dan lebih siap digunakan untuk analisis lanjutan
clean_outlier_iterative <- function(x, max_iter = 5) {
for (i in 1:max_iter) {
Q1 <- quantile(x, 0.25, na.rm = TRUE)
Q3 <- quantile(x, 0.75, na.rm = TRUE)
IQR <- Q3 - Q1
lower <- Q1 - 1.5 * IQR
upper <- Q3 + 1.5 * IQR
outliers <- which(x < lower | x > upper)
if (length(outliers) == 0) break
x[outliers] <- median(x, na.rm = TRUE)
}
return(x)
}
data_num_clean <- as.data.frame(lapply(data_num, clean_outlier_iterative))
outlier_after <- sapply(data_num_clean, function(x) length(detect_outlier(x)))
cat("Jumlah outlier setelah ditangani:\n")## Jumlah outlier setelah ditangani:print(outlier_after)## Year Life.expectancy
## 0 0
## Adult.Mortality infant.deaths
## 0 0
## Alcohol percentage.expenditure
## 0 0
## Hepatitis.B Measles
## 0 0
## BMI under.five.deaths
## 0 0
## Polio Total.expenditure
## 68 0
## Diphtheria HIV.AIDS
## 92 0
## GDP Population
## 0 0
## thinness..1.19.years thinness.5.9.years
## 0 0
## Income.composition.of.resources Schooling
## 0 0data_long_after <- data_num_clean %>%
pivot_longer(cols = everything(), names_to = "Variabel", values_to = "Nilai")
ggplot(data_long_after, aes(x = "", y = Nilai)) +
geom_boxplot(fill = "lightgreen", color = "darkgreen", outlier.color = "red", outlier.size = 1) +
facet_wrap(~ Variabel, scales = "free", ncol = 4) +
theme_minimal(base_size = 11) +
theme(
strip.text = element_text(face = "bold"),
axis.text.x = element_blank(),
axis.ticks.x = element_blank()
) +
labs(title = "Boxplot Setelah Pembersihan Outlier", y = "Nilai")
Boxplot setelah penanganan outlier tahap 2 menunjukkan bahwa seluruh
variabel kini memiliki persebaran yang jauh lebih rapat dan stabil,
seperti Adult Mortality yang berada pada kisaran 0–350, Alcohol sekitar
0–15, BMI sekitar 20–60, GDP menyempit pada rentang 0–3000, infant
deaths hanya 0–6, Measles pada kisaran 0–30, Population di bawah 3×10⁶,
Life expectancy sekitar 55–85, serta variabel lain seperti Schooling,
Total expenditure, HIV/AIDS, dan imunisasi yang tampil lebih homogen,
sehingga dataset menjadi bersih dari nilai ekstrem dan siap digunakan
untuk analisis lanjutan
cat_cols <- sapply(Life_Expectancy_Clean, is.character)
cat_cols <- names(Life_Expectancy_Clean)[cat_cols]
cat("Kolom kategorikal yang ditemukan:\n")## Kolom kategorikal yang ditemukan:print(cat_cols)## [1] "Country" "Status"for (col in cat_cols) {
unique_vals <- unique(Life_Expectancy_Clean[[col]])
if (length(unique_vals) == 2) {
Life_Expectancy_Clean[[col]] <- as.numeric(as.factor(Life_Expectancy_Clean[[col]])) - 1
} else {
cat(paste("Kolom", col, "memiliki lebih dari 2 kategori, perlu one-hot encoding.\n"))
}
}## Kolom Country memiliki lebih dari 2 kategori, perlu one-hot encoding.str(Life_Expectancy_Clean)## tibble [1,649 × 22] (S3: tbl_df/tbl/data.frame)
## $ Country : chr [1:1649] "Afghanistan" "Afghanistan" "Afghanistan" "Afghanistan" ...
## $ Year : num [1:1649] 2015 2014 2013 2012 2011 ...
## $ Status : num [1:1649] 1 1 1 1 1 1 1 1 1 1 ...
## $ Life expectancy : num [1:1649] 65 59.9 59.9 59.5 59.2 58.8 58.6 58.1 57.5 57.3 ...
## $ Adult Mortality : num [1:1649] 263 271 268 272 275 279 281 287 295 295 ...
## $ infant deaths : num [1:1649] 62 64 66 69 71 74 77 80 82 84 ...
## $ Alcohol : num [1:1649] 0.01 0.01 0.01 0.01 0.01 0.01 0.01 0.03 0.02 0.03 ...
## $ percentage expenditure : num [1:1649] 71.3 73.5 73.2 78.2 7.1 ...
## $ Hepatitis B : num [1:1649] 65 62 64 67 68 66 63 64 63 64 ...
## $ Measles : num [1:1649] 1154 492 430 2787 3013 ...
## $ BMI : num [1:1649] 19.1 18.6 18.1 17.6 17.2 16.7 16.2 15.7 15.2 14.7 ...
## $ under-five deaths : num [1:1649] 83 86 89 93 97 102 106 110 113 116 ...
## $ Polio : num [1:1649] 6 58 62 67 68 66 63 64 63 58 ...
## $ Total expenditure : num [1:1649] 8.16 8.18 8.13 8.52 7.87 9.2 9.42 8.33 6.73 7.43 ...
## $ Diphtheria : num [1:1649] 65 62 64 67 68 66 63 64 63 58 ...
## $ HIV/AIDS : num [1:1649] 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 0.1 ...
## $ GDP : num [1:1649] 584.3 612.7 631.7 670 63.5 ...
## $ Population : num [1:1649] 33736494 327582 31731688 3696958 2978599 ...
## $ thinness 1-19 years : num [1:1649] 17.2 17.5 17.7 17.9 18.2 18.4 18.6 18.8 19 19.2 ...
## $ thinness 5-9 years : num [1:1649] 17.3 17.5 17.7 18 18.2 18.4 18.7 18.9 19.1 19.3 ...
## $ Income composition of resources: num [1:1649] 0.479 0.476 0.47 0.463 0.454 0.448 0.434 0.433 0.415 0.405 ...
## $ Schooling : num [1:1649] 10.1 10 9.9 9.8 9.5 9.2 8.9 8.7 8.4 8.1 ...
## - attr(*, "na.action")= 'omit' Named int [1:1289] 33 45 46 47 48 49 58 59 60 61 ...
## ..- attr(*, "names")= chr [1:1289] "33" "45" "46" "47" ...View(Life_Expectancy_Clean)numeric_cols <- sapply(Life_Expectancy_Clean, is.numeric)
numeric_cols["Year"] <- FALSE
numeric_cols["Status"] <- FALSE
Life_Expectancy_Normalized <- as.data.frame(
lapply(Life_Expectancy_Clean[, numeric_cols], function(x) {
(x - min(x, na.rm = TRUE)) / (max(x, na.rm = TRUE) - min(x, na.rm = TRUE))
})
)
Life_Expectancy_Normalized <- cbind(
Life_Expectancy_Clean[, !numeric_cols],
Life_Expectancy_Normalized
)
str(Life_Expectancy_Normalized)## 'data.frame': 1649 obs. of 22 variables:
## $ Country : chr "Afghanistan" "Afghanistan" "Afghanistan" "Afghanistan" ...
## $ Year : num 2015 2014 2013 2012 2011 ...
## $ Status : num 1 1 1 1 1 1 1 1 1 1 ...
## $ Life.expectancy : num 0.467 0.353 0.353 0.344 0.338 ...
## $ Adult.Mortality : num 0.363 0.374 0.37 0.375 0.38 ...
## $ infant.deaths : num 0.0387 0.04 0.0413 0.0431 0.0444 ...
## $ Alcohol : num 0 0 0 0 0 ...
## $ percentage.expenditure : num 0.003759 0.003878 0.003861 0.004123 0.000374 ...
## $ Hepatitis.B : num 0.649 0.619 0.639 0.67 0.68 ...
## $ Measles : num 0.00878 0.00374 0.00327 0.0212 0.02292 ...
## $ BMI : num 0.228 0.221 0.214 0.208 0.202 ...
## $ under.five.deaths : num 0.0395 0.041 0.0424 0.0443 0.0462 ...
## $ Polio : num 0.0312 0.5729 0.6146 0.6667 0.6771 ...
## $ Total.expenditure : num 0.544 0.545 0.541 0.57 0.522 ...
## $ Diphtheria : num 0.649 0.619 0.639 0.67 0.68 ...
## $ HIV.AIDS : num 0 0 0 0 0 0 0 0 0 0 ...
## $ GDP : num 0.004889 0.005127 0.005287 0.005608 0.000519 ...
## $ Population : num 0.026074 0.000253 0.024525 0.002857 0.002302 ...
## $ thinness..1.19.years : num 0.631 0.642 0.649 0.657 0.668 ...
## $ thinness.5.9.years : num 0.612 0.619 0.626 0.637 0.644 ...
## $ Income.composition.of.resources: num 0.512 0.509 0.502 0.495 0.485 ...
## $ Schooling : num 0.358 0.352 0.345 0.339 0.321 ...View(Life_Expectancy_Normalized)data_final <- Life_Expectancy_Normalized
names(data_final)## [1] "Country" "Year"
## [3] "Status" "Life.expectancy"
## [5] "Adult.Mortality" "infant.deaths"
## [7] "Alcohol" "percentage.expenditure"
## [9] "Hepatitis.B" "Measles"
## [11] "BMI" "under.five.deaths"
## [13] "Polio" "Total.expenditure"
## [15] "Diphtheria" "HIV.AIDS"
## [17] "GDP" "Population"
## [19] "thinness..1.19.years" "thinness.5.9.years"
## [21] "Income.composition.of.resources" "Schooling"data_final <- Life_Expectancy_Normalized # data sudah normalisasi
target <- "Life.expectancy"
predictors <- setdiff(names(data_final), c("Country", "Year", target))
set.seed(123)
train_index <- sample(1:nrow(data_final), 0.8 * nrow(data_final))
data_train <- data_final[train_index, ]
data_test <- data_final[-train_index, ]
x_train <- data_train[, predictors, drop=FALSE]
y_train <- data_train[[target]]
x_test <- data_test[, predictors, drop=FALSE]
y_test <- data_test[[target]]
cat("Jumlah data training:", nrow(data_train), "\n")## Jumlah data training: 1319cat("Jumlah data testing:", nrow(data_test), "\n")## Jumlah data testing: 330# Response variable
response <- "Life.expectancy"
# Data utama yang dipakai VIF, PCA, Ridge, LASSO
df <- data_train # atau gunakan data_final kalau mau full data
# Pastikan predictors benar
predictors <- setdiff(names(df), c("Country", "Year", response))formula_vif <- as.formula(
paste("Life.expectancy ~", paste(predictors, collapse = " + "))
)
# Fit model regresi linear
model_vif <- lm(formula_vif, data = data_train)
# Hitung VIF
vif_values <- vif(model_vif)
cat("=== HASIL VIF ===\n")## === HASIL VIF ===print(vif_values)## Status Adult.Mortality
## 1.806313 1.808198
## infant.deaths Alcohol
## 245.900128 2.256621
## percentage.expenditure Hepatitis.B
## 14.287615 1.667816
## Measles BMI
## 1.539020 1.821104
## under.five.deaths Polio
## 234.891128 1.727204
## Total.expenditure Diphtheria
## 1.119102 2.142147
## HIV.AIDS GDP
## 1.473217 14.884693
## Population thinness..1.19.years
## 2.057050 6.890268
## thinness.5.9.years Income.composition.of.resources
## 6.932188 2.872390
## Schooling
## 3.399901# Interpretasi otomatis
cat("\n=== INTERPRETASI OTOMATIS ===\n")##
## === INTERPRETASI OTOMATIS ===for (i in 1:length(vif_values)) {
if (vif_values[i] < 5) {
cat(names(vif_values)[i], ": Tidak ada indikasi multikolinearitas (VIF < 5)\n")
} else if (vif_values[i] >= 5 & vif_values[i] < 10) {
cat(names(vif_values)[i], ": Ada indikasi multikolinearitas sedang (5 ≤ VIF < 10)\n")
} else {
cat(names(vif_values)[i], ": Multikolinearitas tinggi (VIF ≥ 10)\n")
}
} ## Status : Tidak ada indikasi multikolinearitas (VIF < 5)
## Adult.Mortality : Tidak ada indikasi multikolinearitas (VIF < 5)
## infant.deaths : Multikolinearitas tinggi (VIF ≥ 10)
## Alcohol : Tidak ada indikasi multikolinearitas (VIF < 5)
## percentage.expenditure : Multikolinearitas tinggi (VIF ≥ 10)
## Hepatitis.B : Tidak ada indikasi multikolinearitas (VIF < 5)
## Measles : Tidak ada indikasi multikolinearitas (VIF < 5)
## BMI : Tidak ada indikasi multikolinearitas (VIF < 5)
## under.five.deaths : Multikolinearitas tinggi (VIF ≥ 10)
## Polio : Tidak ada indikasi multikolinearitas (VIF < 5)
## Total.expenditure : Tidak ada indikasi multikolinearitas (VIF < 5)
## Diphtheria : Tidak ada indikasi multikolinearitas (VIF < 5)
## HIV.AIDS : Tidak ada indikasi multikolinearitas (VIF < 5)
## GDP : Multikolinearitas tinggi (VIF ≥ 10)
## Population : Tidak ada indikasi multikolinearitas (VIF < 5)
## thinness..1.19.years : Ada indikasi multikolinearitas sedang (5 ≤ VIF < 10)
## thinness.5.9.years : Ada indikasi multikolinearitas sedang (5 ≤ VIF < 10)
## Income.composition.of.resources : Tidak ada indikasi multikolinearitas (VIF < 5)
## Schooling : Tidak ada indikasi multikolinearitas (VIF < 5)model_full <- lm(as.formula(paste(response, "~", paste(predictors, collapse = " + "))),
data = df)model_full <- lm(as.formula(paste(response, "~", paste(predictors, collapse = " + "))),
data = df)
vif_full <- vif(model_full)
vif_full## Status Adult.Mortality
## 1.806313 1.808198
## infant.deaths Alcohol
## 245.900128 2.256621
## percentage.expenditure Hepatitis.B
## 14.287615 1.667816
## Measles BMI
## 1.539020 1.821104
## under.five.deaths Polio
## 234.891128 1.727204
## Total.expenditure Diphtheria
## 1.119102 2.142147
## HIV.AIDS GDP
## 1.473217 14.884693
## Population thinness..1.19.years
## 2.057050 6.890268
## thinness.5.9.years Income.composition.of.resources
## 6.932188 2.872390
## Schooling
## 3.399901Hasil perhitungan VIF menunjukkan bahwa variabel infant.deaths (245.9), under.five.deaths (234.89), percentage.expenditure (14.28), GDP (14.88), serta thinness usia 1–19 tahun (6.89) dan 5–9 tahun (6.93) memiliki nilai VIF sangat tinggi, yang menandakan adanya multikolinearitas kuat terutama antara variabel mortalitas anak dan pengeluaran kesehatan, sehingga variabel-variabel ini perlu dipertimbangkan untuk dieliminasi atau direduksi pada model
high_vif <- names(vif_full[vif_full > 5])
high_vif## [1] "infant.deaths" "percentage.expenditure" "under.five.deaths"
## [4] "GDP" "thinness..1.19.years" "thinness.5.9.years"df_reduced <- df %>% select(-all_of(high_vif))
model_reduced <- lm(
as.formula(paste(response, "~ .")),
data = df_reduced
)Setelah proses pembersihan multikolinearitas, variabel dengan nilai VIF sangat tinggi yaitu infant.deaths, percentage.expenditure, under.five.deaths, GDP, thinness 1–19 years, dan thinness 5–9 years telah dibuang karena berkontribusi besar terhadap multikolinearitas, sehingga model kini hanya mempertahankan variabel-variabel yang lebih stabil dan tidak saling berkorelasi kuat.
alias_info <- alias(model_reduced)$Complete
aliased_vars <- names(alias_info[alias_info == TRUE])
aliased_vars## NULLHasil pengecekan aliased coefficients menunjukkan nilai NULL, yang berarti tidak ada koefisien yang tereliminasi karena linear dependency sehingga semua variabel yang tersisa bersifat independen dan dapat diestimasi dengan baik dalam model.
if(length(aliased_vars) > 0){
cat("Menghapus variabel aliased:\n")
print(aliased_vars)
df_reduced <- df_reduced %>% select(-all_of(aliased_vars))
model_reduced <- lm(
as.formula(paste(response, "~ .")),
data = df_reduced
)
}# Ambil hanya prediktor numerik
X <- df_reduced %>% select(where(is.numeric))
# Buat matriks korelasi
cor_mat <- cor(X, use = "pairwise.complete.obs")
# Invers matriks korelasi
inv_cor <- solve(cor_mat)
# Ambil diagonal → itulah VIF
vif_cor <- diag(inv_cor)
vif_df <- data.frame(
variable = names(vif_cor),
VIF = vif_cor
)
vif_df## variable VIF
## Year Year 1.157394
## Status Status 1.737264
## Life.expectancy Life.expectancy 5.721034
## Adult.Mortality Adult.Mortality 2.191515
## Alcohol Alcohol 2.229992
## Hepatitis.B Hepatitis.B 1.678801
## Measles Measles 1.196830
## BMI BMI 1.626715
## Polio Polio 1.735447
## Total.expenditure Total.expenditure 1.123413
## Diphtheria Diphtheria 2.130705
## HIV.AIDS HIV.AIDS 2.014932
## Population Population 1.169145
## Income.composition.of.resources Income.composition.of.resources 3.164593
## Schooling Schooling 3.878807Hasil correlation-based VIF menunjukkan bahwa seluruh variabel memiliki nilai VIF rendah hingga moderat—mulai dari sekitar 1.12 pada Total.expenditure hingga 3.88 pada Schooling—dengan nilai tertinggi dimiliki oleh Schooling (3.88) dan Income.composition.of.resources (3.16), namun keseluruhannya masih berada jauh di bawah ambang batas kritis (VIF > 10), sehingga dapat disimpulkan bahwa model sudah bebas dari multikolinearitas signifikan
# 1. Ambil prediktor numerik saja
X_pca <- df %>%
select(all_of(predictors)) %>%
select(where(is.numeric)) %>%
as.data.frame()
# 2. Hapus variabel dengan varians nol (jika ada)
zero_var <- names(X_pca)[apply(X_pca, 2, var, na.rm = TRUE) == 0]
if(length(zero_var) > 0){
cat("Menghapus variabel varians nol:\n")
print(zero_var)
X_pca <- X_pca %>% select(-all_of(zero_var))
}
# 3. Tangani NA atau Infinite → isi dengan median kolom
X_pca_clean <- X_pca %>%
mutate_all(~ ifelse(!is.finite(.) | is.na(.), median(., na.rm = TRUE), .))
# 4. Jalankan PCA (TANPA ERROR)
pca_model <- prcomp(X_pca_clean, scale. = TRUE)
# 5. Ringkasan PCA
summary(pca_model)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 2.4210 1.7156 1.34467 1.23861 1.0871 0.93744 0.90330
## Proportion of Variance 0.3085 0.1549 0.09516 0.08075 0.0622 0.04625 0.04294
## Cumulative Proportion 0.3085 0.4634 0.55856 0.63931 0.7015 0.74775 0.79070
## PC8 PC9 PC10 PC11 PC12 PC13 PC14
## Standard deviation 0.83607 0.76642 0.72831 0.66200 0.6406 0.58930 0.56925
## Proportion of Variance 0.03679 0.03092 0.02792 0.02307 0.0216 0.01828 0.01706
## Cumulative Proportion 0.82749 0.85840 0.88632 0.90939 0.9310 0.94926 0.96632
## PC15 PC16 PC17 PC18 PC19
## Standard deviation 0.56190 0.45679 0.28006 0.18732 0.04566
## Proportion of Variance 0.01662 0.01098 0.00413 0.00185 0.00011
## Cumulative Proportion 0.98293 0.99392 0.99804 0.99989 1.00000# 6. Ambil 2 PC pertama dan buat model regresi PCA
pc_df <- as.data.frame(pca_model$x[, 1:2])
pc_df$y <- df[[response]]
model_pca <- lm(y ~ PC1 + PC2, data = pc_df)
# 7. Hasil Model PCA
summary(model_pca)##
## Call:
## lm(formula = y ~ PC1 + PC2, data = pc_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.41424 -0.07238 0.01545 0.08548 0.33167
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.561073 0.003316 169.23 <2e-16 ***
## PC1 -0.058974 0.001370 -43.05 <2e-16 ***
## PC2 -0.034832 0.001933 -18.02 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1204 on 1316 degrees of freedom
## Multiple R-squared: 0.6233, Adjusted R-squared: 0.6227
## F-statistic: 1089 on 2 and 1316 DF, p-value: < 2.2e-16Hasil PCA menunjukkan bahwa komponen utama pertama (PC1) menjelaskan 30.85% variasi dan PC2 menjelaskan 15.49% sehingga dua komponen ini sudah menangkap 46.34% total variasi data, dan ketika digunakan dalam regresi, model y ~ PC1 + PC2 memberikan hasil signifikan dengan kedua PC berpengaruh negatif (p < 2e-16), residual error kecil (0.1204), serta R² sebesar 0.623 yang menandakan bahwa dua komponen utama tersebut mampu menjelaskan sekitar 62% variasi respon secara efektif.
cat("AIC Model Full :", AIC(model_full), "\n")## AIC Model Full : -2919.126if (exists("model_reduced")) {
cat("AIC Model Reduced :", AIC(model_reduced), "\n")
}## AIC Model Reduced : -4854.897cat("AIC Model PCA :", AIC(model_pca), "\n")## AIC Model PCA : -1836.037Hasil perbandingan AIC menunjukkan bahwa model Reduced memiliki nilai AIC paling rendah (-4854.897) dibandingkan model Full (-2919.126) dan model PCA (-1836.037), sehingga model Reduced adalah model yang paling optimal dan efisien karena memberikan keseimbangan terbaik antara kompleksitas dan goodness-of-fit
library(glmnet)## Warning: package 'glmnet' was built under R version 4.4.3## Loading required package: Matrix## Warning: package 'Matrix' was built under R version 4.4.3##
## Attaching package: 'Matrix'## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack## Loaded glmnet 4.1-10# Bersihkan data: hanya variabel yang terlibat dan non-NA
df_clean <- df %>%
select(all_of(c(response, predictors))) %>%
drop_na()
# Bangun X_mat dan y_vec dari data yang sama
X_mat <- model.matrix(as.formula(paste(response, "~ .")), df_clean)[,-1]
y_vec <- df_clean[[response]]
# Ridge & LASSO Cross-Validated Lambda
set.seed(123)
cv_ridge <- cv.glmnet(X_mat, y_vec, alpha = 0)
cv_lasso <- cv.glmnet(X_mat, y_vec, alpha = 1)
ridge_model <- glmnet(X_mat, y_vec, alpha = 0, lambda = cv_ridge$lambda.min)
lasso_model <- glmnet(X_mat, y_vec, alpha = 1, lambda = cv_lasso$lambda.min)
cat("Koef Ridge:\n"); print(coef(ridge_model))## Koef Ridge:## 20 x 1 sparse Matrix of class "dgCMatrix"
## s0
## (Intercept) 0.320057324
## Status -0.021952347
## Adult.Mortality -0.294033101
## infant.deaths 0.048510894
## Alcohol -0.040204914
## percentage.expenditure 0.102325446
## Hepatitis.B -0.007071805
## Measles 0.029128416
## BMI 0.064717666
## under.five.deaths -0.164137697
## Polio 0.034579366
## Total.expenditure 0.013476514
## Diphtheria 0.028328329
## HIV.AIDS -0.448987392
## GDP 0.072480111
## Population 0.076334973
## thinness..1.19.years -0.025959122
## thinness.5.9.years -0.012269314
## Income.composition.of.resources 0.197501700
## Schooling 0.293445522cat("\nKoef LASSO:\n"); print(coef(lasso_model))##
## Koef LASSO:## 20 x 1 sparse Matrix of class "dgCMatrix"
## s0
## (Intercept) 0.325165657
## Status -0.020388837
## Adult.Mortality -0.289116719
## infant.deaths 2.622135430
## Alcohol -0.037802537
## percentage.expenditure 0.146728689
## Hepatitis.B -0.009064405
## Measles -0.006706986
## BMI 0.057986827
## under.five.deaths -2.635561702
## Polio 0.029876316
## Total.expenditure 0.016152878
## Diphtheria 0.018093458
## HIV.AIDS -0.470648052
## GDP 0.024375137
## Population 0.012342258
## thinness..1.19.years -0.021380257
## thinness.5.9.years -0.014322764
## Income.composition.of.resources 0.193680414
## Schooling 0.320272388Model Ridge menunjukkan semua koefisien mengecil dan tetap stabil (misalnya Adult.Mortality = –0.294, HIV.AIDS = –0.449, Schooling = 0.293), sedangkan LASSO menonjolkan prediktor paling kuat dengan nilai koefisien ekstrem seperti infant.deaths = 2.622, under.five.deaths = –2.636, dan HIV.AIDS = –0.471 sebagai variabel yang paling memengaruhi variabel target.
library(caret)
set.seed(123)
folds <- createFolds(y_vec, k = 5)
mse_ridge <- mse_lasso <- c()
for(i in seq_along(folds)){
test_idx <- folds[[i]]
train_idx <- setdiff(seq_along(y_vec), test_idx)
X_train <- X_mat[train_idx, ]
X_test <- X_mat[test_idx, ]
y_train <- y_vec[train_idx]
y_test <- y_vec[test_idx]
# Ridge
mod_ridge <- glmnet(X_train, y_train, alpha = 0, lambda = cv_ridge$lambda.min)
pred_ridge <- predict(mod_ridge, X_test)
mse_ridge[i] <- mean((y_test - pred_ridge)^2)
# LASSO
mod_lasso <- glmnet(X_train, y_train, alpha = 1, lambda = cv_lasso$lambda.min)
pred_lasso <- predict(mod_lasso, X_test)
mse_lasso[i] <- mean((y_test - pred_lasso)^2)
}
cat("CV MSE Ridge :", mean(mse_ridge), "\n")## CV MSE Ridge : 0.006801859cat("CV MSE LASSO :", mean(mse_lasso), "\n")## CV MSE LASSO : 0.006455907Hasil K-Fold Cross Validation menunjukkan bahwa model LASSO memiliki performa sedikit lebih baik (CV MSE = 0.006456) dibandingkan Ridge (CV MSE = 0.006802), sehingga LASSO lebih optimal dalam memprediksi variabel target pada data ini.
cat("AIC Full :", AIC(model_full), "\n")## AIC Full : -2919.126if (exists("model_reduced")) {
cat("AIC Reduced :", AIC(model_reduced), "\n")
}## AIC Reduced : -4854.897cat("AIC PCA :", AIC(model_pca), "\n")## AIC PCA : -1836.037cat("MSE Ridge :", mean(mse_ridge), "\n")## MSE Ridge : 0.006801859cat("MSE LASSO :", mean(mse_lasso), "\n")## MSE LASSO : 0.006455907Dari perbandingan model, reduced model memiliki AIC paling rendah sehingga lebih efisien dan fit dibanding full dan PCA model, sedangkan LASSO memiliki MSE lebih rendah daripada Ridge, menunjukkan prediksi LASSO sedikit lebih akurat.
cat("\n=== KESIMPULAN AKHIR ===\n")##
## === KESIMPULAN AKHIR ===if (exists("model_reduced") && AIC(model_reduced) < AIC(model_full)) {
cat("- Model Reduced lebih baik dari Model Full (AIC lebih kecil).\n")
}## - Model Reduced lebih baik dari Model Full (AIC lebih kecil).if (AIC(model_pca) < AIC(model_full)) {
cat("- Model PCA memberikan hasil lebih baik & bebas multikolinearitas.\n")
}
if (mean(mse_ridge) < mean(mse_lasso)) {
cat("- Ridge memiliki MSE lebih kecil → koefisien lebih stabil.\n")
} else {
cat("- LASSO memiliki MSE lebih kecil → seleksi variabel efektif.\n")
}## - LASSO memiliki MSE lebih kecil → seleksi variabel efektif.cat("- Model terbaik dipilih berdasarkan AIC dan MSE terkecil.\n")## - Model terbaik dipilih berdasarkan AIC dan MSE terkecil.