ISSS608 In-Class Exercise #6

In-Class Exercise #6 done by me, myself and I (and guided by Prof Kam).

Published

May 20, 2022

DOI

Getting Started

Setting up R packages

To start with, tidyverse, sf and tmap packages will be installed (if not yet) and launched using library().

packages = c("tidyverse","sf","tmap", "lubridate", "clock", "sftime", "rmarkdown")

for(p in packages){
  if(!require(p, character.only = T)){
    install.packages(p)
    }
  library(p, character.only = T)
  }
schools <- read_sf("data/wkt/Schools.csv", 
                   options = "GEOM_POSSIBLE_NAMES=location")

apartments <- read_sf("data/wkt/Apartments.csv", 
                   options = "GEOM_POSSIBLE_NAMES=location")

buildings <- read_sf("data/wkt/Buildings.csv", 
                   options = "GEOM_POSSIBLE_NAMES=location")

employers <- read_sf("data/wkt/Employers.csv", 
                   options = "GEOM_POSSIBLE_NAMES=location")

pubs <- read_sf("data/wkt/Pubs.csv", 
                   options = "GEOM_POSSIBLE_NAMES=location")

restaurants <- read_sf("data/wkt/Restaurants.csv", 
                   options = "GEOM_POSSIBLE_NAMES=location")
# tmap_mode("view") # interactive
# tmap_mode("plot") # static

tmap_mode("view")
tm_shape(buildings) + 
  tm_polygons(col = "grey60",
              size = 1,
              border.col = "black",
              border.lwd = 1) +
tm_shape(employers) + 
  tm_dots(col = "red") +
tm_shape(apartments) + 
  tm_dots(col = "blue") +
tm_shape(schools) + 
  tm_dots(col = "green") +
tm_shape(pubs) + 
  tm_dots(col = "yellow") +
tm_shape(restaurants) + 
  tm_dots(col = "cyan")
Leaflet | Tiles © Esri — Esri, DeLorme, NAVTEQ
logs <- read_sf("data/wkt/ParticipantStatusLogs1.csv", 
                options = "GEOM_POSSIBLE_NAMES=currentLocation")
glimpse(logs)
logs_selected <- logs %>% 
  mutate(Timestamp = date_time_parse(timestamp,
                                     zone="",
                                     format="%Y-%m-%dT%H:%M:%S")) %>% 
  mutate(day = get_day(Timestamp)) %>% 
  filter(currentMode == "Transport")
tmap_mode("plot")
tm_shape(buildings) + 
  tm_polygons(col = "grey60",
              size = 1,
              border.col = "black",
              border.lwd = 1) +
tm_shape(logs_selected) + 
  tm_dots(col = "red")

#This creates a hexagon map of the total grid area.
hex <- st_make_grid(buildings, 
                    cellsize=100, 
                    square=FALSE) %>%
  st_sf() %>%
  rowid_to_column('hex_id')
plot(hex)

# This overlays the data of interest (logs_selected) on to the hexagon map and joins the hex_id to the table
points_in_hex <- st_join(logs_selected, 
                         hex, 
                         join=st_within)
# plot(points_in_hex, pch='.')
points_in_hex <- st_join(logs_selected, 
                        hex, 
                        join=st_within) %>%
  st_set_geometry(NULL) %>%
  count(name='pointCount', hex_id)
head(points_in_hex)
# A tibble: 6 x 2
  hex_id pointCount
   <int>      <int>
1    169         35
2    212         56
3    225         21
4    226         94
5    227         22
6    228         45
hex_combined <- hex %>%
  left_join(points_in_hex, 
            by = 'hex_id') %>%
  replace(is.na(.), 0)
tm_shape(hex_combined %>%
           filter(pointCount > 0))+
  tm_fill("pointCount",
          n = 8,
          style = "quantile") +
  tm_borders(alpha = 0.1)

logs_path <- logs_selected %>%
  group_by(participantId, day) %>%
  summarize(m = mean(Timestamp), 
            do_union=FALSE) %>%
  st_cast("LINESTRING")
logs_path_selected <- logs_path %>% 
  filter(participantId ==0)

tmap_mode("plot")
tm_shape(buildings) + 
  tm_polygons(col = "grey60",
              size = 1,
              border.col = "black",
              border.lwd = 1) +
tm_shape(logs_path_selected) + 
  tm_lines(col = "blue")

# For participant 0 on Day 5
tmap_mode("plot")
tm_shape(buildings) + 
  tm_polygons(col = "grey60",
              size = 1,
              border.col = "black",
              border.lwd = 1) +
tm_shape(subset(logs_path, logs_path$participantId == 0 & logs_path$day == 5)) + 
  tm_lines(col = "blue")