Regresi Nonparametrik dengan Pendekatan Smoothing Spline pada Data Google Mobility Index dan Covid 19 di DKI Jakarta Juni 2020

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 digunakan 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 Juli 2020.

2. Data Google Mobility Index dan Covid 19 di Jakarta Juni 2020

3. Data Deskriptif

library(jmv)
descriptives(data, 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                  1416.267                                  -32.46667   
##    Median                1396.000                                  -34.00000   
##    Standard deviation    180.0467                                   10.13609   
##    Minimum               951.0000                                  -68.00000   
##    Maximum               1794.000                                  -15.00000   
##  -----------------------------------------------------------------------------

4. Perbandingan Pendekatan

library(npreg)
mod.ss <- ss(data$Tanggal,data$Dirawat, nknots = 10)
data$prediksi_ss <- mod.ss$y
data

mod.smsp <- smooth.spline( data$Tanggal,data$Dirawat, nknots = 10)
data$prediksi_smsp <- mod.smsp$y
data

plot(data$Tanggal, data$Dirawat, col = 'black', lwd =4, type = 'l')

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

points(data$Tanggal,mod.ss$y , col = 'blue', lwd = 2, type = 'l')


legend("topleft", 
       legend = c("Real", "Model SS", "Trends"), 
       col = c("Black","blue","yellow"), lwd = 2, bty = "p")

mod.ss1 <- ss(data$Tanggal,data$workplaces_percent_change_from_baseline, nknots = 10)
data$prediksi_ss1 <- mod.ss1$y
data

mod.smsp1 <- smooth.spline( data$Tanggal,data$workplaces_percent_change_from_baseline, nknots = 10)
data$prediksi_smsp1 <- mod.smsp1$y
data

# Hasil plot

plot(data$Tanggal, data$workplaces_percent_change_from_baseline, col = 'black', lwd = 4, type = 'l')

# add lm fit
abline(coef(lm( data$workplaces_percent_change_from_baseline ~ data$Tanggal  , nilai = data)), col = 'green', lwd = 3, type = 'l')
lines(data$Tanggal, data$prediksi_ss1 , type = 'l', col = 'red', lwd = 2)
lines(data$Tanggal, data$prediksi_smsp1, type = 'l', col = 'blue', lwd = 3)

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(data$Dirawat, data$workplaces_percent_change_from_baseline)

## 
##  Pearson's product-moment correlation
## 
## data:  data$Dirawat and data$workplaces_percent_change_from_baseline
## t = -3.0402, df = 28, p-value = 0.005085
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.7278153 -0.1680658
## sample estimates:
##        cor 
## -0.4981713

Dari output tersebut dapat kita simpulkan bahwa tidak adanya hubungan yang signifikan antara mobilityjakarta Dirawat dan data mobility workplaces_percent_change_from_baseline (p-value<-3,04). 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(data$Dirawat ~ data$workplaces_percent_change_from_baseline, nilai = data)
summary(model)

## 
## Call:
## lm(formula = data$Dirawat ~ data$workplaces_percent_change_from_baseline, 
##     nilai = data)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -469.99  -56.01  -12.38   80.70  267.11 
## 
## Coefficients:
##                                              Estimate Std. Error t value
## (Intercept)                                  1128.970     98.852   11.42
## data$workplaces_percent_change_from_baseline   -8.849      2.911   -3.04
##                                              Pr(>|t|)    
## (Intercept)                                  4.74e-12 ***
## data$workplaces_percent_change_from_baseline  0.00508 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 158.9 on 28 degrees of freedom
## Multiple R-squared:  0.2482, Adjusted R-squared:  0.2213 
## F-statistic: 9.243 on 1 and 28 DF,  p-value: 0.005085

data$prediksi_model <- model$fitted.values
data

# 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, type = 'l', col = rgb(0, 0, 1, alpha = 0.5), ...)
    # lines(density(x), col = 2, lwd = 2, type = 'l') # Uncomment to add density lines
}
# Menyetarakan berdasarkan formula
pairs(data$Dirawat~data$workplaces_percent_change_from_baseline, nilai = data,
      upper.panel = NULL,         # Disabling the upper panel
      diag.panel = panel.hist)    # Adding the histograms

# plot method
plot(data$Tanggal, data$Dirawat, col = 'black', lwd =4, type = 'l')

#plot(mod.ss)
# add lm fit
abline(coef(lm( data$Dirawat ~ data$Tanggal  , nilai = data)), col = 'red', lwd =4)
rug(data$Tanggal)  # add rug to plot


lines(data$Tanggal,mod.ss$y , col = 'blue', lwd = 3)

#plot(mod.smsp)

lines(data$Tanggal, data$prediksi_model, col = 'cyan', lwd = 3)
legend("topleft", 
       legend = c("Real", "Model SS", "Trends", "Regresi Nonparametrik"), 
       col = c("Black","blue","red","cyan"), lwd = 2, bty = "p")