Skip to content

Latest commit

 

History

History
145 lines (129 loc) · 9.25 KB

01-design-base-map.md

File metadata and controls

145 lines (129 loc) · 9.25 KB
Raw

Design base map

Qingqing Chen Last compiled date: 17 September, 2021

Prepare datasets

# sg planning areas
sg_planing_areas <- read_sf(here("data/raw_data/sg-subzone/MP14_SUBZONE_NO_SEA_PL.shp")) %>%
  st_make_valid() %>%
  st_transform(crs = 3414) %>%
  group_by(REGION_N, PLN_AREA_N, SUBZONE_N) %>%
  dplyr::summarise() %>%
  ungroup()

# sg boundary
if(file.exists(here("data/derived_data/sg_boundary.rds"))){
  sg_boundary <- readRDS(here("data/derived_data/sg_boundary.rds"))
}else{
  sg_boundary <- sg_planing_areas %>% summarise()
  saveRDS(sg_boundary, file = here("data/derived_data/sg_boundary.rds"))
}

# get sg bounding box
sg_bbox <- getbb("singapore") %>% as_tibble()
if(file.exists(here("data/derived_data/streets.rds"))){
  streets <- readRDS(here("data/derived_data/streets.rds"))
}else{
  streets <- opq(bbox = c(sg_bbox$min[1], sg_bbox$min[2], sg_bbox$max[1], sg_bbox$max[2])) %>%
    add_osm_feature(key = "highway", value = c("primary", "trunk")) %>%
    osmdata_sf()
  streets <- streets$osm_lines %>%
    filter(!is.na(name)) %>%
    st_simplify(dTolerance = 0.0001) %>%
    st_transform(crs = 3414) %>%
    st_join(., sg_planing_areas, largest = T) %>%
    filter(!is.na(REGION_N))
  saveRDS(streets, file = here("data/derived_data/streets.rds"))
}

if(file.exists(here("data/derived_data/area_centers.rds"))){
  area_centers <- readRDS(here("data/derived_data/area_centers.rds"))
}else{
  # reference area
  area <- sg_planing_areas %>%
    filter(SUBZONE_N %in% c("NATIONAL UNIVERSITY OF S'PORE", "SENTOSA", "EAST COAST", "WOODLANDS", "CENTRAL WATER CATCHMENT", "JURONG GATEWAY", "CITY HALL",  "CHANGI AIRPORT", "TAMPINES EAST", "SERANGOON CENTRAL")) %>%  # NORTHSHORE
    mutate(SUBZONE_N = map_chr(SUBZONE_N, stringr::str_to_title))

  # reference area centers
  area_centers <- area %>%
    st_centroid() %>% rownames_to_column(var = "id") %>%
    mutate(label = paste0(id, ". ", SUBZONE_N)) %>%
    mutate(label = factor(label, levels = label))
  saveRDS(area_centers, file = here("data/derived_data/area_centers.rds"))
}

# hatched reference areas
if(file.exists(here("data/derived_data/area_hatched.rds"))){
  area_hatched <- readRDS(here("data/derived_data/area_hatched.rds"))
}else{
  area_hatched <- hatchedLayer(area, pattern = "right2left", mode = "sfc", density = 7)
  saveRDS(area_hatched, file = here("data/derived_data/area_hatched.rds"))
}

Prepare image

tune_img <- function(img_nm, img_title, geom_size){
  base_path <- "data/photos/"
  img <- image_read(here(paste0(base_path, img_nm))) %>%
  image_resize(geometry = geom_size)
  ggdraw() +
    draw_image(img, x = 0.9, y = 0.9, hjust = 1, vjust = 1, height = 0.88) +
    draw_plot_label(img_title, fontface = "plain", x = 0.0, y = 0.99, hjust = 0, vjust = 1, size = 10)
}

img1 <- tune_img(img_nm = "cityhall.jpeg", img_title = "1. City Hall", geom_size = "400x550")
img2 <- tune_img(img_nm = "flickr-eastcoast.jpg", img_title = "2. East Coast", geom_size = "400x550")
img3 <- tune_img(img_nm = "flickr-nus.jpg", img_title = "3. National University of Singapore", geom_size = "400x550")
img4 <- tune_img(img_nm = "flickr-sentosa.jpg", img_title = "4. Sentosa", geom_size = "400x550")
img5 <- tune_img(img_nm = "flickr-changiairport.jpg", img_title = "5. Changi Airport", geom_size = "400x550")
img6 <- tune_img(img_nm = "flickr-tampines.jpg", img_title = "6. Tampines", geom_size = "400x550")
img7 <- tune_img(img_nm = "flickr-central-water-catchment.jpg", img_title = "7. Central Water Catchment", geom_size = "400x550")
img8 <- tune_img(img_nm = "flickr-woodlands.jpg", img_title = "8. Woodlands", geom_size = "400x550")
# img8 <- tune_img(img_nm = "flickr-northshore.jpg", img_title = "8. Northshore", geom_size = "400x550")
img9 <- tune_img(img_nm = "flickr-serangoon.jpg", img_title = "9. Serangoon Centre", geom_size = "400x550")
img10 <- tune_img(img_nm = "flickr-jurongeast.jpg", img_title = "10. Jurong Gateway", geom_size = "400x550")

Draw base map

base_map <- tm_shape(sg_boundary) +
  tm_borders(col = "grey") +
  tm_shape(streets) +
  tm_lines(col = rgb(80, 80, 80, maxColorValue = 255), lwd = 1, alpha = 1) +
  tm_shape(area_hatched) +
  tm_lines(col = rgb(80, 110, 120, maxColorValue = 255)) +
  tm_shape(area_centers) +
  tm_bubbles(col = rgb(80, 80, 80, maxColorValue = 255), size = 1) +
  tm_text(text = "id", col = "white", size = 1) +
  tm_layout(frame = F)

grid.newpage()
pushViewport(viewport(layout = grid.layout(ncol = 3, nrow = 5, widths = c(3.4, 0.9, 0.9))))
print(base_map, vp = viewport(layout.pos.col = 1))
grid.text("Labeled places are reference areas", x = 0.5, y = 0.1, just = c(1, 1), gp = gpar(fontsize = 12, fontface = "italic"), vp = viewport(layout.pos.col = 1))
grid.text("Singapore map", x = 0.35, y = 0.06, just = c(1, 1), gp = gpar(fontsize = 12, fontface = "italic"), vp = viewport(layout.pos.col = 1))
print(img1, vp = viewport(layout.pos.col = 2, layout.pos.row = 1))
print(img2, vp = viewport(layout.pos.col = 2, layout.pos.row = 2))
print(img3, vp = viewport(layout.pos.col = 2, layout.pos.row = 3))
print(img4, vp = viewport(layout.pos.col = 2, layout.pos.row = 4))
print(img5, vp = viewport(layout.pos.col = 2, layout.pos.row = 5))
print(img6, vp = viewport(layout.pos.col = 3, layout.pos.row = 1))
print(img7, vp = viewport(layout.pos.col = 3, layout.pos.row = 2))
print(img8, vp = viewport(layout.pos.col = 3, layout.pos.row = 3))
print(img9, vp = viewport(layout.pos.col = 3, layout.pos.row = 4))
print(img10, vp = viewport(layout.pos.col =3, layout.pos.row = 5))

Photo links