Dosen Pengampu : Prof. Dr. Suhartono, M.Kom
Lembaga : Universitas Islam Negeri Maulana Malik Ibrahim Malang
Fakultas : Sains dan Teknologi
Jurusan : Teknik Informatika
Kelas : (C) Linear Algebra
NIM : 210605110035
library(readxl)
## Warning: package 'readxl' was built under R version 4.1.2
Data <- read_excel(path = "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.6 v dplyr 1.0.8
## v tidyr 1.2.0 v stringr 1.4.0
## v readr 2.1.2 v forcats 0.5.1
## Warning: package 'ggplot2' was built under R version 4.1.2
## Warning: package 'tibble' was built under R version 4.1.2
## Warning: package 'tidyr' was built under R version 4.1.3
## Warning: package 'readr' was built under R version 4.1.3
## Warning: package 'purrr' was built under R version 4.1.3
## Warning: package 'dplyr' was built under R version 4.1.3
## Warning: package 'forcats' 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-JK")
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 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 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 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 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-12-01" < date & date < "2021-12-31")
DataUp
## # 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)
## Warning: package 'reshape2' was built under R version 4.1.3
##
## Attaching package: 'reshape2'
## The following object is masked from 'package:tidyr':
##
## smiths
x <- 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] 29 15
library(MASS)
##
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
##
## select
lm.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 231.96 231.956
## Residuals 27 111.08 4.114
## F value Pr(>F)
## DataUp$grocery_and_pharmacy_percent_change_from_baseline 56.382 4.459e-08 ***
## Residuals
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
summary(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
## -4.7903 -1.0959 0.1265 1.5153 3.1265
##
## Coefficients:
## Estimate Std. Error
## (Intercept) -13.76495 1.04896
## DataUp$grocery_and_pharmacy_percent_change_from_baseline 0.69441 0.09248
## t value Pr(>|t|)
## (Intercept) -13.123 3.12e-13 ***
## DataUp$grocery_and_pharmacy_percent_change_from_baseline 7.509 4.46e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.028 on 27 degrees of freedom
## Multiple R-squared: 0.6762, Adjusted R-squared: 0.6642
## F-statistic: 56.38 on 1 and 27 DF, p-value: 4.459e-08
plot(lm.fit)
shapiro.test(residuals(lm.fit))
##
## Shapiro-Wilk normality test
##
## data: residuals(lm.fit)
## W = 0.96116, p-value = 0.3509
sres <- rstandard(lm.fit)
sres[which(abs(sres)>2)]
## 1 6
## -2.123282 -2.421042
cooksD <- cooks.distance(lm.fit)
p50 <- qf(0.5, df1=2, df2=560-2)
any(cooksD>p50)
## [1] FALSE