Michael Branion-Calles

Example Talk

Sat, 01 Jun 2030 13:00:00 +0000

Click on the Slides button above to view the built-in slides feature.

Slides can be added in a few ways:

Create slides using Hugo Blox Builder’s feature and link using the slides parameter in the front matter of the talk file
Upload an existing slide deck to this page bundle and link it using links: [{ type: slides, url: path/to/file } ] in front matter
Embed your slides (e.g. Google Slides) or presentation video on this page using .

Further event details, including such as image galleries, can be added to the body of this page.

Projects

Thu, 04 Sep 2025 00:00:00 +0000

Spatial Analysis of Social Inequalities in Road Traffic Injury

Mon, 01 Sep 2025 00:00:00 +0000

This ongoing project maps how social inequalities shape the risk of road traffic injuries across neighborhoods in British Columbia. By combining census data, crash records, and spatial modeling, it highlights patterns of deprivation and injury risk—especially for pedestrians and cyclists—to inform safer and more equitable urban planning.

Impact: Provides evidence of strong socioeconomic gradient across all regions of the province, a first step to creating and evaluating equitable transportation safety policies.

Tech Stack: R (INLA, tidyverse, sf), GIS, Bayesian spatial modeling

Fantasy Hockey ELO

Mon, 07 Apr 2025 00:00:00 +0000

A fun and interactive Shiny app that tracks and visualizes ELO scores over 11 seasons of fantasy hockey for participants in a head-to-head league among friends.

Impact: Makes competitive tracking intuitive and enjoyable for everyone in the league.

Tech Stack: R, Shiny, ELO algorithm, data visualization

Comparing pedestrian and cyclist injuries from falls and collisions in British Columbia, Canada: Frequencies and population characteristics

Wed, 02 Apr 2025 00:00:00 +0000

Underreporting and selection bias of serious road traffic injuries in auto insurance claims and police reports in British Columbia, Canada

Thu, 06 Mar 2025 00:00:00 +0000

Ascertainment and description of pedestrian and bicycling injuries and fatalities in Ontario from administrative health records 2003–2017: contributions of non-collision falls and crashes

Thu, 11 Jul 2024 00:00:00 +0000

Risk Factors and Inequities in Transportation Injury and Mortality in the Canadian Census Health and Environment Cohorts (CanCHECs)

Fri, 01 Mar 2024 00:00:00 +0000

Experience

Tue, 24 Oct 2023 00:00:00 +0000

Learn JavaScript

Tue, 24 Oct 2023 00:00:00 +0000

is designed to give technical content creators a seamless experience. You can focus on the content and the Hugo Blox Builder which this template is built upon handles the rest.

Embed videos, podcasts, code, LaTeX math, and even test students!

On this page, you’ll find some examples of the types of technical content that can be rendered with Hugo Blox.

Video

Teach your course by sharing videos with your students. Choose from one of the following approaches:

Youtube:

{{< youtube w7Ft2ymGmfc >}}

Bilibili:

{{< bilibili id="BV1WV4y1r7DF" >}}

Video file

Videos may be added to a page by either placing them in your assets/media/ media library or in your , and then embedding them with the video shortcode:

{{< video src="my_video.mp4" controls="yes" >}}

Podcast

You can add a podcast or music to a page by placing the MP3 file in the page’s folder or the media library folder and then embedding the audio on your page with the audio shortcode:

{{< audio src="ambient-piano.mp3" >}}

Try it out:

Test students

Provide a simple yet fun self-assessment by revealing the solutions to challenges with the spoiler shortcode:

{{< spoiler text="👉 Click to view the solution" >}}
You found me!
{{< /spoiler >}}

renders as

👉 Click to view the solution

You found me 🎉

Math

Hugo Blox Builder supports a Markdown extension for $\LaTeX$ math. You can enable this feature by toggling the math option in your config/_default/params.yaml file.

To render inline or block math, wrap your LaTeX math with {{< math >}}$...${{< /math >}} or {{< math >}}$$...$${{< /math >}}, respectively.

We wrap the LaTeX math in the Hugo Blox math shortcode to prevent Hugo rendering our math as Markdown.

Example math block:

{{< math >}}
$$
\gamma_{n} = \frac{ \left | \left (\mathbf x_{n} - \mathbf x_{n-1} \right )^T \left [\nabla F (\mathbf x_{n}) - \nabla F (\mathbf x_{n-1}) \right ] \right |}{\left \|\nabla F(\mathbf{x}_{n}) - \nabla F(\mathbf{x}_{n-1}) \right \|^2}
$$
{{< /math >}}

renders as

$$\gamma_{n} = \frac{ \left | \left (\mathbf x_{n} - \mathbf x_{n-1} \right )^T \left [\nabla F (\mathbf x_{n}) - \nabla F (\mathbf x_{n-1}) \right ] \right |}{\left \|\nabla F(\mathbf{x}_{n}) - \nabla F(\mathbf{x}_{n-1}) \right \|^2}$$

Example inline math {{< math >}}$\nabla F(\mathbf{x}_{n})${{< /math >}} renders as $\nabla F(\mathbf{x}_{n})$ .

Example multi-line math using the math linebreak (\\):

{{< math >}}
$$f(k;p_{0}^{*}) = \begin{cases}p_{0}^{*} & \text{if }k=1, \\
1-p_{0}^{*} & \text{if }k=0.\end{cases}$$
{{< /math >}}

renders as

$$ f(k;p_{0}^{*}) = \begin{cases}p_{0}^{*} & \text{if }k=1, \\ 1-p_{0}^{*} & \text{if }k=0.\end{cases} $$

Code

Hugo Blox Builder utilises Hugo’s Markdown extension for highlighting code syntax. The code theme can be selected in the config/_default/params.yaml file.

```python
import pandas as pd
data = pd.read_csv("data.csv")
data.head()
```

renders as

import pandas as pd
data = pd.read_csv("data.csv")
data.head()

Inline Images

{{< icon name="python" >}} Python

renders as

Python

Learn Python

Tue, 24 Oct 2023 00:00:00 +0000

is designed to give technical content creators a seamless experience. You can focus on the content and the Hugo Blox Builder which this template is built upon handles the rest.

Embed videos, podcasts, code, LaTeX math, and even test students!

