Skip to content

Axivor

Get Update

  • Home
  • Life Coach
  • Luxury Lifestyle
  • Travel Lifestyle
  • Travel Tips
  • Urban Life
  • More
    • About Us
    • Contact Us
    • Disclaimer
    • Privacy Policy
    • Terms and Conditions
  • Toggle search form
Animating public transport networks on 3D stacked maps

Animating public transport networks on 3D stacked maps

Posted on July 8, 2025 By Rehan No Comments on Animating public transport networks on 3D stacked maps

img { border: 5px solid #FFFFFF; }

As much as I would like to, I can’t procrastinate participate in all 30 days of the
#30DayMapChallenge. So here is the reproducible code to create a 3D image with stacked maps and an animated public transport network. This should cover some topics of the 30DayMapChallenge.

  • 2: Lines
  • 4: Hexagons
  • 11: 3D
  • 12: Population
  • 20: Movement

Animating public transport networks on 3D stacked maps

install.packages('easypackages')
easypackages::packages('geobr', 'aopdata', 'gtfs2gps', 
                       'data.table', 'sf', 'viridis',
                       'magrittr', 'dplyr', 'ggnewscale',
                       'ggplot2', 'gganimate', 'av')



###### Functions to tilt sf ---------------------------------------------
# more info at https://www.urbandemographics.org/post/figures-map-layers-r/
rotate_data <- function(data, x_add = 0, y_add = 0) {
  
  shear_matrix <- function(){ matrix(c(2, 1.2, 0, 1), 2, 2) }
  
  rotate_matrix <- function(x){ 
    matrix(c(cos(x), sin(x), -sin(x), cos(x)), 2, 2) 
  }
  data %>% 
    dplyr::mutate(
      geometry = .$geometry * shear_matrix() * rotate_matrix(pi/20) + c(x_add, y_add)
    )
}

rotate_data_geom <- function(data, x_add = 0, y_add = 0) {
  shear_matrix <- function(){ matrix(c(2, 1.2, 0, 1), 2, 2) }
  
  rotate_matrix <- function(x) { 
    matrix(c(cos(x), sin(x), -sin(x), cos(x)), 2, 2) 
  }
  data %>% 
    dplyr::mutate(
      geom = .$geom * shear_matrix() * rotate_matrix(pi/20) + c(x_add, y_add)
    )
}


###### DATA: city boundary ---------------------------------------------
code_muni <- geobr::lookup_muni(name_muni = 'Fortaleza')$code_muni
city <- read_municipality(code_muni = code_muni)




###### DATA: population from aopdata ---------------------------------------------

#' more info at https://www.ipea.gov.br/acessooportunidades/en/
aop <- aopdata::read_access(city = 'fortaleza', mode="public_transport", geometry = T)

# select areas with population
aop <- subset(aop, P001 > 0)




###### DATA: pubic transport data ---------------------------------------------

# read GTFS data

# I'm using a local file, but you can use a sample GTFS by uncommenting the line below 
gtfs_file <-  './GTFS_fortaleza_20211020.zip'
#gtfs_file <- system.file("extdata/fortaleza.zip", package = "gtfs2gps")
gtfs_raw <- gtfs2gps::read_gtfs(gtfs_file)

# select trips btween 7am and 8am
gtfs <- gtfs2gps::filter_day_period(gtfs_raw, period_start="07:00:00", period_end = '08:00:00')

# select a sample of n routes
set.seed(42)
nroutes <- 80
myroutes <- sample(x = unique(gtfs$routes$route_id), size = nroutes, replace = F)
gtfs <- gtfs2gps::filter_by_route_id(gtfs, route_ids = myroutes)

# get route geometries
routes <- gtfs2gps::gtfs_shapes_as_sf(gtfs)

# convert GTFS to GPS-like data.table
gps <- gtfs2gps(gtfs, parallel = T, spatial_resolution = 200)
gps <- gps[ between(departure_time, as.ITime('07:00:00'), as.ITime('08:00:00'))]

# Convert "GPS" points of vehicle positions into sf
gps_points <- sfheaders::sf_point(gps, x = "shape_pt_lon" , y = "shape_pt_lat", keep = T)
sf::st_crs(gps_points) <- 4326

# rotate vehicle positions and back to points
gps_points_r <- rotate_data(gps_points, y_add = 0.3)
gps_points_df <- sfheaders::sf_to_df(gps_points_r, fill = T)

# remove missing
gps_points_df <- subset(gps_points_df, !is.na(departure_time))


###### Plot ---------------------------------------------

# annotate parameters
x = -80.92
clr="gray40"
sz = 4

# city boundary
temp1  <- ggplot() +
              geom_sf(data = city %>% rotate_data_geom(y_add = .03), color="gray90", fill="gray90", show.legend = FALSE) +
              annotate("text", label="City boundary", x=x, y=9.10, hjust = 0, color=clr, size=sz) +
              labs(caption = "Image by @UrbanDemog")

temp2 <- temp1 +
  
  # Population Income
  geom_sf(data = subset(aop, P001>0) %>% rotate_data(y_add = .1), aes(fill=R001 ), color=NA, show.legend = FALSE) +
  scale_fill_viridis_c(option = 'E') +
  annotate("text", label="Income", x=x, y= 9.18, hjust = 0, color=clr, size=sz) +
  
  # Employment accessibility
  new_scale_fill() +
  geom_sf(data = subset(aop, P001>0) %>% rotate_data(y_add = .2), aes(fill=CMATT60 ), color=NA, show.legend = FALSE) +
  scale_fill_viridis_c(option = 'inferno') +
  annotate("text", label="Job access", x=x, y= 9.25, hjust = 0, color=clr, size=sz) +

  # public transport routes
  geom_sf(data = routes %>% rotate_data(y_add = 0.3), color="gray80", alpha=.4, show.legend = FALSE) +
  annotate("text", label="Public transport \nNetwork", x=x, y= 9.35, hjust = 0, color=clr, size=sz) +

  # public transport trips
  new_scale_color() +
  geom_point(data = gps_points_df, aes(x = x, y=y, color = shape_id), size= .8, alpha = 0.5, show.legend = FALSE) +
  # annotate("text", label="Public transport \nvehicles", x=x, y= 9.35, hjust = 0, color=clr, size=sz) +
  scale_colour_viridis(discrete = T) +
  theme_void() +
  
  # gganimate specificatons
  labs(title="Time: {frame_time}") +
  transition_time(as.POSIXct(departure_time) + 10800) +  # need to fix issue with time zone
  shadow_wake(wake_length = 0.015, alpha = FALSE) +
  ease_aes('linear') +
  coord_sf(xlim = c(-81.5, -80.8)) +
  theme(plot.background = element_rect(fill="white", color="white"),
        plot.caption = element_text(color="gray30"))



###### Save ---------------------------------------------

# save gif
anim_save(animation = temp2, "stacked_map_gtfs2gps222.gif", fps = 10, width=550, height=400)

# save mp4
anim <- animate(temp2, duration = 10, fps = 10, renderer = av_renderer(), width=550, height=400)
anim_save(animation = anim, "stacked_map_gtfs2gps222.mp4", width=550, height=400)


Urban Life

Post navigation

Previous Post: Why Your Life Purpose is So Important
Next Post: 12 Most Complimented Men’s Fragrances

More Related Articles

The Last Leaf Gardener: Not so fast, Youngquist The Last Leaf Gardener: Not so fast, Youngquist Urban Life
Wall to Wall Festival 2025 in Mordialloc, Australia – StreetArtNews Wall to Wall Festival 2025 in Mordialloc, Australia – StreetArtNews Urban Life
Back to the Future, Farmers of America Back to the Future, Farmers of America Urban Life
How many people really understand how tariffs work? – Urban Ag News How many people really understand how tariffs work? – Urban Ag News Urban Life
500+ Camping Recipes 500+ Camping Recipes Urban Life
My Private Tour Of a Secret Venetian Palazzo and Garden My Private Tour Of a Secret Venetian Palazzo and Garden Urban Life

Leave a Reply Cancel reply

Your email address will not be published. Required fields are marked *

Categories

  • Life Coach
  • Luxury Lifestyle
  • Travel Lifestyle
  • Travel Tips
  • Urban Life

Copyright © 2025 Axivor.

Powered by PressBook Blog WordPress theme