Regresi dengan pendekatan smoothing spline Pada Data Google Mobility Index dan Covid-19 di Jakarta Mei 2020
Muhammad Amirul Muttaqin
21/4/2022
Lembaga : Universitas Islam Negeri Maulana Malik Ibrahim Malang
Jurusan : Teknik Informatika
1 Pengertian smoothing spline
Smoothing splines adalah pendekatan yang ampuh untuk memperkirakan hubungan fungsional antara prediktor X dan respons Y. Smoothing splines dapat di-fit baik menggunakan fungsi smooth.spline (dalam paket stats) atau fungsi ss (dalam paket npreg). Dokumen ini memberikan latar belakang teoritis tentang smoothing splines, serta contoh-contoh yang menggambarkan bagaimana menggunakan fungsi smooth.spline dan ss. Seperti yang saya tunjukkan dalam tutorial ini, kedua fungsi memiliki sintaks yang sangat mirip, tetapi fungsi ss menawarkan beberapa opsi tambahan.
Regresi spline merupakan smoothing untuk memplot data dengan mempertimbangkan kemulusan kurva. Spline adalah model polinomial yang tersegmentasi atau terbagi, dan sifat segmen ini memberikan fleksibilitas yang lebih besar daripada model polinomial biasa. Properti ini memungkinkan model regresi spline untuk secara efektif disesuaikan dengan properti lokal data. Penggunaan splines menitikberatkan pada adanya perilaku atau pola data yang memiliki sifat yang berbeda pada suatu area tertentu dengan pada area lainnya. Berikut regresi nonparametrik dengan pendekatan smoothing spline pada data Google Mobility Index dan Covid-19 di Jakarta mei 2020.
2 *Data Google Mobility Index dan Covid-19 di Jakarta Mei 2020"
library(readxl)## Warning: package 'readxl' was built under R version 4.1.2mobilityjakarta <- read_excel(path = "Data Riwayat Covid-19 & Google Mobility Index Mei 2020.xlsx")
mobilityjakartaplot(mobilityjakarta$Tanggal,mobilityjakarta$POSITIF)
3 Data Deskriptif
library(jmv)## Warning: package 'jmv' was built under R version 4.1.3# Mendapatkan data descriptive menggunakan fungsi descritptive
descriptives(mobilityjakarta, vars = vars(POSITIF, grocery_and_pharmacy_percent_change_from_baseline), freq = TRUE)##
## DESCRIPTIVES
##
## Descriptives
## ---------------------------------------------------------------------------------------
## POSITIF grocery_and_pharmacy_percent_change_from_baseline
## ---------------------------------------------------------------------------------------
## N 31 31
## Missing 0 0
## Mean 5738.258 -21.19355
## Median 5795.000 -22.00000
## Standard deviation 918.6507 8.673405
## Minimum 4283.000 -34.00000
## Maximum 7272.000 -1.000000
## ---------------------------------------------------------------------------------------4 Perbandingan Pendekatan
library(npreg)## Warning: package 'npreg' was built under R version 4.1.3mod.ss <- ss(mobilityjakarta$Tanggal,mobilityjakarta$POSITIF, nknots = 10)
mobilityjakarta$prediksi_ss <- mod.ss$y
mobilityjakarta5 Perbandingan Pendekatan
library(npreg)
mod.ss <- ss(mobilityjakarta$Tanggal,mobilityjakarta$POSITIF, nknots = 10)
mobilityjakarta$prediksi_ss <- mod.ss$y
mobilityjakartamod.smsp <- smooth.spline( mobilityjakarta$Tanggal,mobilityjakarta$POSITIF, nknots = 10)
mobilityjakarta$prediksi_smsp <- mod.smsp$y
mobilityjakarta# plot method
plot(mobilityjakarta$Tanggal, mobilityjakarta$POSITIF, lty = 10, col = 'Green', lwd =10)
# plot(mod.ss)
# add lm fit
abline(coef(lm( mobilityjakarta$POSITIF ~ mobilityjakarta$Tanggal , data = mobilityjakarta)), lty = 2.5, col = 'blue', lwd =7)
rug(mobilityjakarta$Tanggal) # add rug to plot
points(mobilityjakarta$Tanggal,mod.ss$y , lty = 2, col = 'Yellow', lwd = 5)
legend("bottomright",
legend = c("Real", "Model SS", "Trends"),
lty = 1:3, col = c("Green","Yellow","Blue"), lwd = 3, bty = "p")
library(npreg)
mod.ss1 <- ss(mobilityjakarta$Tanggal,mobilityjakarta$grocery_and_pharmacy_percent_change_from_baselineF, nknots = 10)## Warning: Unknown or uninitialised column:
## `grocery_and_pharmacy_percent_change_from_baselineF`.## Warning in sqrt(sse/(n - df)): NaNs producedmobilityjakarta$prediksi_ss1 <- mod.ss1$y
mobilityjakartamod.smsp1 <- smooth.spline( mobilityjakarta$Tanggal,mobilityjakarta$grocery_and_pharmacy_percent_change_from_baseline, nknots = 10)
mobilityjakarta$prediksi_smsp1 <- mod.smsp1$y
mobilityjakarta# Hasil plot
plot(mobilityjakarta$Tanggal, mobilityjakarta$grocery_and_pharmacy_percent_change_from_baseline, lty = 10, col = 'Purple', lwd =5)
# add lm fit
abline(coef(lm( mobilityjakarta$grocery_and_pharmacy_percent_change_from_baseline ~ mobilityjakarta$Tanggal , data = mobilityjakarta)), lty = 10, col = 'Blue', lwd =5)
lines(mobilityjakarta$Tanggal, mobilityjakarta$prediksi_ss1 , lty = 2, col = 'yellow', lwd = 4)
lines(mobilityjakarta$Tanggal, mobilityjakarta$prediksi_smsp1, lty = 4, col = 'green', lwd = 2)
6 Korelasi Pearson
Korelasi Pearson adalah alat analisis statistik yang digunakan untuk melihat keeratan hubungan linier antara 2 variabel yang skala datanya adalah interval atau rasio.
cor.test(mobilityjakarta$POSITIF,mobilityjakarta$grocery_and_pharmacy_percent_change_from_baseline)##
## Pearson's product-moment correlation
##
## data: mobilityjakarta$POSITIF and mobilityjakarta$grocery_and_pharmacy_percent_change_from_baseline
## t = 3.2615, df = 29, p-value = 0.002834
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
## 0.2005101 0.7370824
## sample estimates:
## cor
## 0.5180438Dari output tersebut dapat kita simpulkan bahwa adanya hubungan yang signifikan antara mobilityjakarta POSITIF dan mobilityjakarta grocery_and_pharmacy_percent_change_from_baseline (p-value<0,01). Nilai p-value dalam output R dituliskan 0.002834. Nilai koefisien korelasi r adalah sebesar 0.5180438 yang menunjukkan hubungan yang cukup kuat dan positif (berbanding lurus) antara variabel POSITIF dan grocery_and_pharmacy_percent_change_from_baseline.
7 Hasil Regresi dengan Pendekatan Smoothing Spline
model <- lm(mobilityjakarta$POSITIF ~ mobilityjakarta$grocery_and_pharmacy_percent_change_from_baseline, data = mobilityjakarta)
summary(model)##
## Call:
## lm(formula = mobilityjakarta$POSITIF ~ mobilityjakarta$grocery_and_pharmacy_percent_change_from_baseline,
## data = mobilityjakarta)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1081.8 -562.6 -281.3 621.1 1632.9
##
## Coefficients:
## Estimate
## (Intercept) 6901.13
## mobilityjakarta$grocery_and_pharmacy_percent_change_from_baseline 54.87
## Std. Error
## (Intercept) 384.35
## mobilityjakarta$grocery_and_pharmacy_percent_change_from_baseline 16.82
## t value
## (Intercept) 17.955
## mobilityjakarta$grocery_and_pharmacy_percent_change_from_baseline 3.262
## Pr(>|t|)
## (Intercept) < 2e-16 ***
## mobilityjakarta$grocery_and_pharmacy_percent_change_from_baseline 0.00283 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 799.2 on 29 degrees of freedom
## Multiple R-squared: 0.2684, Adjusted R-squared: 0.2431
## F-statistic: 10.64 on 1 and 29 DF, p-value: 0.002834mobilityjakarta$prediksi_model <- model$fitted.values
mobilityjakarta# Menambahkan Histograms
panel.hist <- function(x, ...) {
usr <- par("usr")
on.exit(par(usr))
par(usr = c(usr[1:2], 0, 1.5))
his <- hist(x, plot = FALSE)
breaks <- his$breaks
nB <- length(breaks)
y <- his$counts
y <- y/max(y)
rect(breaks[-nB], 0, breaks[-1], y, col = rgb(0, 1, 0, alpha = 0.5), ...)
# lines(density(x), col = 2, lwd = 2) # Uncomment to add density lines
}
# Menyetarakan berdasarkan formula
pairs(mobilityjakarta$POSITIF~mobilityjakarta$grocery_and_pharmacy_percent_change_from_baseline, data = mobilityjakarta,
upper.panel = NULL, # Disabling the upper panel
diag.panel = panel.hist) # Adding the histograms
# plot method
plot(mobilityjakarta$Tanggal, mobilityjakarta$POSITIF, lty = 10, col = 'Red', lwd =5)
#plot(mod.ss)
# add lm fit
abline(coef(lm( mobilityjakarta$POSITIF ~ mobilityjakarta$Tanggal , data = mobilityjakarta)), lty = 10, col = 'Blue', lwd =5)
rug(mobilityjakarta$Tanggal) # add rug to plot
lines(mobilityjakarta$Tanggal,mod.ss$y , lty = 2, col = 'Orange', lwd = 4)
#plot(mod.smsp)
lines(mobilityjakarta$Tanggal, mobilityjakarta$prediksi_model, lty = 2, col = 'Green', lwd = 4)
legend("topleft",
legend = c("Real", "Model SS", "Trends", "Regresi Nonparametrik"),
lty = 1:4, col = c("Red","Orange","Blue","Green"), lwd = 3, bty = "p")