On this page, you’ll find some examples of the types of technical content that can be rendered with Hugo Blox.

Video

Teach your course by sharing videos with your students. Choose from one of the following approaches:

Youtube:

{{< youtube w7Ft2ymGmfc >}}

Bilibili:

{{< bilibili id="BV1WV4y1r7DF" >}}

Video file

Videos may be added to a page by either placing them in your assets/media/ media library or in your , and then embedding them with the video shortcode:

{{< video src="my_video.mp4" controls="yes" >}}

Podcast

You can add a podcast or music to a page by placing the MP3 file in the page’s folder or the media library folder and then embedding the audio on your page with the audio shortcode:

{{< audio src="ambient-piano.mp3" >}}

Try it out:

Test students

Provide a simple yet fun self-assessment by revealing the solutions to challenges with the spoiler shortcode:

{{< spoiler text="👉 Click to view the solution" >}}
You found me!
{{< /spoiler >}}

renders as

👉 Click to view the solution

You found me 🎉

Math

Hugo Blox Builder supports a Markdown extension for $\LaTeX$ math. You can enable this feature by toggling the math option in your config/_default/params.yaml file.

To render inline or block math, wrap your LaTeX math with {{< math >}}$...${{< /math >}} or {{< math >}}$$...$${{< /math >}}, respectively.

We wrap the LaTeX math in the Hugo Blox math shortcode to prevent Hugo rendering our math as Markdown.

Example math block:

{{< math >}}
$$
\gamma_{n} = \frac{ \left | \left (\mathbf x_{n} - \mathbf x_{n-1} \right )^T \left [\nabla F (\mathbf x_{n}) - \nabla F (\mathbf x_{n-1}) \right ] \right |}{\left \|\nabla F(\mathbf{x}_{n}) - \nabla F(\mathbf{x}_{n-1}) \right \|^2}
$$
{{< /math >}}

renders as

Example inline math {{< math >}}$\nabla F(\mathbf{x}_{n})${{< /math >}} renders as $\nabla F(\mathbf{x}_{n})$ .

Example multi-line math using the math linebreak (\\):

{{< math >}}
$$f(k;p_{0}^{*}) = \begin{cases}p_{0}^{*} & \text{if }k=1, \\
1-p_{0}^{*} & \text{if }k=0.\end{cases}$$
{{< /math >}}

renders as

$$ f(k;p_{0}^{*}) = \begin{cases}p_{0}^{*} & \text{if }k=1, \\ 1-p_{0}^{*} & \text{if }k=0.\end{cases} $$

Code

Hugo Blox Builder utilises Hugo’s Markdown extension for highlighting code syntax. The code theme can be selected in the config/_default/params.yaml file.

```python
import pandas as pd
data = pd.read_csv("data.csv")
data.head()
```

renders as

import pandas as pd
data = pd.read_csv("data.csv")
data.head()

Inline Images

{{< icon name="python" >}} Python

renders as

Python

Active Transportation Safety and Road Traffic Injury in British Columbia

Thu, 31 Aug 2023 00:00:00 +0000

This report was prepared for decision makers and policy makers in the provincial government to support goals of increasing active transportation while striving for Vision Zero. It uses linked datasets encompassing insurance claims, police reports, hospital admissions, and sociodemographic information to describe changes in road traffic injury rates over time, identify population groups with higher rates, and discern factors that influence injury severity.

Key findings:

Insurance claims miss just over 25% of injuries requiring hospital admission for pedestrians, cyclists, and drivers.
Falls on public roadways (including sidewalks) are an important and increasing source of injuries for pedestrians and cyclists but are not captured by auto-insurance claims or police collision data.
Cyclists and pedestrians face a disproportionately higher risk of injury and death compared to motor vehicle occupants. Reductions over time are primarily from fewer motor-vehicle collisions, while pedestrian falls and single-bicycle crashes are increasing.
Inequalities exist: lower-income individuals and those in less wealthy neighborhoods face higher injury rates; older age is associated with a higher proportion of fall-related traffic injuries.
Speed limits >30 km/hr and heavier vehicles are associated with higher risk of fatal injury for all road users, with a greater effect on pedestrians and cyclists.

Considerations:

Stratify road safety goals by road user type, population groups, and crash types.
Expand the definition of pedestrian injuries to include falls on roadways (including sidewalks).
Manage kinetic energy via speed management and physical separation as part of a Safe Systems approach.
A provincial travel survey is needed to accurately assess pedestrian and cyclist risk.
Improve emergency department data collection on mechanisms of injury (including minor injuries) to enhance surveillance, risk-factor analysis, and severity assessment.

Publications:

Underreporting and selection bias of serious road traffic injuries in auto insurance claims and police reports in British Columbia, Canada. (Transportation Research Interdisciplinary Perspectives, 2025).
Comparing pedestrian and cyclist injuries from falls and collisions in British Columbia, Canada: Frequencies and population characteristics. (Journal of Transport & Health, 2025).

Crowdsourced bicycling crashes and near misses: trends in Canadian cities

Fri, 13 Aug 2021 00:00:00 +0000

Estimating walking and bicycling in Canada and their road collision fatality risks: The need for a national household travel survey

Tue, 01 Jun 2021 00:00:00 +0000

Translating risk to preventable burden by estimating numbers of bicycling injuries preventable by separated infrastructure on a Toronto, Ontario corridor

Wed, 26 May 2021 00:00:00 +0000

Who Bikes? An Assessment of Leisure and Commuting Bicycling from the Canadian Community Health Survey

Sat, 01 May 2021 00:00:00 +0000

Changes in Commute Mode Attributed to COVID-19 Risk in Canadian National Survey Data

Fri, 12 Feb 2021 00:00:00 +0000

Kernel Density Estimation of Point Processes in Network Space in R

Fri, 22 Jan 2021 00:00:00 +0000

Kernel Density Estimation of Point Processes in Network Space in R

Update (September 2025): This was a blog post originally from January 2021 where I implemented a network-based KDE in R based on the algorithm outlined in . At the time there was not a ton of R functionality for network analysis; packages like sfnetworks did not yet exist and neither did spNetwork to conduct network-based KDE. A much more thorough examination of network-based KDEs and their implementation in R (current as of 2025) can be found here: . I have updated this post slightly (including code for extracting police data and using stplanr for network cleaning). Most of the code still holds up as it relied on igraph and tidygraph directly. While likely not of particular use anymore given the advanced functionality found in spNetwork, this little post can stand as a relic of its time.

