Spline Smoothing Angka Kematian Neonatal
Sapta Hastho Ponco
2024-04-28
Spline adalah alat penting dalam regresi nonparametrik yang digunakan untuk memodelkan hubungan antara variabel dengan menggunakan fungsi polinomial di berbagai interval. Spline memungkinkan fleksibilitas tinggi dalam menyesuaikan kurva dengan data dengan menjaga kekasaran kurva pada tingkat yang dapat diterima (Eubank, 1999).
pacman::p_load(readxl, dplyr, ggplot2, tidyverse, ISLR, grid, writexl)1 Explore Data
Plot Awal Data:
plot_awal <- ggplot(data1,aes(x=x1, y=x2)) +
geom_point(alpha=0.55, color="black") +
ggtitle("Angka Kematian Neonatal") +
xlab("Order Tahun")+
ylab("% AKN")+
stat_smooth(method = "lm",
formula = y~x,lty = 1,
col = "blue",se = F)+
theme_grey()
plot_awal
2 Smoothing Spline
Metode Smoothing Spline dilakukan dengan menggunakan fungsi smooth.spline() yang secara otomatis memilih parameter lambda terbaik dengan menggunakan Cross-Validation (CV) dan Generalized Cross-Validation (GCV).
Perbedaan utama antara keduanya adalah pada ukuran kebaikan model yang digunakan. Kalau CV menggunakan MSE sebagai ukuran kebaikan model, sedangkan GCV menggunakan Weighted-MSE. Banyaknya folds (lipatan) pada CV dan GCV ini adalah sejumlah observasinya.
Membangun Model Smoothing Spline
model_spline <- with(data = data1,smooth.spline(x=data1$x1,y=data1$x2))
model_spline## Call:
## smooth.spline(x = data1$x1, y = data1$x2)
##
## Smoothing Parameter spar= 0.2696129 lambda= 6.696144e-06 (16 iterations)
## Equivalent Degrees of Freedom (Df): 15.4951
## Penalized Criterion (RSS): 0.5695391
## GCV: 0.2961183Output di atas menunjukkan bahwa dengan pendekatan Smoothing Spline pada data, diperoleh secara otomatis dengan GCV nilai lambda yang sangat kecil yaitu mendekati 0 dengan 16 kali iterasi sebagai parameter lambda terbaik.
Dari hasil penentuan model smoothing splines terbaik tersebut, berikut diperlihatkan secara visual hasil Smoothing Spline.
plot(data1$x1, data1$x2, main="Fitting Curve with Smoothing Spline",
xlab="Order Tahun", ylab="% AKN", pch=16, col="black")
lines(model_spline, col="red", lwd=2) #garis smoothing spline ke plot
Dari plot dapat dilihat bahwa garis sudah tepat secara visual berada pada titik-titik data.
Fitted values dari model spline
fitted_values <- round(data.frame(x = model_spline$x, y = model_spline$y),2)
fitted_values## x y
## 1 1 96.97
## 2 2 91.41
## 3 3 86.20
## 4 4 80.54
## 5 5 72.65
## 6 6 64.71
## 7 7 58.41
## 8 8 55.17
## 9 9 52.83
## 10 10 50.46
## 11 11 48.10
## 12 12 46.19
## 13 13 45.51
## 14 14 45.17
## 15 15 44.80
## 16 16 44.42
## 17 17 43.95
## 18 18 43.19
## 19 19 42.36
## 20 20 41.55
## 21 21 40.77
## 22 22 40.00Menggabungkan data asli dengan fitted values
combined_data <- data1 %>%
rename(original_y = x2) %>%
left_join(fitted_values, by = c("x1" = "x")) %>%
rename(fitted_y = y)
combined_data## # A tibble: 22 × 5
## x1 tahun Indikator original_y fitted_y
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 1991 97 97 97.0
## 2 2 1992 NA 91.3 91.4
## 3 3 1993 NA 86.0 86.2
## 4 4 1994 81 81 80.5
## 5 5 1995 NA 72.5 72.6
## 6 6 1996 NA 64.8 64.7
## 7 7 1997 58 58 58.4
## 8 8 1998 NA 55.4 55.2
## 9 9 1999 NA 52.9 52.8
## 10 10 2000 NA 50.5 50.5
## # ℹ 12 more rows# Pemeriksaan nilai NA atau karakter dalam kolom
combined_data <- combined_data %>%
filter(!is.na(original_y) & !is.na(fitted_y))3 R-square & RMSE
R-square
R-squared (\(R^2\)) memberikan gambaran umum tentang seberapa baik model dalam menjelaskan variasi dalam data dibandingkan dengan model yang hanya menggunakan rata-rata sebagai prediksi.
Rumus untuk R-squared adalah (Gujarati & Porter, 2009):
\[ R^2 = 1 - \frac{RSS}{TSS} \]
dimana:
- \(RSS\) adalah Residual Sum of Squares, dan
- \(TSS\) adalah Total Sum of Squares.
# Hitung Total Sum of Squares (TSS)
tss <- sum((combined_data$original_y - mean(combined_data$original_y))^2)
# Hitung Residual Sum of Squares (RSS)
rss <- sum((combined_data$original_y - combined_data$fitted_y)^2)
# Hitung R-squared
r_squared <- 1 - (rss / tss)
# Cetak nilai R-squared
print(paste("R-squared: ", r_squared))## [1] "R-squared: 0.999915726957144"R-squared memberikan gambaran umum tentang seberapa baik model dalam menjelaskan variasi dalam data dibandingkan dengan model yang hanya menggunakan rata-rata sebagai prediksi.
Dari output penghitungan di atas diperoleh nilai R-squared sebesar 99,99%.
RMSE
Root Mean Squared Error (RMSE) adalah kuran statistik yang digunakan untuk mengevaluasi seberapa baik model prediktif atau regresi sesuai dengan data yang sebenarnya. RMSE mengukur seberapa besar rata-rata deviasi antara nilai yang diprediksi oleh model dan nilai aktualnya (Hair dkk, 2006).
RMSE adalah ukuran error yang digunakan untuk mengukur perbedaan antara nilai yang diprediksi dan nilai yang sebenarnya. RMSE adalah akar kuadrat dari rata-rata kuadrat error. Semakin kecil nilai RMSE, semakin baik model dalam memprediksi nilai yang sebenarnya.
Rumus untuk RMSE adalah:
\[ \text{RMSE} = \sqrt{\frac{1}{n} \sum_{i=1}^{n} (y_i - \hat{y}_i)^2} \] dimana:
- \(y_i\) adalah nilai sebenarnya,
- \(\hat{y}_i\) adalah nilai yang diprediksi,
- \(n\) adalah jumlah observasi.
# Hitung RMSE untuk fitted values (data asli)
# Pastikan `x` di `fitted_values` dan `data1` cocok
common_x <- intersect(data1$x1, fitted_values$x)
rmse_fitted <- sqrt(mean((data1 %>% filter(x1 %in% common_x) %>% pull(x2) -
fitted_values %>% filter(x %in% common_x) %>% pull(y))^2, na.rm = TRUE))
# Cetak nilai RMSE
print(paste("RMSE untuk Fitted Values: ", rmse_fitted))## [1] "RMSE untuk Fitted Values: 0.160055665852539"Output menunjukkan bahwa nilai RMSE diperoleh sebesar 0.1600
4 Predicted Value
Misalkan ingin diketahui nilai prediksi dalam 30 tahun ke depan.
x_new <- seq(max(data1$x1) + 1, max(data1$x1) + 30, by = 1)
predictions <- predict(model_spline, x_new)
predicted_values <- data.frame(x = predictions$x, y = predictions$y, type = "Predicted")
head(predicted_values)## x y type
## 1 23 39.23033 Predicted
## 2 24 38.46148 Predicted
## 3 25 37.69264 Predicted
## 4 26 36.92380 Predicted
## 5 27 36.15495 Predicted
## 6 28 35.38611 Predicted5 Visual Akhir
Menggabungkan data asli, fitted values (hasil spline), dan nilai prediksi
combined_data_full <- bind_rows(
data.frame(x = data1$x1, y = data1$x2, type = "Original"),
fitted_values %>% mutate(type = "Fitted"),
predicted_values %>% mutate(type = "Predicted")
)Plot data:
# Plot prediksi dengan ggplot
ggplot(data1, aes(x=x1, y=x2)) +
geom_point(alpha=0.55, color="black") +
geom_line(data = fitted_values, aes(x = x, y = y), col="red", lty=1) +
geom_line(data = predicted_values, aes(x = x, y = y), col="darkorange", lty=1) +
xlab("X values") +
ylab("Y values") +
ggtitle("Plot of Fitted and Predicted Values with Smoothing Spline") +
theme_bw()
Export Data
head(combined_data_full)## x y type
## 1 1 97.00000 Original
## 2 2 91.34319 Original
## 3 3 86.01627 Original
## 4 4 81.00000 Original
## 5 5 72.46573 Original
## 6 6 64.83064 Originalwrite_xlsx(combined_data_full, "combined_data.xls")6 References
[1] Damodar, Gujarati & Dawn C. Porter. (2009). Basic Econometric 5th Edition. McGraw–Hill: New York.
[2] Eubank, R.L. (1999). Nonparametric Regression and Spline Smoothing. Dekker: New York.
[3] Hair, J. F., dkk. (2006). Multivariate Data Analysis Sixth Edition. Pearson Education Inc: New Jersey.
Direktorat Statistik Kesejahteraan Rakyat, BPS, saptahas@bps.go.id