Membangun Regresi Linier Sederhana pada Data Google Mobility Index
Muizzul Azizah Oktavianing Putri
6/5/2022
Dosen Pengampu : Prof. Dr. Suhartono, M.Kom
Lembaga : Universitas Islam Negeri Maulana Malik Ibrahim Malang
Jurusan : Teknik Informatika
library(readxl)## Warning: package 'readxl' was built under R version 4.1.3Data <- read_excel(path = "C:/Users/Putri Oktavia/OneDrive/Dokumen/Mobility_Index_2021.xlsx")
Data## # A tibble: 12,775 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 12,765 more rows, and 10 more variables: iso_3166_2_code <chr>,
## # census_fips_code <lgl>, place_id <chr>, date <dttm>,
## # 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)## Warning: package 'tidyverse' was built under R version 4.1.3## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.4 v dplyr 1.0.8
## v tidyr 1.1.4 v stringr 1.4.0
## v readr 2.0.2 v forcats 0.5.1## Warning: package 'dplyr' was built under R version 4.1.3## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()Data1 <- Data %>%
filter(iso_3166_2_code== "ID-KI")
Data1## # A tibble: 365 x 15
## country_region_code country_region sub_region_1 sub_region_2 metro_area
## <chr> <chr> <chr> <lgl> <lgl>
## 1 ID Indonesia East Kalimantan NA NA
## 2 ID Indonesia East Kalimantan NA NA
## 3 ID Indonesia East Kalimantan NA NA
## 4 ID Indonesia East Kalimantan NA NA
## 5 ID Indonesia East Kalimantan NA NA
## 6 ID Indonesia East Kalimantan NA NA
## 7 ID Indonesia East Kalimantan NA NA
## 8 ID Indonesia East Kalimantan NA NA
## 9 ID Indonesia East Kalimantan NA NA
## 10 ID Indonesia East Kalimantan NA NA
## # ... with 355 more rows, and 10 more variables: iso_3166_2_code <chr>,
## # census_fips_code <lgl>, place_id <chr>, date <dttm>,
## # 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>, ...Data1$date <- as.Date(Data1$date)
Data1## # A tibble: 365 x 15
## country_region_code country_region sub_region_1 sub_region_2 metro_area
## <chr> <chr> <chr> <lgl> <lgl>
## 1 ID Indonesia East Kalimantan NA NA
## 2 ID Indonesia East Kalimantan NA NA
## 3 ID Indonesia East Kalimantan NA NA
## 4 ID Indonesia East Kalimantan NA NA
## 5 ID Indonesia East Kalimantan NA NA
## 6 ID Indonesia East Kalimantan NA NA
## 7 ID Indonesia East Kalimantan NA NA
## 8 ID Indonesia East Kalimantan NA NA
## 9 ID Indonesia East Kalimantan NA NA
## 10 ID Indonesia East Kalimantan NA NA
## # ... with 355 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>, ...DataUp <- filter(Data1, "2021-01-01" < date & date < "2021-12-31")
DataUp## # A tibble: 363 x 15
## country_region_code country_region sub_region_1 sub_region_2 metro_area
## <chr> <chr> <chr> <lgl> <lgl>
## 1 ID Indonesia East Kalimantan NA NA
## 2 ID Indonesia East Kalimantan NA NA
## 3 ID Indonesia East Kalimantan NA NA
## 4 ID Indonesia East Kalimantan NA NA
## 5 ID Indonesia East Kalimantan NA NA
## 6 ID Indonesia East Kalimantan NA NA
## 7 ID Indonesia East Kalimantan NA NA
## 8 ID Indonesia East Kalimantan NA NA
## 9 ID Indonesia East Kalimantan NA NA
## 10 ID Indonesia East Kalimantan NA NA
## # ... with 353 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)## Warning: package 'reshape2' was built under R version 4.1.3##
## Attaching package: 'reshape2'## The following object is masked from 'package:tidyr':
##
## smithsx <- DataUp$date
retail <- DataUp$retail_and_recreation_percent_change_from_baseline
grocery <- DataUp$grocery_and_pharmacy_percent_change_from_baseline
park <- DataUp$parks_percent_change_from_baseline
station <- DataUp$transit_stations_percent_change_from_baseline
workplace <- DataUp$workplaces_percent_change_from_baseline
residental <- DataUp$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 2022",
y = "Mobility", x = "Date") +
theme(axis.text.x = element_text(angle = -90))
dim(DataUp)## [1] 363 15library(MASS)## Warning: package 'MASS' was built under R version 4.1.2##
## Attaching package: 'MASS'## The following object is masked from 'package:dplyr':
##
## selectlm.fit <- lm(DataUp$retail_and_recreation_percent_change_from_baseline~DataUp$grocery_and_pharmacy_percent_change_from_baseline, data=DataUp)
anova(lm.fit)## Analysis of Variance Table
##
## Response: DataUp$retail_and_recreation_percent_change_from_baseline
## Df Sum Sq Mean Sq
## DataUp$grocery_and_pharmacy_percent_change_from_baseline 1 49725 49725
## Residuals 361 10087 28
## F value Pr(>F)
## DataUp$grocery_and_pharmacy_percent_change_from_baseline 1779.6 < 2.2e-16 ***
## Residuals
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1summary(lm.fit)##
## Call:
## lm(formula = DataUp$retail_and_recreation_percent_change_from_baseline ~
## DataUp$grocery_and_pharmacy_percent_change_from_baseline,
## data = DataUp)
##
## Residuals:
## Min 1Q Median 3Q Max
## -24.8459 -2.8643 0.6818 3.6071 16.3940
##
## Coefficients:
## Estimate Std. Error
## (Intercept) -23.14126 0.46134
## DataUp$grocery_and_pharmacy_percent_change_from_baseline 0.85055 0.02016
## t value Pr(>|t|)
## (Intercept) -50.16 <2e-16 ***
## DataUp$grocery_and_pharmacy_percent_change_from_baseline 42.19 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5.286 on 361 degrees of freedom
## Multiple R-squared: 0.8314, Adjusted R-squared: 0.8309
## F-statistic: 1780 on 1 and 361 DF, p-value: < 2.2e-16plot(lm.fit)
shapiro.test(residuals(lm.fit))##
## Shapiro-Wilk normality test
##
## data: residuals(lm.fit)
## W = 0.9567, p-value = 7.365e-09library(lmtest)## Warning: package 'lmtest' was built under R version 4.1.3## Loading required package: zoo## Warning: package 'zoo' was built under R version 4.1.3##
## 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 = 15.14, df = 1, p-value = 9.985e-05dwtest(lm.fit, alternative = "two.sided")##
## Durbin-Watson test
##
## data: lm.fit
## DW = 0.53907, p-value < 2.2e-16
## alternative hypothesis: true autocorrelation is not 0sres <- rstandard(lm.fit)
sres[which(abs(sres)>2)]## 127 130 131 132 190 197 198 199
## -2.073287 -2.254314 -4.790455 3.118025 -2.599319 -3.062992 -2.447285 -2.994295
## 201 202 203 204 205 208 211 212
## -2.096823 -2.192210 -2.305234 -3.148170 -2.532988 -2.059216 -2.901896 -2.200899
## 218 349 360
## -2.144130 2.100980 2.032782cooksD <- cooks.distance(lm.fit)
p50 <- qf(0.5, df1=2, df2=560-2)
any(cooksD>p50)## [1] FALSE