The network KDE is a 1-D version of the planar kernel density estimator, with $\tau$ (bandwidth) based on network distances rather than Euclidean distances, and the output is based on lixels (a 1-D version of pixels) rather than pixels across 2-D Euclidean space.

To produce kernel density estimates (KDE) of point processes in a linear network:

$$ \lambda(z)= \sum_{i=1}^{n} \frac{1}{\tau}\, k\!\left(\frac{d_{iz}}{\tau}\right) y_i $$

Where,

$\lambda(z)$ is the density at location $z$;
$\tau$ is the bandwidth (linear network distance);
$k$ is the kernel function, typically a function of the ratio of $d_{iz}$ to $\tau$;
$d_{iz}$ is the linear network distance from event $i$ to location $z$.

I wanted to implement a network-based KDE in R based on the algorithm outlined in . The network KDE is a 1-D version of the planar kernel density estimator, with $\tau$ (bandwidth) based on network distances rather than Euclidean distances, and the output is based on lixels (a 1-D version of pixels) rather than pixels across 2-D Euclidean space.

In this post I use data from Vancouver, BC as a case study for implementing a network kernel density estimator of points in a network in R.

Set Up

library(tidygraph)
library(igraph)
library(stplanr)
library(cancensus)
library(osmdata)
library(dplyr)
library(sf)
library(sfnetworks)
library(ggplot2)
library(stringr)

Getting the example data

The first step is to load example data.

Study Area Extent

I use the get_census function from the package to extract a sf object with POLYGON geometries, representing the study extent: the City of Vancouver.

study_area <- get_census(dataset='CA16', regions=list(CSD="5915"),
 level='CSD', use_cache = FALSE,geo_format = "sf") %>%
 filter(name=="Vancouver (CY)") %>%
 st_transform(crs = 26910)

ggplot(study_area) +
 geom_sf() +
 coord_sf() +
 theme_void()

Road Network Data

Next I use the osmdata package to download street network files for the City of Vancouver. The getbb() function defines a bounding box for the City of Vancouver.

bbx <- getbb("Vancouver, BC")

Next we use the opq() and add_osm_feature functions to obtain open street map road network data. The osmdata_sf()

streets <- bbx %>%
 opq()%>%
 add_osm_feature(key = "highway",
 value=c("residential", "living_street",
 "service","unclassified",
 "pedestrian", "footway",
 "track","path","motorway", "trunk",
 "primary","secondary",
 "tertiary","motorway_link",
 "trunk_link","primary_link",
 "secondary_link",
 "tertiary_link")) %>%
 osmdata_sf()


streets_sf <- st_transform(streets$osm_lines,crs=26910) %>%
 st_intersection(.,st_geometry(study_area)) |>
 st_cast(to = "MULTILINESTRING") |>
 st_cast(to = "LINESTRING")

ggplot() +
 geom_sf(data = streets_sf,
 aes(color=highway),
 size = .4,
 alpha = .65)+
 theme_void()

Police Report Data

Finally I get point data of police reports in Vancouver from the City of Vancouver. I subset the data to only include vehicle collisions reported to police in 2018 (last full year of data available).

# core base + tidy read
url <- "https://geodash.vpd.ca/opendata/crimedata_download/crimedata_csv_all_years.zip"
zipf <- tempfile(fileext = ".zip")
csvd <- tempfile(fileext = ".csv")

download.file(url, destfile = zipf, mode = "wb")
csv_name <- unzip(zipf, list = TRUE)$Name[grepl("\\.csv$", unzip(zipf, list=TRUE)$Name)]
unzip(zipf, files = csv_name, exdir = dirname(csvd))
file.rename(file.path(dirname(csvd), csv_name), csvd)

[1] TRUE

# fast, friendly read
library(readr)
crime <- readr::read_csv(csvd, show_col_types = FALSE)
dplyr::glimpse(crime)

Rows: 925,938
Columns: 10
$ TYPE <chr> "Break and Enter Commercial", "Break and Enter Commercia…
$ YEAR <dbl> 2022, 2022, 2023, 2022, 2022, 2022, 2022, 2022, 2022, 20…
$ MONTH <dbl> 1, 1, 9, 6, 3, 3, 2, 2, 4, 8, 9, 2, 4, 4, 5, 2, 4, 10, 8…
$ DAY <dbl> 5, 3, 14, 17, 15, 19, 23, 25, 30, 2, 11, 24, 1, 28, 11, …
$ HOUR <dbl> 7, 16, 3, 5, 5, 6, 23, 10, 22, 15, 0, 4, 4, 12, 18, 22, …
$ MINUTE <dbl> 34, 19, 30, 16, 14, 42, 0, 15, 45, 31, 5, 8, 7, 5, 0, 5,…
$ HUNDRED_BLOCK <chr> "10XX ALBERNI ST", "10XX ALBERNI ST", "10XX ALBERNI ST",…
$ NEIGHBOURHOOD <chr> "West End", "West End", "West End", "West End", "West En…
$ X <dbl> 491015.9, 491036.1, 491065.3, 491067.3, 491102.2, 491102…
$ Y <dbl> 5459166, 5459146, 5459130, 5459115, 5459092, 5459092, 54…

collisions <- crime %>%
 filter(YEAR==2025 & str_detect(TYPE,"Vehicle Collision"))%>%
 filter(X!=0) %>%
 st_as_sf(.,coords = c("X","Y"),crs=26910)

Locations of police reported vehicle collisions are below.

ggplot(collisions) +
 geom_sf() +
 coord_sf() +
 theme_void()

Now we have the data we need to try and estimate the density of police-reported collisions or “hotspots” in the City of Vancouver.

NOTE: These data do not differentiate between different types of collisions between road users, and police road collision data consistently miss out on the majority of crashes that occur to active transport users (bicyclists and pedestrians).

Prepare the network data

In the algorithm outlined in the resulting density estimates on a network are based on a spatial unit of analysis they term a lixel. Lixels are basically the 1-D version of a pixel, and refer to how long the segments in our network are from which we calculate densities of events.

