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

Referensi

https://rpubs.com/suhartono-uinmaliki/870470

https://www.google.com/covid19/mobility/?hl=id