Najah Muchsin Sanin

19 April 2022

Dosen Pengampu : Prof. Dr. Suhartono, M.Kom

Lembaga : Universitas Islam Negeri Maulana Malik Ibrahim Malang

Jurusan : Teknik Informatika

1 Pengertian Smoothing Spline

Smoothing merupakan salah satu metode yang digunakan dalam analisis data non parametrik. Tujuan dari smoothing adalah untuk meminimalkan keragaman karakteristik data dari data yang tidak memiliki pengaruh sehingga ciri-ciri dari data akan tampak lebih jelas. Smoothing telah menjadi teknik umum di dalam metode-metode nonparametrik yang digunakan untuk menduga fungsi. Salah satu model regresi dengan pendekatan non parametrik yang dapat diguanakan untuk menduga kurva regresi adalah regresi spline.

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 Agustus 2021.

2 Data Google Mobility Index dan Covid-19 di Jakarta Agustus 2021

library(readxl)
## Warning: package 'readxl' was built under R version 4.1.2
mobilityjakarta <- read_excel(path = "Data Google Mobility Index dan Covid-19 Agustus 2021.xlsx")
mobilityjakarta
plot(mobilityjakarta$Tanggal,mobilityjakarta$SelfIsolation)

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(SelfIsolation, parks_percent_change_from_baseline), freq = TRUE)
## 
##  DESCRIPTIVES
## 
##  Descriptives                                                                  
##  ----------------------------------------------------------------------------- 
##                          SelfIsolation    parks_percent_change_from_baseline   
##  ----------------------------------------------------------------------------- 
##    N                                31                                    31   
##    Missing                           0                                     0   
##    Mean                       6727.806                             -50.90323   
##    Median                     6290.000                             -50.00000   
##    Standard deviation         1459.328                              5.740818   
##    Minimum                    4980.000                             -67.00000   
##    Maximum                    9535.000                             -41.00000   
##  -----------------------------------------------------------------------------

4 Perbandingan Pendekatan

library(npreg)
## Warning: package 'npreg' was built under R version 4.1.3
mod.ss <- ss(mobilityjakarta$Tanggal,mobilityjakarta$SelfIsolation, nknots = 10)
mobilityjakarta$prediksi_ss <- mod.ss$y
mobilityjakarta
mod.smsp <- smooth.spline( mobilityjakarta$Tanggal,mobilityjakarta$SelfIsolation, nknots = 10)
mobilityjakarta$prediksi_smsp <- mod.smsp$y
mobilityjakarta
# plot method
plot(mobilityjakarta$Tanggal, mobilityjakarta$SelfIsolation, lty = 10, col = 'black', lwd =10)

# plot(mod.ss)
# add lm fit
abline(coef(lm( mobilityjakarta$SelfIsolation ~ mobilityjakarta$Tanggal  , data = mobilityjakarta)), lty = 2.5, col = 'red', lwd =7)
rug(mobilityjakarta$Tanggal)  # add rug to plot

points(mobilityjakarta$Tanggal,mod.ss$y , lty = 2, col = 'pink', lwd = 5)


legend("topright", 
       legend = c("Real", "Model SS", "Trends"), 
       lty = 1:3, col = c("Black","pink","red"), lwd = 3, bty = "p")

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

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

# add lm fit
abline(coef(lm( mobilityjakarta$parks_percent_change_from_baseline ~ mobilityjakarta$Tanggal  , data = mobilityjakarta)), lty = 3, col = 'yellow', lwd =4)
lines(mobilityjakarta$Tanggal, mobilityjakarta$prediksi_ss1 , lty = 2, col = 'red', lwd = 4)
lines(mobilityjakarta$Tanggal, mobilityjakarta$prediksi_smsp1, lty = 4, col = 'blue', lwd = 6)

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$SelfIsolation,mobilityjakarta$parks_percent_change_from_baseline)
## 
##  Pearson's product-moment correlation
## 
## data:  mobilityjakarta$SelfIsolation and mobilityjakarta$parks_percent_change_from_baseline
## t = -2.8503, df = 29, p-value = 0.00796
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.7052426 -0.1360102
## sample estimates:
##       cor 
## -0.467805

Dari output tersebut dapat kita simpulkan bahwa adanya hubungan yang signifikan antara mobilityjakarta SelfIsolation dan mobilityjakarta parks_percent_change_from_baseline (p-value<0,01). Nilai p-value dalam output R dituliskan 0.00796. Nilai koefisien korelasi r adalah sebesar -0.467805 yang menunjukkan hubungan yang cukup kuat dan negatif ( berbanding terbalik) antara variabel SelfIsolation dan parks_percent_change_from_baseline.

6 Hasil Regresi dengan Pendekatan Smoothing Spline

model <- lm(mobilityjakarta$SelfIsolation ~ mobilityjakarta$parks_percent_change_from_baseline, data = mobilityjakarta)
summary(model)
## 
## Call:
## lm(formula = mobilityjakarta$SelfIsolation ~ mobilityjakarta$parks_percent_change_from_baseline, 
##     data = mobilityjakarta)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1868.8  -922.3  -376.9   727.6  2787.2 
## 
## Coefficients:
##                                                    Estimate Std. Error t value
## (Intercept)                                          674.55    2136.74   0.316
## mobilityjakarta$parks_percent_change_from_baseline  -118.92      41.72  -2.850
##                                                    Pr(>|t|)   
## (Intercept)                                         0.75450   
## mobilityjakarta$parks_percent_change_from_baseline  0.00796 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1312 on 29 degrees of freedom
## Multiple R-squared:  0.2188, Adjusted R-squared:  0.1919 
## F-statistic: 8.124 on 1 and 29 DF,  p-value: 0.00796
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, 1, 0, alpha = 0.5), ...)
    # lines(density(x), col = 2, lwd = 2) # Uncomment to add density lines
}
# Menyetarakan berdasarkan formula
pairs(mobilityjakarta$SelfIsolation~mobilityjakarta$parks_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$SelfIsolation, lty = 10, col = 'black', lwd =5)

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


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

#plot(mod.smsp)

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