Membangun Model Linier dengan Interaksi Antar Variabel Prediktor pada data Google Mobility Index di Jakarta bulan Oktober 2021
3/28/202 Author : Lia Wahyuliningtyas Mata Kuliah : Pengantar Konsep Pemrograman Algoritma dan Struktur Data Magister Teknik Informatika Dosen Pengampu : Prof Dr Suhartono M.Kom UIN Maulana Malik Ibrahim Malang
library(readxl)
#baca data excel
mobilindexjkt <- read_excel("2021_mobility_jkt_okt.xlsx")
covidjkt <- read_excel("covid_jkt_okt.xlsx")
datagab <- read_excel("datagab.xlsx")
datagab2 <- read_excel("Data_Gab2.xlsx")retail <- mobilindexjkt$retail_and_recreation_percent_change_from_baseline
grocery <- mobilindexjkt$grocery_and_pharmacy_percent_change_from_baseline
park <- mobilindexjkt$parks_percent_change_from_baseline
station <- mobilindexjkt$transit_stations_percent_change_from_baseline
workplace <- mobilindexjkt$workplaces_percent_change_from_baseline
residental <- mobilindexjkt$residential_percent_change_from_baselinedate <- mobilindexjkt$date
date <- datagab$date
positif <- datagab$positif
retail <- datagab$retailPositif <- covidjkt$Positif## Warning: Unknown or uninitialised column: `Positif`.Dirawat <- covidjkt$Dirawat
Sembuh <- covidjkt$Sembuh
Meninggal <- covidjkt$Meninggal
Isolasi_Mandiri <- covidjkt$SelfIsolation## Warning: Unknown or uninitialised column: `SelfIsolation`.Positif <- datagab2$positif
Retail <- datagab2$retail_and_recreation_percent_change_from_baseline
Grocery <- datagab2$grocery_and_pharmacy_percent_change_from_baseline
Park <- datagab2$parks_percent_change_from_baseline
Station <- datagab2$transit_stations_percent_change_from_baseline
Workplace <- datagab2$workplaces_percent_change_from_baseline
Residental <- datagab2$residential_percent_change_from_baseline#Visualisasi Data Menggunakan Fungsi plot(). #Fungsi plot() merupakan fungsi umum yang digunakan untuk membuat pola pada R.
summary(covidjkt)## Tanggal Nama_Kota POSITIF
## Min. :2021-10-01 00:00:00 Length:31 Min. :857916
## 1st Qu.:2021-10-08 12:00:00 Class :character 1st Qu.:858971
## Median :2021-10-16 00:00:00 Mode :character Median :860014
## Mean :2021-10-16 00:00:00 Mean :859866
## 3rd Qu.:2021-10-23 12:00:00 3rd Qu.:860815
## Max. :2021-10-31 00:00:00 Max. :861540
## Dirawat Sembuh Meninggal Self Isolation
## Min. :256.0 Min. :842715 Min. :13524 Min. : 618.0
## 1st Qu.:289.5 1st Qu.:843780 1st Qu.:13542 1st Qu.: 849.0
## Median :348.0 Median :845121 Median :13551 Median : 978.0
## Mean :357.8 Mean :844977 Mean :13549 Mean : 983.1
## 3rd Qu.:437.0 3rd Qu.:846121 3rd Qu.:13556 3rd Qu.:1202.0
## Max. :504.0 Max. :847021 Max. :13562 Max. :1285.0#dataframe KASUS POSITIF
dataku <- data.frame(date, retail, grocery, park, station, workplace, residental)library(ggplot2)
library(reshape2)## Warning: package 'reshape2' was built under R version 4.1.3dataku1 <- melt(data = dataku, id.vars = "date")
ggplot(data = dataku1, aes(x = date, y = value, colour = variable))+
geom_point() +
geom_line() +
theme(legend.justification = "top") +
labs(title = "Grafik Mobility Index",
subtitle = "Propinsi DKI Jakarta Indonesia Oktober 2021",
y = "Index Mobility", x = "Date") +
theme(axis.text.x = element_text(angle = -90))
head(datagab2)## # A tibble: 6 x 8
## date positif retail_and_recr~ grocery_and_pha~ parks_percent_c~
## <dttm> <dbl> <dbl> <dbl> <dbl>
## 1 2021-10-01 00:00:00 857916 -9 16 -29
## 2 2021-10-02 00:00:00 858071 -11 17 -32
## 3 2021-10-03 00:00:00 858198 -13 11 -39
## 4 2021-10-04 00:00:00 858347 -17 5 -39
## 5 2021-10-05 00:00:00 858419 -15 9 -39
## 6 2021-10-06 00:00:00 858622 -15 6 -35
## # ... with 3 more variables:
## # transit_stations_percent_change_from_baseline <dbl>,
## # workplaces_percent_change_from_baseline <dbl>,
## # residential_percent_change_from_baseline <dbl>p <- ggplot(datagab2, aes(x = date))
p <- p + geom_line(aes(y = Positif/10000, colour = "Positif"))
p <- p + geom_line(aes(y = Park, colour = "park"))
p <- p + geom_line(aes(y = Retail, colour = "retail"))
p <- p + geom_line(aes(y = Grocery, colour = "grocery"))
p <- p + geom_line(aes(y = Station, colour = "station"))
p <- p + geom_line(aes(y = Workplace, colour = "workplace"))
p <- p + geom_line(aes(y = Residental, colour = "residental"))
p <- p + scale_y_continuous(sec.axis = sec_axis(~.*0.1, name = "mobility"))
p
head(datagab)## # A tibble: 6 x 3
## date positif retail
## <dttm> <dbl> <dbl>
## 1 2021-10-01 00:00:00 857916 -9
## 2 2021-10-02 00:00:00 858071 -11
## 3 2021-10-03 00:00:00 858198 -13
## 4 2021-10-04 00:00:00 858347 -17
## 5 2021-10-05 00:00:00 858419 -15
## 6 2021-10-06 00:00:00 858622 -15p <- ggplot(datagab, aes(x = date))
p <- p + geom_line(aes(y = Positif/10000, colour = "Positif"))
p <- p + geom_line(aes(y = Retail, colour = "Retail"))
p <- p + scale_y_continuous(sec.axis = sec_axis(~.*0.1, name = "Retail"))
p
model <- lm(positif ~ retail)
summary(model)##
## Call:
## lm(formula = positif ~ retail)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1777.13 -786.01 71.05 913.76 1814.93
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 859405.67 823.40 1043.729 <2e-16 ***
## retail -31.94 55.37 -0.577 0.569
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1121 on 29 degrees of freedom
## Multiple R-squared: 0.01134, Adjusted R-squared: -0.02275
## F-statistic: 0.3327 on 1 and 29 DF, p-value: 0.5685anova(model)## Analysis of Variance Table
##
## Response: positif
## Df Sum Sq Mean Sq F value Pr(>F)
## retail 1 417812 417812 0.3327 0.5685
## Residuals 29 36414855 1255685plot(datagab$positif ~ mobilindexjkt$date, col = "red", pch = 20, cex = 1.5, main = "Kasus Positif Covid 19")
abline(model)
plot(cooks.distance(model), pch = 16, col = "red")
plot(model)
AIC(model)## [1] 527.2457BIC(model)## [1] 531.5477head(predict(model), n = 30)## 1 2 3 4 5 6 7 8
## 859693.1 859757.0 859820.9 859948.7 859884.8 859884.8 859820.9 859725.1
## 9 10 11 12 13 14 15 16
## 859789.0 859852.8 859916.7 859916.7 859884.8 859884.8 859789.0 859884.8
## 17 18 19 20 21 22 23 24
## 859980.6 860268.1 859916.7 859852.8 859980.6 859820.9 859884.8 859916.7
## 25 26 27 28 29 30
## 859916.7 859916.7 860012.5 859852.8 859597.3 859757.0plot(head(predict(model), n = 30))
head(resid(model), n = 30)## 1 2 3 4 5 6
## -1777.13043 -1686.01087 -1622.89130 -1601.65217 -1465.77174 -1262.77174
## 7 8 9 10 11 12
## -1049.89130 -804.07065 -767.95109 -691.83152 -714.71196 -571.71196
## 13 14 15 16 17 18
## -261.77174 -148.77174 71.04891 129.22826 164.40761 -16.05435
## 19 20 21 22 23 24
## 441.28804 608.16848 569.40761 812.10870 864.22826 963.28804
## 25 26 27 28 29 30
## 1045.28804 1082.28804 1091.46739 1382.16848 1733.69022 1669.98913coef(model)## (Intercept) retail
## 859405.66848 -31.94022datagab$residuals <- model$residuals
datagab$predicted <- model$fitted.values
datagab## # A tibble: 31 x 5
## date positif retail residuals predicted
## <dttm> <dbl> <dbl> <dbl> <dbl>
## 1 2021-10-01 00:00:00 857916 -9 -1777. 859693.
## 2 2021-10-02 00:00:00 858071 -11 -1686. 859757.
## 3 2021-10-03 00:00:00 858198 -13 -1623. 859821.
## 4 2021-10-04 00:00:00 858347 -17 -1602. 859949.
## 5 2021-10-05 00:00:00 858419 -15 -1466. 859885.
## 6 2021-10-06 00:00:00 858622 -15 -1263. 859885.
## 7 2021-10-07 00:00:00 858771 -13 -1050. 859821.
## 8 2021-10-08 00:00:00 858921 -10 -804. 859725.
## 9 2021-10-09 00:00:00 859021 -12 -768. 859789.
## 10 2021-10-10 00:00:00 859161 -14 -692. 859853.
## # ... with 21 more rowsscatter.smooth(x=datagab$date, y=datagab$positif, main="date")
boxplot(datagab$positif, main="positif", boxplot.stats(datagab$positif)$out)
Referensi: https://riwayat-file-covid-19-dki-jakarta-jakartagis.hub.arcgis.com/ https://www.google.com/covid19/mobility/ https://rpubs.com/suhartono-uinmaliki/870592