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 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.2
mobilityjakarta <- read_excel(path = "Data Google Mobility Index dan Covid-19 Mei 2020.xlsx")
mobilityjakarta
plot(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.3
mod.ss <- ss(mobilityjakarta$Tanggal,mobilityjakarta$POSITIF, nknots = 10)
mobilityjakarta$prediksi_ss <- mod.ss$y
mobilityjakarta
mod.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 = 'black', 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 = 'red', lwd = 5)

legend("bottomright", 
       legend = c("Real", "Model SS", "Trends"), 
       lty = 1:3, col = c("Black","Red","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 produced
mobilityjakarta$prediksi_ss1 <- mod.ss1$y
mobilityjakarta
mod.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 = 'black', lwd =5)

# add lm fit
abline(coef(lm( mobilityjakarta$grocery_and_pharmacy_percent_change_from_baseline ~ mobilityjakarta$Tanggal  , data = mobilityjakarta)), lty = 10, col = 'red', 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)

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$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.5180438

Dari 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.

6 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.002834
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(1, 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 = 'black', lwd =5)

#plot(mod.ss)
# add lm fit
abline(coef(lm( mobilityjakarta$POSITIF ~ 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 = 'cyan', lwd = 4)
legend("topleft", 
       legend = c("Real", "Model SS", "Trends", "Regresi Nonparametrik"), 
       lty = 1:4, col = c("Black","purple","green","cyan"), lwd = 3, bty = "p")