To create a lixelized network I combine the split_lines() and the lixelize network() functions.

The split_lines() function has three arguments:

input_lines: sf object with LINSETRING or MULTILINESTRING geometry
max_length: the lixel size, defined by the maximum length of an individual linestring in the data.
id: a unique id for each line segment in the sf object

The split_lines() function is given below:

split_lines <- function(input_lines, max_length, id) {

 input_lines <- input_lines %>% ungroup()

 geom_column <- attr(input_lines, "sf_column")

 input_crs <- sf::st_crs(input_lines)

 input_lines[["geom_len"]] <- sf::st_length(input_lines[[geom_column]])

 attr(input_lines[["geom_len"]], "units") <- NULL
 input_lines[["geom_len"]] <- as.numeric(input_lines[["geom_len"]])

 too_short <- filter(select(all_of(input_lines),all_of(id), all_of(geom_column), geom_len), geom_len < max_length) %>% select(-geom_len)

 too_long <- filter(select(all_of(input_lines),all_of(id), all_of(geom_column), geom_len), geom_len >= max_length)

 rm(input_lines) # just to control memory usage in case this is big.

 too_long <- mutate(too_long,
 pieces = ceiling(geom_len / max_length),
 fID = 1:nrow(too_long)) %>%
 select(-geom_len)

 split_points <- sf::st_set_geometry(too_long, NULL)[rep(seq_len(nrow(too_long)), too_long[["pieces"]]),] %>%
 select(-pieces)

 split_points <- mutate(split_points, split_fID = row.names(split_points)) %>%
 group_by(fID) %>%
 mutate(piece = 1:n()) %>%
 mutate(start = (piece - 1) / n(),
 end = piece / n()) %>%
 ungroup()

 new_line <- function(i, f, t) {
 lwgeom::st_linesubstring(x = too_long[[geom_column]][i], from = f, to = t)[[1]]
 }

 split_lines <- apply(split_points[c("fID", "start", "end")], 1,
 function(x) new_line(i = x[["fID"]], f = x[["start"]], t = x[["end"]]))

 rm(too_long)

 split_lines <- st_sf(split_points[c(id)], geometry = st_sfc(split_lines, crs = input_crs))

 lixel <- rbind(split_lines,too_short) %>% mutate(LIXID = row_number())

 return(lixel)
}

The second function needed to prepare the network data is the lixelize_network function. This takes two arguments, an sf object with LINESTRING or MULTILINESTRING geometry and the lixel_length argument. This function will create two lixelized networks: 1) the output network where the line data are lixelized and no segment is larger than the a given pixel size and 2) a shortest distance network which will be used to calculate road network lengths in our network kernel density estimates that we will dive into shortly.

The lixelize network function is given below:

lixelize_network <- function(sf_network,max_lixel_length,uid){
 print("Splitting input spatial lines by lixel length...")
 target_lixel <- split_lines(input_lines = sf_network,max_length = max_lixel_length,id = uid)
 print("Create corresponding shortest distance network...")
 shortest_distance_network <- split_lines(input_lines = target_lixel,max_length = max_lixel_length/2,id = uid)
 return(list(target_lixel=target_lixel,shortest_distance_network=shortest_distance_network))
}

Our approach varies from Xie and Yan (2008) in that we define a “maximum” length for lixels based on the split_lines() function, and segments that are larger than the specified length are split into equal sized lixels. Instead of having $n$ lixels with 1 extra “residual lixel” we instead have $n$+1 lixels of equal length, under the lixel limit. For example a 45m segment with a maximum lixel length of 10m would be split into 5 segments of 9m instead of 4 lixels of 10m and a residual lixel of 5m.

Now we have the data we need to try and estimate the density of police-reported collisions or “hotspots” in the City of Vancouver.

Prepare the network data

To create a lixelized network I combine the split_lines() and the lixelize network() functions.

The split_lines() function has three arguments:

input_lines: sf object with LINSETRING or MULTILINESTRING geometry
max_length: the lixel size, defined by the maximum length of an individual linestring in the data.
id: a unique id for each line segment in the sf object

The split_lines() function is given below:

split_lines <- function(input_lines, max_length, id) {

 input_lines <- input_lines %>% ungroup()

 geom_column <- attr(input_lines, "sf_column")

 input_crs <- sf::st_crs(input_lines)

 input_lines[["geom_len"]] <- sf::st_length(input_lines[[geom_column]])

 attr(input_lines[["geom_len"]], "units") <- NULL
 input_lines[["geom_len"]] <- as.numeric(input_lines[["geom_len"]])

 too_short <- filter(select(input_lines,all_of(id), all_of(geom_column), geom_len), geom_len < max_length) %>% select(-geom_len)

 too_long <- filter(select(input_lines,all_of(id), all_of(geom_column), geom_len), geom_len >= max_length)

 rm(input_lines) # just to control memory usage in case this is big.

 too_long <- mutate(too_long,
 pieces = ceiling(geom_len / max_length),
 fID = 1:nrow(too_long)) %>%
 select(-geom_len)

 split_points <- sf::st_set_geometry(too_long, NULL)[rep(seq_len(nrow(too_long)), too_long[["pieces"]]),] %>%
 select(-pieces)

 split_points <- mutate(split_points, split_fID = row.names(split_points)) %>%
 group_by(fID) %>%
 mutate(piece = 1:n()) %>%
 mutate(start = (piece - 1) / n(),
 end = piece / n()) %>%
 ungroup()

 new_line <- function(i, f, t) {
 lwgeom::st_linesubstring(x = too_long[[geom_column]][i], from = f, to = t)[[1]]
 }

 split_lines <- apply(split_points[c("fID", "start", "end")], 1,
 function(x) new_line(i = x[["fID"]], f = x[["start"]], t = x[["end"]]))

 rm(too_long)

 split_lines <- st_sf(split_points[c(id)], geometry = st_sfc(split_lines, crs = input_crs))

 lixel <- rbind(split_lines,too_short) %>% mutate(LIXID = row_number())

 return(lixel)
}

The lixelize network function is given below:

