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 November 2020.

2 Data Google Mobility Index dan Covid-19 di Jakarta November 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 November 2020.xlsx")
mobilityjakarta
plot(mobilityjakarta$Tanggal,mobilityjakarta$Dirawat)

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, workplaces_percent_change_from_baseline), freq = TRUE)
## 
##  DESCRIPTIVES
## 
##  Descriptives                                                                  
##  ----------------------------------------------------------------------------- 
##                          Dirawat     workplaces_percent_change_from_baseline   
##  ----------------------------------------------------------------------------- 
##    N                           30                                         30   
##    Missing                      0                                          0   
##    Mean                  2299.600                                  -26.50000   
##    Median                2233.500                                  -31.00000   
##    Standard deviation    583.7056                                   7.468324   
##    Minimum               1472.000                                  -33.00000   
##    Maximum               3387.000                                  -13.00000   
##  ----------------------------------------------------------------------------- 
## 
## 
##  FREQUENCIES
## 
##  Frequencies of workplaces_percent_change_from_baseline 
##  ------------------------------------------------------ 
##    Levels    Counts    % of Total    Cumulative %   
##  ------------------------------------------------------ 
##    -33            2       6.66667         6.66667   
##    -32            5      16.66667        23.33333   
##    -31           10      33.33333        56.66667   
##    -30            4      13.33333        70.00000   
##    -18            1       3.33333        73.33333   
##    -17            3      10.00000        83.33333   
##    -16            1       3.33333        86.66667   
##    -14            2       6.66667        93.33333   
##    -13            2       6.66667       100.00000   
##  ------------------------------------------------------

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 = 'black', lwd =7)

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

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


legend("topleft", 
       legend = c("Real", "Model SS", "Trends"), 
       lty = 1:3, col = c("Black","blue","yellow"), 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 = 'pink', lwd = 4)
lines(mobilityjakarta$Tanggal, mobilityjakarta$prediksi_smsp1, lty = 4, col = 'purple', 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$Dirawat,mobilityjakarta$workplaces_percent_change_from_baseline)
## 
##  Pearson's product-moment correlation
## 
## data:  mobilityjakarta$Dirawat and mobilityjakarta$workplaces_percent_change_from_baseline
## t = 0.18696, df = 28, p-value = 0.853
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.3291455  0.3906110
## sample estimates:
##        cor 
## 0.03531093

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.853. Nilai koefisien korelasi r adalah sebesar 0.03531093 yang menunjukkan hubungan yang lemah dan positif ( berbanding lurus) antara variabel Dirawat dan workplaces_percent_change_from_baseline.

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 
## -815.18 -482.67  -75.76  487.57 1097.06 
## 
## Coefficients:
##                                                         Estimate Std. Error
## (Intercept)                                              2372.74     405.91
## mobilityjakarta$workplaces_percent_change_from_baseline     2.76      14.76
##                                                         t value Pr(>|t|)    
## (Intercept)                                               5.845 2.78e-06 ***
## mobilityjakarta$workplaces_percent_change_from_baseline   0.187    0.853    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 593.7 on 28 degrees of freedom
## Multiple R-squared:  0.001247,   Adjusted R-squared:  -0.03442 
## F-statistic: 0.03496 on 1 and 28 DF,  p-value: 0.853
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")