Pasi Haapakorva Sun Jan 20 20:34:13 2019
library(gt)
library(tidyverse)## -- Attaching packages ------------------------------------------------------------------------------------------------ tidyverse 1.2.1 --
## v ggplot2 3.1.0.9000 v purrr 0.2.5
## v tibble 2.0.1 v dplyr 0.8.0
## v tidyr 0.8.2 v stringr 1.3.1
## v readr 1.3.1 v forcats 0.3.0
## -- Conflicts --------------------------------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(here)## here() starts at C:/Users/pasih_000/Documents/rprojektit/gt_testi
# Here I'm loading data acquired from the City of Oulu about the number of cyclist passing an ecocounter
hep <- fs::dir_ls(here("data")) %>%
str_subset("ID_(89|96)") %>%
map(~ read_csv2(., col_types = "ccdcccdddddd", locale = locale(encoding = "ISO-8859-1")) %>% as_tibble())## Using ',' as decimal and '.' as grouping mark. Use read_delim() for more control.
## Using ',' as decimal and '.' as grouping mark. Use read_delim() for more control.
hep2 <- hep %>%
bind_rows() %>%
rename_all(tolower) %>%
mutate(kuukausi = as.numeric(kuukausi)) %>%
group_by(mittausid, vuosi, kuukausi) %>%
summarise(pp = sum(pp_yht)) %>%
ungroup() %>%
complete(mittausid, vuosi, kuukausi, fill = list(pp = 0)) %>%
filter(!(vuosi == 2018 & kuukausi > 9))
hep2 %>%
ggplot(aes(lubridate::make_date(vuosi, kuukausi), pp, color = mittausid)) +
geom_line()
# There seems to be some problems with the data. Some periods have less
# observations. Let's replace them with previous years' values.
hep2[c(hep2$kuukausi %in% 8:11 & hep2$mittausid == 96 & hep2$vuosi == 2012), 4] <-
hep2[c(hep2$kuukausi %in% 8:11 & hep2$mittausid == 96 & hep2$vuosi == 2011), 4]
hep2[c(hep2$kuukausi %in% 4:6 & hep2$mittausid == 96 & hep2$vuosi == 2013), 4] <-
hep2[c(hep2$kuukausi %in% 4:6 & hep2$mittausid == 96 & hep2$vuosi == 2012), 4]
hep2[c(hep2$kuukausi %in% 10:12 & hep2$mittausid == 96 & hep2$vuosi == 2014), 4] <-
hep2[c(hep2$kuukausi %in% 10:12 & hep2$mittausid == 96 & hep2$vuosi == 2013), 4]
hep2 %>%
ggplot(aes(lubridate::make_date(vuosi, kuukausi), pp, color = mittausid)) +
geom_line()
# I want to compare later years to mean of the first three years.
# Year 2018 is incomplete, so I'll calculate another mean for it.
pp_all_mean <- hep2 %>%
group_by(mittausid, vuosi) %>%
summarise(pp_all = sum(pp)) %>%
group_by(mittausid) %>%
mutate(pp_all_mean = mean(pp_all[vuosi %in% 2011:2013])) %>%
distinct(mittausid, pp_all_mean)
pp_9_mean <- hep2 %>%
filter(kuukausi < 10) %>%
group_by(mittausid, vuosi) %>%
summarise(pp_all = sum(pp)) %>%
group_by(mittausid) %>%
mutate(pp_9_mean = mean(pp_all[vuosi %in% 2011:2013])) %>%
distinct(mittausid, pp_9_mean)
pp_means <- pp_all_mean %>%
left_join(pp_9_mean)## Joining, by = "mittausid"
gt_data <- hep2 %>%
group_by(mittausid, vuosi) %>%
summarise(pp_all = sum(pp)) %>%
left_join(pp_means) %>%
mutate(osuus = case_when(vuosi == 2018 ~ pp_all / pp_9_mean - 1,
TRUE ~ pp_all / pp_all_mean - 1)) %>%
ungroup() %>%
mutate(mittausid = case_when(mittausid == "89" ~ "Hupisaaret",
TRUE ~ "Ouluhalli"))## Joining, by = "mittausid"
# Building the `gt` table
gt_pp <- gt_data %>%
gt(rowname_col = "vuosi", groupname_col = "mittausid") %>%
cols_hide(vars(pp_all_mean, pp_9_mean)) %>%
cols_label(pp_all = "Pyöräliikenne, lkm", osuus = "Vertailuluku") %>%
fmt_percent(columns = vars(osuus), sep_mark = " ", dec_mark = ",", decimals = 1, incl_space = TRUE) %>%
fmt_number(columns = vars(pp_all), sep_mark = " ", dec_mark = ",", decimals = 0)
# It looks like some of the formatting is lost in this markdown file, eg. alignment.
gt_pp| Pyöräliikenne, lkm | Vertailuluku | |
|---|---|---|
| Hupisaaret | ||
| 2011 | 947 328 | 4,5 % |
| 2012 | 863 748 | -4,7 % |
| 2013 | 907 509 | 0,1 % |
| 2014 | 856 681 | -5,5 % |
| 2015 | 857 191 | -5,4 % |
| 2016 | 818 306 | -9,7 % |
| 2017 | 731 361 | -19,3 % |
| 2018 | 610 149 | -16,5 % |
| Ouluhalli | ||
| 2011 | 631 486 | 2,4 % |
| 2012 | 605 763 | -1,8 % |
| 2013 | 612 616 | -0,6 % |
| 2014 | 631 236 | 2,4 % |
| 2015 | 670 178 | 8,7 % |
| 2016 | 646 460 | 4,8 % |
| 2017 | 632 357 | 2,6 % |
| 2018 | 507 098 | 7,0 % |