lixelize_network <- function(sf_network,max_lixel_length,uid){
 print("Splitting input spatial lines by lixel length...")
 target_lixel <- split_lines(input_lines = sf_network,max_length = max_lixel_length,id = uid)
 print("Create corresponding shortest distance network...")
 shortest_distance_network <- split_lines(input_lines = target_lixel,max_length = max_lixel_length/2,id = uid)
 return(list(target_lixel=target_lixel,shortest_distance_network=shortest_distance_network))
}

Lixelize the cleaned network

Next step is to lixelize the cleaned network. I choose a 25m maximum lixel length (e.g. every linear segment in the network will be 25m or under. This function may take some time to run.

lixel_list_25m <- lixelize_network(
 sf_network = streets_sf,
 max_lixel_length = 25,
 uid = "osm_id"

)

[1] "Splitting input spatial lines by lixel length..."
[1] "Create corresponding shortest distance network..."

str(lixel_list_25m)

List of 2
$ target_lixel : sf [224,904 × 3] (S3: sf/tbl_df/tbl/data.frame)
..$ osm_id : chr [1:224904] "4231647" "4231647" "4231647" "4231647" ...
..$ geometry:sfc_LINESTRING of length 224904; first list element: 'XY' num [1:2, 1:2] 487849 487873 5455038 5455039
..$ LIXID : int [1:224904] 1 2 3 4 5 6 7 8 9 10 ...
..- attr(*, "sf_column")= chr "geometry"
..- attr(*, "agr")= Factor w/ 3 levels "constant","aggregate",..: NA NA
.. ..- attr(*, "names")= chr [1:2] "osm_id" "LIXID"
$ shortest_distance_network: sf [436,612 × 3] (S3: sf/tbl_df/tbl/data.frame)
..$ osm_id : chr [1:436612] "4231647" "4231647" "4231647" "4231647" ...
..$ geometry:sfc_LINESTRING of length 436612; first list element: 'XY' num [1:2, 1:2] 487849 487861 5455038 5455039
..$ LIXID : int [1:436612] 1 2 3 4 5 6 7 8 9 10 ...
..- attr(*, "sf_column")= chr "geometry"
..- attr(*, "agr")= Factor w/ 3 levels "constant","aggregate",..: NA NA
.. ..- attr(*, "names")= chr [1:2] "osm_id" "LIXID"

Prepare the point data

Here I need to ensure that the point data are lined up with the cleaned network data. I use a function called st_snap_points which “snaps” the points to the location of the nearest road segment within a specified distance tolerance. The function is given below:

st_snap_points = function(x, y, max_dist = 1000) {

 if (inherits(x, "sf")) n = nrow(x)
 if (inherits(x, "sfc")) n = length(x)

 out = do.call(c,
 lapply(seq(n), function(i) {
 nrst = st_nearest_points(st_geometry(x)[i], y)
 nrst_len = st_length(nrst)
 nrst_mn = which.min(nrst_len)
 if (as.vector(nrst_len[nrst_mn]) > max_dist) return(st_geometry(x)[i])
 return(st_cast(nrst[nrst_mn], "POINT")[2])
 })
 )
 return(out)
}

We snap the points to our road network with a 20m tolerance:

coll_snp <- st_snap_points(collisions,streets_sf,max_dist = 20) #this only returns the geometry - doesn't preserve attributes

coll_snp <- st_sf(collisions %>%
 st_drop_geometry() %>%
 mutate(geom=coll_snp)) #rerturn the attributes to the snapped locations

Calculate Network Kernel Density

The function I have created here for calculating density of events on a network follows the algorithm outline in Xie and Yan (2008) and takes advantage of functionality from sf, igraph and tidygraph to to calculate shortest distances from each lixel in our network to the point processes we specify. Much of the code in this function is adapted from an excellent resource on using these packages for network analysis:

The network_kde() function is defined below:

#function for calculating the centre of 
st_line_midpoints <- function(sf_lines = NULL) {

 g <- st_geometry(sf_lines)

 g_mids <- lapply(g, function(x) {

 coords <- as.matrix(x)

 # this is just a copypaste of maptools:::getMidpoints()):
 get_mids <- function (coords) {
 dist <- sqrt((diff(coords[, 1])^2 + (diff(coords[, 2]))^2))
 dist_mid <- sum(dist)/2
 dist_cum <- c(0, cumsum(dist))
 end_index <- which(dist_cum > dist_mid)[1]
 start_index <- end_index - 1
 start <- coords[start_index, ]
 end <- coords[end_index, ]
 dist_remaining <- dist_mid - dist_cum[start_index]
 mid <- start + (end - start) * (dist_remaining/dist[start_index])
 return(mid)
 }

 mids <- st_point(get_mids(coords))
 })

 out <- st_sfc(g_mids, crs = st_crs(sf_lines))
 out <- st_sf(out)
 out <- bind_cols(out,sf_lines %>% st_drop_geometry()) %>% rename(geom=out)
}


network_kde <- function(lixel_list,point_process,bandwidth = 100,n_cores=1,attribute=1,point_process_is_lixel_midpoint=FALSE){


 #3. Create a network of lixels by establishing the network topology between lixels as well as between lixels and lxnodes.

 #Define topology for calculating shortest distances by converting lixel with half the length to calculate distances
 #The shorter the lixel length the more accurate the calculation of network distance from nearest node of source lixel to nearest node of target lixel
 print("Defining network topology...")

 require(parallel)
 require(doParallel)
 require(igraph)
 require(tidygraph)
 require(sf)
 require(dplyr)


 # Create nodes at the start and end point of each edge

 nodes <- lixel_list$shortest_distance_network %>%
 st_coordinates() %>%
 as_tibble() %>%
 rename(LIXID = L1) %>%
 group_by(LIXID) %>%
 slice(c(1, n())) %>%
 ungroup() %>%
 mutate(start_end = rep(c('start', 'end'), times = n()/2))

 # Give each node a unique index

 nodes <- nodes %>%
 mutate(xy = paste(.$X, .$Y),
 xy = factor(xy, levels = unique(xy))) %>%
 group_by(xy)%>%
 mutate(nodeID = cur_group_id()) %>%
 ungroup() %>%
 select(-xy)

 # Combine the node indices with the edges

 start_nodes <- nodes %>%
 filter(start_end == 'start') %>%
 pull(nodeID)

 end_nodes <- nodes %>%
 filter(start_end == 'end') %>%
 pull(nodeID)

 lixel_list$shortest_distance_network = lixel_list$shortest_distance_network %>%
 mutate(from = start_nodes, to = end_nodes)

 # Remove duplicate nodes
 nodes <- nodes %>%
 distinct(nodeID, .keep_all = TRUE) %>%
 select(-c(LIXID, start_end)) %>%
 st_as_sf(coords = c('X', 'Y')) %>%
 st_set_crs(st_crs(lixel_list$shortest_distance_network))

 # Convert to tbl_graph
 graph <- tbl_graph(nodes = nodes, edges = as_tibble(lixel_list$shortest_distance_network), directed = FALSE)

 graph <- graph %>%
 activate(edges) %>%
 mutate(length = st_length(geometry))

 lixel_list$shortest_distance_network <- NULL

 #4. Create the center points of all the lixels for the target lixel (lxcenters)
 print("Calculating lixel midpoints (lxcenters)...")

 lxcenters <- st_line_midpoints(lixel_list$target_lixel)

 #5. Select a point process occurring within the road network

 #input as function parameter

 #6. For each point find its nearest lixel. Count the number of points nearest to a lixel and assigned as property of lixel.

 #Points should be snapped to network within some distance threshold prior to

 if(point_process_is_lixel_midpoint==FALSE){

 print("Counting number of events on each lixel...")

 point_process <- st_join(point_process,lixel_list$target_lixel["LIXID"],
 join = st_is_within_distance, dist = 0.001) #for each point assign the LIXID that it falls on

 source_lixels <- point_process %>% #summarize the number of points by LIXID (e.g. count the points for each LIXID)
 filter(!is.na(LIXID)) %>%
 group_by(LIXID) %>%
 summarise(n_events = n(),`.groups`="drop") %>%
 st_drop_geometry()

 source_lixels <- inner_join(lxcenters,source_lixels,by="LIXID") #define geometry for source lixels
 }

 if(point_process_is_lixel_midpoint==TRUE){

 source_lixels <- lxcenters %>% mutate(n_events = 1)
 }

 print(paste0(sum(source_lixels$n_events)," events on ",nrow(source_lixels)," source lixels"))

 #7. Define a search bandwidth, measured with the short path network distance

 #input as function parameter

 #8. Calculate the shortest-path network distance from each source lixel to lxcenter of all its neighouring lixels within the seach bandwidth


 nearest_node_to_source_lixel <- st_nearest_feature(source_lixels,nodes)#find nodes from shortest distance network associated with each source lixel
 nearest_node_to_lxcentre <- st_nearest_feature(lxcenters,nodes)#find nodes from shortest distance network associated with each lxcenters

 print("Calculating distances from each source lixel to all other lixel centers... ")


 cl <- makeCluster(n_cores)
 registerDoParallel(cores=cl) #parallel computing

 distances <- foreach::foreach(i = 1:length(nearest_node_to_source_lixel),.packages = c("magrittr","igraph","tidygraph","sf")) %dopar% {
 temp <- distances(
 graph = graph,
 weights = graph %>% activate(edges) %>% pull(length),
 v = nearest_node_to_source_lixel[i]
 )[,nearest_node_to_lxcentre]

 data.frame(LIXID = lxcenters[temp<=max(bandwidth),]$LIXID,
 dist = temp[temp<=max(bandwidth)])
 }

 stopCluster(cl)

 rm("graph")


 # gauss <-function(x) {
 #
 # t1 <- 1/(sqrt(2*pi))
 # t2 <- exp(-((x^2)/(2*bandwidth^2)))
 # n <- (1/bandwidth)*(t1*t2)
 # n <- ifelse(x>bandwidth,0,n)
 #
 #
 # return(n)
 #
 # }
 #
 # plot(gauss(0:(bandwidth*2)))

 quartic <-function(x,r) {
 K <- 3/pi
 t1 <- 1-(x^2/r^2)
 q <- ifelse(x>r,0,K*t1)
 q <- (1/r)*q

 return(q)
 }

 LIXID <- unlist(lapply(lapply(distances,`[`,"LIXID"),function(x) pull(x)))
 distances_list <- lapply(lapply(distances,`[`,"dist"),function(x) pull(x))

 d_list <- list()

 for(i in 1:length(bandwidth)){

 print(paste0("Applying kernel density estimator with bandwidth of ",bandwidth[i],"m ... "))

 d <- lapply(distances_list,function(x) quartic(x,bandwidth[i]))
 d <- mapply(`*`,d,attribute) #multiply by attribute of source lixel
 d <- mapply(`*`,d,source_lixels$n_events) #sum over number of events that occured on the source lixel

 d_list[[i]] <- data.frame(unlist(d))
 }

 d_cols <- as.data.frame(do.call(cbind,d_list))

 names(d_cols) <- paste0("kde_bw_",bandwidth)

 #sum densities over all lixels
 density <- cbind(LIXID,d_cols) %>%
 group_by(LIXID) %>%
 summarise(across(everything(),sum),`.groups`="drop")

 network_kde <- left_join(lixel_list$target_lixel,density,by = "LIXID") %>%
 mutate(length = st_length(.)) %>%
 replace(., is.na(.), 0)

 return(list(network_kde=network_kde,neighbours = distances))

}

As of now I have only set up the algorithm to use a quartic kernel.

Next step is to compute the density of points on a network! The network_kde() function implements parallel computing functionality using the parallel and doParallel packages so we need to specify how many cores are on the computer being used:

n_cores <- bigstatsr::nb_cores()

Finally we specify the lixelized network we are working with, the point process from which we estimate densities of events, the bandwidths we wish to use in our density estimates and the number of cores for parallel computation. The last argument can be ignored for now and set to FALSE as it is something I’m working on to speed up computation if your point process is already associated with the segment (e.g. volumes of road users on a segment).

system.time({
 collisions_network_kde <- network_kde(lixel_list = lixel_list_25m,
 point_process = coll_snp,
 bandwidth = c(50,100,150,250),
 n_cores = n_cores,
 point_process_is_lixel_midpoint = FALSE)
})

[1] "Defining network topology..."
[1] "Calculating lixel midpoints (lxcenters)..."
[1] "Counting number of events on each lixel..."
[1] "733 events on 623 source lixels"
[1] "Calculating distances from each source lixel to all other lixel centers... "
[1] "Applying kernel density estimator with bandwidth of 50m ... "
[1] "Applying kernel density estimator with bandwidth of 100m ... "
[1] "Applying kernel density estimator with bandwidth of 150m ... "
[1] "Applying kernel density estimator with bandwidth of 250m ... "
user system elapsed
105.76 2.36 182.16

glimpse(collisions_network_kde$network_kde)

Rows: 224,904
Columns: 8
$ osm_id <chr> "4231647", "4231647", "4231647", "4231647", "4231647", "423…
$ geometry <LINESTRING [m]> LINESTRING (487848.5 545503..., LINESTRING (4878…
$ LIXID <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, …
$ kde_bw_50 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,…
$ kde_bw_100 <dbl> 0.000000000, 0.000000000, 0.000000000, 0.000000000, 0.00000…
$ kde_bw_150 <dbl> 0.000000000, 0.000000000, 0.000000000, 0.000000000, 0.00000…
$ kde_bw_250 <dbl> 0.000000000, 0.000000000, 0.000000000, 0.000000000, 0.00000…
$ length [m] 24.40429 [m], 24.40429 [m], 24.40429 [m], 24.40429 [m], 24.40…

The output of the network_kde() is an sf object with LINESTRING geometry, where each line segment is a lixel and the columns refer to density of events in network space for the specified bandwidths.

Mapping out the results

Below we can then map out the results. We will use the 150m bandwidth in this example:

ggplot() +
 geom_sf(data=study_area,color=NA,fill="gray5")+
 geom_sf(data = collisions_network_kde$network_kde,aes(color=kde_bw_150))+
 scale_color_viridis_c(option = "C",direction = 1,name="Density") +
 # geom_sf(data=mask,color=NA,fill="white")+
 theme_void()+
 theme(panel.background= element_rect(fill = NA,color=NA),
 legend.position = "top",
 legend.title.align = 0,
 legend.key.size = unit(1, 'cm'), #change legend key size
 legend.key.height = unit(0.5, 'cm'), #change legend key height
 legend.key.width = unit(1.5, 'cm'))+
 coord_sf(xlim = c(483690.9,499329.2),
 ylim = c(5450534.8,5463381.0))

Zooming into downtown:

ggplot() +
 geom_sf(data=study_area,color=NA,fill="gray5")+
 geom_sf(data = collisions_network_kde$network_kde,aes(color=kde_bw_150))+
 scale_color_viridis_c(option = "C",direction = 1,name="Density") +
 theme_void()+
 theme(panel.background= element_rect(fill = NA,color=NA),
 legend.position = "top",
 legend.title.align = 0,
 legend.key.size = unit(1, 'cm'), #change legend key size
 legend.key.height = unit(0.5, 'cm'), #change legend key height
 legend.key.width = unit(1.5, 'cm'))+
 coord_sf(xlim = c(491321.39853389-1000,491321.39853389+1100),
 ylim = c(5459015.689874-1000,5459015.689874+1000))

That’s the network KDE function as it is for now. Some challenges going forward are computation time for higher resolution pixels and implementing different kernels other than quartic.

Reproducibility receipt

[1] "2025-09-03 16:15:49 PDT"
Local: main C:/Users/micha/Documents/GitHub/mbcalles.github.io
Remote: main @ origin (https://github.com/mbcalles/mbcalles.github.io)
Head: [2a60de6] 2025-09-03: publication
R version 4.4.1 (2024-06-14 ucrt)
Platform: x86_64-w64-mingw32/x64
Running under: Windows 11 x64 (build 26100)
Matrix products: default
locale:
[1] LC_COLLATE=English_Canada.utf8 LC_CTYPE=English_Canada.utf8
[3] LC_MONETARY=English_Canada.utf8 LC_NUMERIC=C
[5] LC_TIME=English_Canada.utf8
time zone: America/Vancouver
tzcode source: internal
attached base packages:
[1] parallel stats graphics grDevices utils datasets methods
[8] base
other attached packages:
[1] doParallel_1.0.17 iterators_1.0.14 foreach_1.5.2 readr_2.1.5
[5] stringr_1.5.1 ggplot2_3.5.1 sfnetworks_0.6.4 sf_1.0-18
[9] dplyr_1.1.4 osmdata_0.2.5 cancensus_0.5.7 stplanr_1.2.2
[13] igraph_2.1.1 tidygraph_1.3.1
loaded via a namespace (and not attached):
[1] tidyselect_1.2.1 viridisLite_0.4.2 farver_2.1.2
[4] fastmap_1.2.0 spatstat.geom_3.3-3 spatstat.explore_3.3-3
[7] bigassertr_0.1.7 flock_0.7 digest_0.6.37
[10] rpart_4.1.23 timechange_0.3.0 lifecycle_1.0.4
[13] spatstat.data_3.1-2 magrittr_2.0.3 compiler_4.4.1
[16] rlang_1.1.4 tools_4.4.1 utf8_1.2.4
[19] yaml_2.3.10 knitr_1.48 labeling_0.4.3
[22] bit_4.5.0 classInt_0.4-10 curl_5.2.3
[25] xml2_1.3.6 rmio_0.4.0 abind_1.4-8
[28] KernSmooth_2.23-24 bigstatsr_1.6.2 withr_3.0.2
[31] purrr_1.0.2 grid_4.4.1 polyclip_1.10-7
[34] fansi_1.0.6 git2r_0.35.0 e1071_1.7-16
[37] colorspace_2.1-1 scales_1.3.0 spatstat.utils_3.1-0
[40] cli_3.6.3 rmarkdown_2.28 crayon_1.5.3
[43] generics_0.1.3 rstudioapi_0.17.1 httr_1.4.7
[46] tzdb_0.4.0 DBI_1.2.3 proxy_0.4-27
[49] splines_4.4.1 spatstat.model_3.3-2 vctrs_0.6.5
[52] Matrix_1.7-0 jsonlite_1.8.9 geojsonsf_2.0.3
[55] hms_1.1.3 bit64_4.5.2 tensor_1.5
[58] bigparallelr_0.3.2 spatstat.univar_3.0-1 tidyr_1.3.1
[61] units_0.8-5 goftest_1.2-3 parallelly_1.45.1
[64] glue_1.8.0 spatstat.random_3.3-2 lwgeom_0.2-14
[67] codetools_0.2-20 cowplot_1.1.3 lubridate_1.9.3
[70] stringi_1.8.4 gtable_0.3.6 deldir_2.0-4
[73] munsell_0.5.1 tibble_3.2.1 pillar_1.9.0
[76] rappdirs_0.3.3 htmltools_0.5.8.1 R6_2.5.1
[79] httr2_1.0.5 sfheaders_0.4.4 vroom_1.6.5
[82] evaluate_1.0.1 lattice_0.22-6 class_7.3-22
[85] Rcpp_1.0.13 spatstat.linnet_3.2-2 nlme_3.1-164
[88] spatstat.sparse_3.1-0 mgcv_1.9-1 xfun_0.48
[91] pkgconfig_2.0.3

To scoot or not to scoot: Findings from a recent survey about the benefits and barriers of using E-scooters for riders and non-rider

Sun, 20 Sep 2020 00:00:00 +0000

Impact of Public Bicycle Share Programs on Bicycling Collisions

Wed, 02 Sep 2020 00:00:00 +0000

This project evaluated how implementing public bicycle share programs (PBSPs) affected the likelihood of bicycling collisions across multiple North American cities. Using a difference-in-differences approach applied to repeated cross-sectional survey data, it shows that crash odds did not increase after PBSP implementation and were notably lower in cities with existing programs, supporting the safety of well-established bike share systems.

Impact: Offers empirical insights to urban planners and policymakers assessing the safety implications of bike share adoption.

Tech Stack: R, quasi-experimental design (difference-in-differences), multi-city survey analysis

The Impact of Implementing Public Bicycle Share Programs on Bicycle Crashes

Wed, 02 Sep 2020 00:00:00 +0000

Cyclist crash rates and risk factors in a prospective cohort in seven European cities

Mon, 01 Jun 2020 00:00:00 +0000

Impacts of study design on sample size, participation bias, and outcome measurement: a case study from bicycling research

Mon, 02 Dec 2019 00:00:00 +0000

Associations between individual characteristics, availability of bicycle infrastructure, and city-wide safety perceptions of bicycling: a cross-sectional survey of bicyclists in 6 Canadian and U.S. cities

Wed, 01 May 2019 00:00:00 +0000

Impacts of Bicycling Infrastructure in Mid-Sized Cities (IBIMS): Protocol for a Natural Experiment Study

Thu, 18 Jan 2018 00:00:00 +0000

Cycling safety: Quantifying the under reporting of cycling incidents in Vancouver, British Columbia

Fri, 01 Dec 2017 00:00:00 +0000

Comparing Crowdsourced Near-Miss and Collision Cycling Data and Official Bike Safety Reporting

Sun, 01 Jan 2017 00:00:00 +0000

Adjusting local alcohol consumption data for influence of tourists

Wed, 16 Mar 2016 00:00:00 +0000

Evaluation of different radon guideline values based on characterization of ecological risk and visualization of lung cancer mortality trends in British Columbia, Canada

Thu, 19 Nov 2015 00:00:00 +0000

A geospatial approach to the prediction of indoor radon vulnerability in British Columbia, Canada

Wed, 25 Mar 2015 00:00:00 +0000

Michael Branion-Calles

Example Talk

Projects

Spatial Analysis of Social Inequalities in Road Traffic Injury

Fantasy Hockey ELO

Comparing pedestrian and cyclist injuries from falls and collisions in British Columbia, Canada: Frequencies and population characteristics

Underreporting and selection bias of serious road traffic injuries in auto insurance claims and police reports in British Columbia, Canada

Ascertainment and description of pedestrian and bicycling injuries and fatalities in Ontario from administrative health records 2003–2017: contributions of non-collision falls and crashes

Risk Factors and Inequities in Transportation Injury and Mortality in the Canadian Census Health and Environment Cohorts (CanCHECs)

Experience

Learn JavaScript

Video

Podcast

Test students

Math

Code

Inline Images

Did you find this page helpful? Consider sharing it 🙌

Learn Python

Video

Podcast

Test students

Math

Code

Inline Images

Did you find this page helpful? Consider sharing it 🙌

Active Transportation Safety and Road Traffic Injury in British Columbia

Crowdsourced bicycling crashes and near misses: trends in Canadian cities

Estimating walking and bicycling in Canada and their road collision fatality risks: The need for a national household travel survey

Translating risk to preventable burden by estimating numbers of bicycling injuries preventable by separated infrastructure on a Toronto, Ontario corridor

Who Bikes? An Assessment of Leisure and Commuting Bicycling from the Canadian Community Health Survey

Changes in Commute Mode Attributed to COVID-19 Risk in Canadian National Survey Data

Kernel Density Estimation of Point Processes in Network Space in R

Kernel Density Estimation of Point Processes in Network Space in R

Set Up

Getting the example data

Study Area Extent

Road Network Data

Police Report Data

Prepare the network data

Prepare the network data

Lixelize the cleaned network

Prepare the point data

Calculate Network Kernel Density

Mapping out the results

To scoot or not to scoot: Findings from a recent survey about the benefits and barriers of using E-scooters for riders and non-rider

Impact of Public Bicycle Share Programs on Bicycling Collisions

The Impact of Implementing Public Bicycle Share Programs on Bicycle Crashes

Cyclist crash rates and risk factors in a prospective cohort in seven European cities

Impacts of study design on sample size, participation bias, and outcome measurement: a case study from bicycling research

Associations between individual characteristics, availability of bicycle infrastructure, and city-wide safety perceptions of bicycling: a cross-sectional survey of bicyclists in 6 Canadian and U.S. cities

Impacts of Bicycling Infrastructure in Mid-Sized Cities (IBIMS): Protocol for a Natural Experiment Study

Cycling safety: Quantifying the under reporting of cycling incidents in Vancouver, British Columbia

Comparing Crowdsourced Near-Miss and Collision Cycling Data and Official Bike Safety Reporting

Adjusting local alcohol consumption data for influence of tourists

Evaluation of different radon guideline values based on characterization of ecological risk and visualization of lung cancer mortality trends in British Columbia, Canada

A geospatial approach to the prediction of indoor radon vulnerability in British Columbia, Canada