Membangun Regresi Linier Sederhana pada Data Google Mobility Index
210605110104_Moch Hasbi Ashidqy
3/1/2022
Prodi : Teknik Informatika
Lembaga : UIN Maulana Malik Ibrahim Malang
library(readr)
mobility_index <- read_csv("2020_ID_Region_Mobility_Report.csv")## Rows: 11235 Columns: 15
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr (5): country_region_code, country_region, sub_region_1, iso_3166_2_code...
## dbl (6): retail_and_recreation_percent_change_from_baseline, grocery_and_ph...
## lgl (3): sub_region_2, metro_area, census_fips_code
## date (1): date
##
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.mobility_index## # A tibble: 11,235 x 15
## country_region_code country_region sub_region_1 sub_region_2 metro_area
## <chr> <chr> <chr> <lgl> <lgl>
## 1 ID Indonesia <NA> NA NA
## 2 ID Indonesia <NA> NA NA
## 3 ID Indonesia <NA> NA NA
## 4 ID Indonesia <NA> NA NA
## 5 ID Indonesia <NA> NA NA
## 6 ID Indonesia <NA> NA NA
## 7 ID Indonesia <NA> NA NA
## 8 ID Indonesia <NA> NA NA
## 9 ID Indonesia <NA> NA NA
## 10 ID Indonesia <NA> NA NA
## # ... with 11,225 more rows, and 10 more variables: iso_3166_2_code <chr>,
## # census_fips_code <lgl>, place_id <chr>, date <date>,
## # retail_and_recreation_percent_change_from_baseline <dbl>,
## # grocery_and_pharmacy_percent_change_from_baseline <dbl>,
## # parks_percent_change_from_baseline <dbl>,
## # transit_stations_percent_change_from_baseline <dbl>,
## # workplaces_percent_change_from_baseline <dbl>, ...library(tidyverse)## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.5 v dplyr 1.0.8
## v tibble 3.1.6 v stringr 1.4.0
## v tidyr 1.2.0 v forcats 0.5.1
## v purrr 0.3.4## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()mobilJK <- mobility_index %>%
filter(iso_3166_2_code== "ID-JK")
mobilJK## # A tibble: 321 x 15
## country_region_code country_region sub_region_1 sub_region_2 metro_area
## <chr> <chr> <chr> <lgl> <lgl>
## 1 ID Indonesia Jakarta NA NA
## 2 ID Indonesia Jakarta NA NA
## 3 ID Indonesia Jakarta NA NA
## 4 ID Indonesia Jakarta NA NA
## 5 ID Indonesia Jakarta NA NA
## 6 ID Indonesia Jakarta NA NA
## 7 ID Indonesia Jakarta NA NA
## 8 ID Indonesia Jakarta NA NA
## 9 ID Indonesia Jakarta NA NA
## 10 ID Indonesia Jakarta NA NA
## # ... with 311 more rows, and 10 more variables: iso_3166_2_code <chr>,
## # census_fips_code <lgl>, place_id <chr>, date <date>,
## # retail_and_recreation_percent_change_from_baseline <dbl>,
## # grocery_and_pharmacy_percent_change_from_baseline <dbl>,
## # parks_percent_change_from_baseline <dbl>,
## # transit_stations_percent_change_from_baseline <dbl>,
## # workplaces_percent_change_from_baseline <dbl>, ...mobilJTup <- filter(mobilJK, "2020-12-01" < date & date < "2020-12-31")
mobilJTup## # A tibble: 29 x 15
## country_region_code country_region sub_region_1 sub_region_2 metro_area
## <chr> <chr> <chr> <lgl> <lgl>
## 1 ID Indonesia Jakarta NA NA
## 2 ID Indonesia Jakarta NA NA
## 3 ID Indonesia Jakarta NA NA
## 4 ID Indonesia Jakarta NA NA
## 5 ID Indonesia Jakarta NA NA
## 6 ID Indonesia Jakarta NA NA
## 7 ID Indonesia Jakarta NA NA
## 8 ID Indonesia Jakarta NA NA
## 9 ID Indonesia Jakarta NA NA
## 10 ID Indonesia Jakarta NA NA
## # ... with 19 more rows, and 10 more variables: iso_3166_2_code <chr>,
## # census_fips_code <lgl>, place_id <chr>, date <date>,
## # retail_and_recreation_percent_change_from_baseline <dbl>,
## # grocery_and_pharmacy_percent_change_from_baseline <dbl>,
## # parks_percent_change_from_baseline <dbl>,
## # transit_stations_percent_change_from_baseline <dbl>,
## # workplaces_percent_change_from_baseline <dbl>, ...library(ggplot2)
library(reshape2)##
## Attaching package: 'reshape2'## The following object is masked from 'package:tidyr':
##
## smithsx<-mobilJTup$date
retail <- mobilJTup$retail_and_recreation_percent_change_from_baseline
grocery <- mobilJTup$grocery_and_pharmacy_percent_change_from_baseline
park <- mobilJTup$parks_percent_change_from_baseline
station <- mobilJTup$transit_stations_percent_change_from_baseline
workplace <- mobilJTup$workplaces_percent_change_from_baseline
residental <- mobilJTup$residential_percent_change_from_baseline
df <- data.frame(x, retail, grocery, park, station, workplace,residental )
# melt the data to a long format
df2 <- melt(data = df, id.vars = "x")
# plot, using the aesthetics argument 'colour'
ggplot(data = df2, aes(x = x, y = value, colour = variable))+
geom_point() +
geom_line() +
theme(legend.justification = "top") +
labs(title = "Google Mobility Index",
subtitle = "Propinsi DKI Jakarta Indonesia 2020",
y = "Mobility", x = "Date") +
theme(axis.text.x = element_text(angle = -90))
dim(mobility_index)## [1] 11235 15Regrasi Linier Sederhana (Simple Linear Regression)
Pada pembahasan pembentukan model linier sederhana menggunakan dataset google mobility index dengan jumlah observasi sebesar 29 observasi. Pada contoh kali ini kita akan mencoba membentuk model dengan variabel dependen berupa medv (median harga rumah) dan variabel independen berupa retail_and_recreation_percent_change_from_baseline dengan mobilJTup$grocery_and_pharmacy_percent_change_from_baseline. Berikut adalh sintaks untuk membentuk model tersebut:
library(MASS)##
## Attaching package: 'MASS'## The following object is masked from 'package:dplyr':
##
## selectlm.fit <- lm(mobility_index$retail_and_recreation_percent_change_from_baseline~mobility_index$grocery_and_pharmacy_percent_change_from_baseline, data=mobility_index)
anova(lm.fit)## Analysis of Variance Table
##
## Response: mobility_index$retail_and_recreation_percent_change_from_baseline
## Df Sum Sq
## mobility_index$grocery_and_pharmacy_percent_change_from_baseline 1 1535036
## Residuals 11134 710674
## Mean Sq
## mobility_index$grocery_and_pharmacy_percent_change_from_baseline 1535036
## Residuals 64
## F value
## mobility_index$grocery_and_pharmacy_percent_change_from_baseline 24049
## Residuals
## Pr(>F)
## mobility_index$grocery_and_pharmacy_percent_change_from_baseline < 2.2e-16 ***
## Residuals
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1summary(lm.fit)##
## Call:
## lm(formula = mobility_index$retail_and_recreation_percent_change_from_baseline ~
## mobility_index$grocery_and_pharmacy_percent_change_from_baseline,
## data = mobility_index)
##
## Residuals:
## Min 1Q Median 3Q Max
## -46.217 -4.704 -0.009 4.688 26.819
##
## Coefficients:
## Estimate
## (Intercept) -14.993747
## mobility_index$grocery_and_pharmacy_percent_change_from_baseline 0.869440
## Std. Error
## (Intercept) 0.077991
## mobility_index$grocery_and_pharmacy_percent_change_from_baseline 0.005606
## t value
## (Intercept) -192.2
## mobility_index$grocery_and_pharmacy_percent_change_from_baseline 155.1
## Pr(>|t|)
## (Intercept) <2e-16 ***
## mobility_index$grocery_and_pharmacy_percent_change_from_baseline <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 7.989 on 11134 degrees of freedom
## (99 observations deleted due to missingness)
## Multiple R-squared: 0.6835, Adjusted R-squared: 0.6835
## F-statistic: 2.405e+04 on 1 and 11134 DF, p-value: < 2.2e-16plot(lm.fit)
# influential observation
# observasi > percentil 50
# tidak ada observasi dengan jarak cook yang extrim
cooksD <- cooks.distance(lm.fit)
p50 <- qf(0.5, df1=2, df2=560-2)
any(cooksD>p50)## [1] FALSE# varians bersifat konstan
# (varians tidak konstan)
library(lmtest)## Warning: package 'lmtest' was built under R version 4.1.3## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numericbptest(lm.fit)##
## studentized Breusch-Pagan test
##
## data: lm.fit
## BP = 556.44, df = 1, p-value < 2.2e-16# error bersifat independen
# (error tidak bersifat independen)
dwtest(lm.fit, alternative = "two.sided")##
## Durbin-Watson test
##
## data: lm.fit
## DW = 0.18475, p-value < 2.2e-16
## alternative hypothesis: true autocorrelation is not 0# deteksi outlier (stdres > 2)
sres <- rstandard(lm.fit)
sres[which(abs(sres)>2)] # nomor observasi outlier## 97 98 99 323 324 329 331 337
## -2.433440 -2.264726 -3.157287 2.051030 2.268680 2.094470 2.219643 2.034681
## 338 345 346 418 419 420 488 648
## 2.083730 2.317728 2.094470 -2.363474 -2.215998 -3.550939 -2.576402 2.181429
## 650 681 967 1035 1060 1061 1062 1130
## 2.001987 -2.542519 2.045443 -2.020464 -2.401215 -2.814662 -3.816271 -3.801467
## 1289 1292 1294 1306 1308 1310 1311 1382
## 2.029102 2.001987 2.045443 2.007613 2.051030 2.018334 2.219643 -2.166754
## 1383 1607 1618 1632 1633 2254 2257 2259
## -2.781760 2.078127 2.018334 2.388282 2.023968 2.018334 2.094470 2.001987
## 2275 2569 2570 2571 2572 2573 2574 2575
## 2.061784 2.203299 2.143507 2.312130 2.170615 2.622291 2.137936 2.295788
## 2576 2577 2578 2579 2580 2582 2583 2590
## 2.312130 2.420961 2.295788 2.328472 2.497118 2.203299 2.377506 2.192554
## 2592 2593 2594 2595 2596 2597 2666 2667
## 2.377506 2.143507 2.393854 2.159855 2.312130 2.034681 -2.047140 -3.108785
## 2892 2899 2988 3219 3309 3532 3534 3535
## 2.072588 2.078127 -2.079712 2.328472 -3.832561 2.285028 2.012763 2.029102
## 3536 3537 3539 3540 3541 3542 3543 3544
## 2.263109 2.029102 2.361160 2.061784 2.154275 2.513455 2.480781 2.045443
## 3546 3550 3551 3553 3555 3556 3557 3558
## 2.361160 2.186957 2.001987 2.143507 2.203299 2.453645 2.203299 2.328472
## 3560 3845 3855 3865 3951 4033 4035 4061
## 2.301378 -2.183382 2.078127 2.720334 -2.389903 2.208905 2.034681 2.100082
## 4178 4180 4215 4216 4217 4219 4220 4221
## 2.078127 2.192554 -2.031119 -2.597287 -2.461509 -2.096557 -2.265118 -2.063836
## 4223 4224 4226 4228 4230 4231 4237 4238
## -2.472104 -2.319944 -2.047477 -2.156298 -2.309385 -2.266100 -2.184183 -2.216945
## 4242 4243 4244 4249 4250 4251 4252 4254
## -2.270836 -2.108121 -2.450971 -2.211126 -2.711892 -2.728271 -2.434587 -2.102305
## 4256 4257 4258 4259 4260 4261 4262 4263
## -2.603078 -2.521207 -2.913140 -2.635837 -2.346922 -2.396021 -2.488470 -2.580921
## 4264 4265 4266 4267 4268 4269 4270 4271
## -2.858287 -3.358992 -3.174091 -2.112920 -3.135687 -2.607935 -3.772313 -3.445818
## 4272 4273 4274 4275 4276 4277 4278 4279
## -4.229547 -2.559788 -2.461509 -2.597287 -2.346922 -2.531833 -2.515473 -2.923732
## 4280 4281 4282 4283 4284 4285 4286 4287
## -2.630023 -2.548194 -2.357582 -2.265118 -2.357582 -2.216052 -2.716754 -2.673374
## 4293 4294 4398 4399 4402 4403 4404 4405
## -2.107230 -2.047477 -2.308522 -2.189016 -2.134299 -2.477125 -2.117952 -2.493472
## 4406 4407 4413 4495 4496 4498 4499 4500
## -2.232406 -2.009126 -2.014763 2.235987 2.219643 2.219643 2.312130 2.235987
## 4501 4502 4503 4504 4505 4506 4507 4508
## 2.235987 2.328472 2.344816 2.078127 2.268680 2.235987 2.235987 2.143507
## 4509 4510 4511 4516 4517 4519 4520 4521
## 2.361160 2.410202 2.034681 2.143507 2.051030 2.034681 2.143507 2.159855
## 4522 4593 4914 5137 5163 5459 5460 5467
## 2.034681 -2.068810 -3.097667 2.018334 2.067379 2.393854 2.312130 2.497118
## 5478 5480 5481 5482 5483 5484 5485 5549
## 2.083730 2.127160 2.094470 2.045443 2.143507 2.486333 2.159855 -2.003552
## 5553 5554 5555 5556 5624 5771 5778 5780
## -2.150428 -2.564260 -2.863579 -3.185127 -3.017339 -2.776883 -3.354158 2.067379
## 5847 5862 5863 5869 5870 5874 5875 5876
## -2.716449 -2.177748 -2.101606 -2.063377 -2.155883 -3.310345 -3.386717 -4.165745
## 5877 5919 5925 5944 5945 5952 5961 5996
## -5.789491 -2.188551 -2.057900 -2.379110 -4.553050 -2.128721 -2.096087 -2.063455
## 6000 6002 6003 6005 6007 6008 6009 6010
## -2.275610 -2.384469 -2.335506 -2.101455 -2.536931 -2.830967 -2.928815 -3.016167
## 6011 6012 6013 6014 6015 6016 6017 6021
## -2.395425 -2.063455 -2.068810 -2.705767 -2.156030 -2.237600 -2.439059 -2.575337
## 6022 6023 6024 6025 6026 6029 6030 6031
## -2.221285 -2.624243 -2.967279 -2.003527 -2.248615 -2.390132 -2.482729 -2.733152
## 6032 6034 6037 6040 6041 6042 6043 6044
## -2.515339 -2.063455 -2.161358 -2.248615 -2.559037 -3.027329 -2.499034 -3.076200
## 6045 6046 6047 6048 6049 6050 6051 6052
## -2.439059 -2.264925 -2.809473 -2.313857 -2.825769 -2.063455 -2.264925 -2.564260
## 6053 6054 6055 6056 6057 6058 6059 6060
## -2.079771 -2.482729 -2.531645 -2.765753 -2.749452 -3.402998 -2.907260 -2.330169
## 6061 6062 6063 6064 6065 6066 6067 6068
## -2.471680 -2.297546 -2.983574 -2.673155 -2.863579 -3.048764 -2.379072 -3.185127
## 6069 6070 6071 6072 6073 6074 6075 6076
## -3.588347 -4.536818 -3.850229 -4.444023 -4.286284 -3.664777 -4.051994 -4.504359
## 6077 6078 6079 6080 6081 6082 6083 6084
## -2.275610 -3.801467 -4.302522 -4.520588 -3.228928 -3.511943 -3.991736 -4.460260
## 6085 6086 6087 6088 6089 6090 6091 6092
## -4.427786 -4.455679 -4.536818 -3.991736 -3.910482 -4.379084 -4.645858 -4.613409
## 6093 6094 6095 6096 6097 6098 6099 6100
## -3.299170 -3.658490 -3.277775 -3.959231 -3.991736 -4.706249 -5.308237 2.301378
## 6420 6742 6743 6744 6745 6746 6747 6748
## -2.439059 2.285028 2.578818 2.388282 2.420961 2.513455 2.529794 2.638629
## 6749 6750 6751 6752 6753 6754 6755 6756
## 2.203299 2.497118 2.480781 2.546134 2.513455 2.355608 2.856303 2.437302
## 6757 6758 6759 6760 6761 6762 6763 6764
## 2.469988 2.203299 2.235987 2.344816 2.437302 2.486333 2.328472 2.045443
## 6766 6767 6768 6769 6770 7055 7062 7064
## 2.219643 2.562475 2.219643 2.562475 2.001987 -2.145574 -2.183382 2.078127
## 7070 7071 7482 7705 7712 7716 7718 7719
## 2.094470 2.061784 -2.422566 2.143507 2.437302 2.012763 2.562475 2.361160
## 7720 7724 7725 7726 7727 7728 7729 7730
## 2.110815 2.143507 2.018334 2.268680 2.235987 2.143507 2.176204 2.285028
## 7731 7732 7803 7871 8041 8124 8347 8415
## 2.159855 2.094470 -3.206565 -2.194478 2.982036 -2.052575 2.001987 -2.210434
## 8444 8445 8667 8766 8990 8991 8992 8997
## -2.139550 -2.841627 -2.319186 -2.596744 2.034681 2.094470 2.110815 2.034681
## 8998 9010 9011 9087 9392 9393 9394 9395
## 2.045443 2.143507 2.051030 -2.096557 -4.311315 -4.001239 -4.066721 -3.805836
## 9396 9397 9398 9399 9400 9401 9402 9403
## -3.968511 -4.077325 -4.354720 -4.381841 -4.256668 -4.539689 -4.262248 -3.543912
## 9404 9405 9406 9407 9408 9409 9410 9411
## -5.029615 -4.109727 -5.580515 -5.040752 -5.454064 -3.130762 -3.260860 -3.614467
## 9412 9413 9414 9415 9416 9417 9418 9419
## -3.304302 -3.984550 -3.260860 -3.788652 -3.587336 -3.298791 -3.456626 -3.423966
## 9420 9421 9422 9423 9424 9425 9426 9427
## -3.641663 -3.004937 -3.146449 -3.053957 -2.629418 -2.754591 -2.814423 -2.672916
## 9428 9429 9430 9431 9432 9433 9434 9436
## -2.379072 -2.629418 -2.520584 -2.237560 -2.346396 -2.313725 -2.313725 -2.362733
## 9437 9441 9442 9443 9444 9447 9448 9450
## -2.177748 -2.389903 -2.112387 -2.422566 -2.112387 -2.057900 -2.123219 -2.090558
## 9476 9539 9630 9634 9726 9727 9728 9729
## -2.934691 -2.134103 -2.150769 2.078127 -2.096049 -2.079712 -2.749102 -3.255283
## 9952 9966 9970 9971 9976 9977 9978 9979
## 2.034681 2.159855 2.001987 2.018334 2.127160 2.176204 2.252333 2.094470
## 10050 10273 10274 10279 10283 10284 10285 10286
## -2.313725 2.034681 2.268680 2.110815 2.186957 2.088924 2.061784 2.453645
## 10287 10288 10290 10291 10292 10293 10295 10297
## 2.279448 2.219643 2.143507 2.285028 2.034681 2.235987 2.241612 2.317728
## 10298 10299 10300 10301 10304 10585 10586 10587
## 2.334080 2.143507 2.203299 2.110815 2.018334 -2.020329 -2.989729 -2.362733
## 10593 10604 10606 10607 10608 10609 10610 10611
## -3.506999 2.312130 2.170615 2.361160 2.513455 2.965143 2.203299 2.622291
## 10612 10613 10614 10615 10616 10617 10618 10620
## 2.388282 2.812821 2.578818 2.453645 3.356998 2.159855 2.578818 2.094470
## 10623 10625 10692 10920 10922 10927 10941 11010
## 2.377506 2.012763 -2.204970 2.001987 2.203299 2.001987 2.001987 -2.319186
## 11011 11012 11013
## -2.226640 -2.896195 -3.538460# influential observation
# observasi > percentil 50
# tidak ada observasi dengan jarak cook yang extrim
cooksD <- cooks.distance(lm.fit)
p50 <- qf(0.5, df1=2, df2=560-2)
any(cooksD>p50)## [1] FALSEReferensi