Universitas : UIN MAULANA MALIK IBRAHIM MALANG

Jurusan : Teknik Informatika

0.1 Pengertian Smoothing Spline

Smoothing Splines adalah pendekatan yang ampuh untuk memperkirakan hubungan fungsional antara prediktor X dan respons Y. Smoothing splines dapat ditampung 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. Dibandingkan dengan fungsi smooth.spline, fungsi ss memiliki lebih banyak metode pemilihan parameter penghalusan lebih banyak jenis spline (linier, kubik, quintic) opsi untuk batasan periodisitas opsi untuk nilai simpul yang ditentukan pengguna ringkasan yang sesuai dan metode plot

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 adalah regresi nonparametrik dengan pendekatan smoothing spline pada data Google Mobility Index dan Covid-19 di Jakarta Juli 2020.

0.2 Data Google Mobility Index dan Covid-19 di Jakarta Juli 2020

library(readxl)
## Warning: package 'readxl' was built under R version 4.1.2
mobilityjakarta <- read_excel(path = "DataMobility1-7.xlsx")
mobilityjakarta
plot(mobilityjakarta$Tanggal,mobilityjakarta$Dirawat)

0.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(Dirawat, grocery_and_pharmacy_percent_change_from_baseline), freq = TRUE)
## 
##  DESCRIPTIVES
## 
##  Descriptives                                                                            
##  --------------------------------------------------------------------------------------- 
##                          Dirawat     grocery_and_pharmacy_percent_change_from_baseline   
##  --------------------------------------------------------------------------------------- 
##    N                           31                                                   31   
##    Missing                      0                                                    0   
##    Mean                  990.2258                                            -11.83871   
##    Median                826.0000                                            -9.000000   
##    Standard deviation    519.0093                                             8.355026   
##    Minimum               405.0000                                            -30.00000   
##    Maximum               2183.000                                            -3.000000   
##  ---------------------------------------------------------------------------------------

0.4 Perbandingan Pendekatan

library(npreg)
## Warning: package 'npreg' was built under R version 4.1.3
mod.ss <- ss(mobilityjakarta$Tanggal,mobilityjakarta$Dirawat, nknots = 10)
mobilityjakarta$prediksi_ss <- mod.ss$y
mobilityjakarta
mod.smsp <- smooth.spline( mobilityjakarta$Tanggal,mobilityjakarta$Dirawat, nknots = 10)
mobilityjakarta$prediksi_smsp <- mod.smsp$y
mobilityjakarta
# plot method
plot(mobilityjakarta$Tanggal, mobilityjakarta$Dirawat, lty = 10, col = 'Red', lwd =10)
# plot(mod.ss)
# add lm fit
abline(coef(lm( mobilityjakarta$Dirawat ~ 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("Red","Yellow","Blue"), lwd = 3, bty = "p")

library(npreg)
mod.ss1 <- ss(mobilityjakarta$Tanggal,mobilityjakarta$workplaces_percent_change_from_baseline, nknots = 10)
mobilityjakarta$prediksi_ss1 <- mod.ss1$y
mobilityjakarta
mod.smsp1 <- smooth.spline( mobilityjakarta$Tanggal,mobilityjakarta$workplaces_percent_change_from_baseline, nknots = 10)
mobilityjakarta$prediksi_smsp1 <- mod.smsp1$y
mobilityjakarta
# Hasil plot

plot(mobilityjakarta$Tanggal, mobilityjakarta$workplaces_percent_change_from_baseline, lty = 10, col = 'black', lwd =5)

# add lm fit
abline(coef(lm( mobilityjakarta$workplaces_percent_change_from_baseline ~ mobilityjakarta$Tanggal  , data = mobilityjakarta)), lty = 3, col = 'green', lwd =4)
lines(mobilityjakarta$Tanggal, mobilityjakarta$prediksi_ss1 , lty = 2, col = 'Blue', lwd = 4)
lines(mobilityjakarta$Tanggal, mobilityjakarta$prediksi_smsp1, lty = 4, col = 'Orange', lwd = 6)

0.5 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$Dirawat,mobilityjakarta$workplaces_percent_change_from_baseline)
## 
##  Pearson's product-moment correlation
## 
## data:  mobilityjakarta$Dirawat and mobilityjakarta$workplaces_percent_change_from_baseline
## t = -2.64, df = 29, p-value = 0.01321
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.6873252 -0.1017182
## sample estimates:
##        cor 
## -0.4401926

Dari output tersebut dapat kita simpulkan bahwa tidak adanya hubungan yang signifikan antara mobilityjakarta Dirawat dan mobilityjakarta workplaces_percent_change_from_baseline (p-value<0,01). Nilai p-value dalam output R dituliskan 0.01321. Nilai koefisien korelasi r adalah sebesar 0.4401926yang menunjukkan hubungan yang lemah dan positif ( berbanding lurus) antara variabel Dirawat dan workplaces_percent_change_from_baseline.

0.6 Hasil Regresi dengan Pendekatan Smoothing Spline

model <- lm(mobilityjakarta$Dirawat ~ mobilityjakarta$workplaces_percent_change_from_baseline, data = mobilityjakarta)
summary(model)
## 
## Call:
## lm(formula = mobilityjakarta$Dirawat ~ mobilityjakarta$workplaces_percent_change_from_baseline, 
##     data = mobilityjakarta)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -661.04 -382.43  -59.52  349.14  930.15 
## 
## Coefficients:
##                                                         Estimate Std. Error
## (Intercept)                                               194.60     313.16
## mobilityjakarta$workplaces_percent_change_from_baseline   -26.41      10.00
##                                                         t value Pr(>|t|)  
## (Intercept)                                               0.621   0.5392  
## mobilityjakarta$workplaces_percent_change_from_baseline  -2.640   0.0132 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 474 on 29 degrees of freedom
## Multiple R-squared:  0.1938, Adjusted R-squared:  0.166 
## F-statistic:  6.97 on 1 and 29 DF,  p-value: 0.01321
mobilityjakarta$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, 0, 1, alpha = 0.5), ...)
    # lines(density(x), col = 2, lwd = 2) # Uncomment to add density lines
}
# Menyetarakan berdasarkan formula
pairs(mobilityjakarta$Dirawat~mobilityjakarta$workplaces_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$Dirawat, lty = 10, col = 'black', lwd =5)

#plot(mod.ss)
# add lm fit
abline(coef(lm( mobilityjakarta$Dirawat ~ mobilityjakarta$Tanggal  , data = mobilityjakarta)), lty = 10, col = 'purple', lwd =5)
rug(mobilityjakarta$Tanggal)  # add rug to plot


lines(mobilityjakarta$Tanggal,mod.ss$y , lty = 2, col = 'blue', lwd = 4)

#plot(mod.smsp)

lines(mobilityjakarta$Tanggal, mobilityjakarta$prediksi_model, lty = 2, col = 'cyan', lwd = 4)
legend("topleft", 
       legend = c("Real", "Model SS", "Trends", "Regresi Nonparametrik"), 
       lty = 1:4, col = c("Black","blue","purple","cyan"), lwd = 3, bty = "p")