luukvdmeer / sfnetworks

Tidy Geospatial Networks in R

Home Page:https://luukvdmeer.github.io/sfnetworks/

Geek Repo:Geek Repo

Github PK Tool:Github PK Tool

Enhance integration with spatstat package

agila5 opened this issue · comments

Is your feature request related to a problem? Please describe.
During the last months, I've developed a few R scripts that can be used to convert a sfnetwork object (or, more precisely, some fields included in the edges table) into linim and lintess format. This conversion can be extremely beneficial when estimating linear point process models on a spatial network. I'm not sure how large is the population of sfnetworks + spatstat users (maybe I'm the only one 😅) but I think it might be a nice addition to this package. I will add those scripts and more details in subsequent messages.

Describe the solution you'd like
The first conversion (i.e. sfnetwork -> linim) could be defined into an ad-hoc S3 method (maybe as.linim.sfnetwork). OTOH, there is no S3 generic like as.lintess, so we could define something like sfn_to_lintess (or maybe ask the spatstat developers if they would consider including that new generic).

Describe alternatives you've considered
Ignore this issue and just keep using the external scripts.

A first example with lintess objects:

# packages
suppressPackageStartupMessages({
  library(spatstat)
  library(sf)
  library(tidygraph)
  library(sfnetworks)
})

# data
sfn_roxel <- as_sfnetwork(roxel, directed = FALSE) 
sfn_roxel <- sfn_roxel |> 
  st_transform(25832) |> 
  convert(to_spatial_subdivision) |> 
  convert(to_spatial_simple, .clean = TRUE)
#> Warning: to_spatial_subdivision assumes attributes are constant over geometries

A few important things to point out: 1) spatstat code works only with projected coordinates (since they always implicitly assume a sort of Euclidean distance among points); 2) the conversion from sfnetwork to linnet implicitly drops duplicated edges and loops (since they are not supported by spatstat). Therefore, we need to make sure to remove those edge cases otherwise there is no 1-to-1 correspondence between edges and road types.

# convert to lintess object
linnet_roxel <- as.linnet(sfn_roxel, sparse = TRUE)
ltess_roxel <- lintess(
  L = linnet_roxel, 
  df = data.frame(
    seg = seq_len(igraph::ecount(sfn_roxel)), 
    t0 = 0, 
    t1 = 1, 
    tile = sfn_roxel |> activate(edges) |> pull(type)
  )
)

# and plot it
par(mar = c(0, 0, 0, 3))
plot(ltess_roxel, main = "")

This is quite convenient since in this way we can use the road type information as a covariate in a parametric model that relates a point pattern on a linear network (i.e. car crashes data) with external geographical information. For example:

# simulate events
lpp_roxel <- rpoislpp(lambda = 0.005, L = linnet_roxel)

# plot them
par(mar = rep(0, 4))
plot(lpp_roxel, pch = 20, main = "")

# estimate the model
lppm(lpp_roxel ~ ltess_roxel)
#> Point process model on linear network
#>  Fitted to point pattern dataset 'lpp_roxel'
#> 
#> Nonstationary Poisson process
#> 
#> Log intensity:  ~ltess_roxel
#> 
#> Fitted trend coefficients:
#>             (Intercept)      ltess_roxelfootway         ltess_roxelpath 
#>             -5.10239382             -0.26400376             -0.42759368 
#>   ltess_roxelpedestrian  ltess_roxelresidential    ltess_roxelsecondary 
#>            -12.20019128             -0.42475607             -0.40188260 
#>      ltess_roxelservice        ltess_roxeltrack ltess_roxelunclassified 
#>             -0.14643143             -0.21988574             -0.06817756 
#> 
#>                             Estimate        S.E.       CI95.lo      CI95.hi   Ztest
#> (Intercept)              -5.10239382   0.2500000    -5.5923848   -4.6124028    ***
#> ltess_roxelfootway       -0.26400376   0.3393104    -0.9290400    0.4010325
#> ltess_roxelpath          -0.42759368   0.3133916    -1.0418299    0.1866425
#> ltess_roxelpedestrian   -12.20019128 854.3064206 -1686.6100075 1662.2096250
#> ltess_roxelresidential   -0.42475607   0.2720188    -0.9579032    0.1083911
#> ltess_roxelsecondary     -0.40188260   0.3535534    -1.0948345    0.2910693
#> ltess_roxelservice       -0.14643143   0.3095696    -0.7531767    0.4603138
#> ltess_roxeltrack         -0.21988574   0.5590170    -1.3155389    0.8757674
#> ltess_roxelunclassified  -0.06817756   0.3916747    -0.8358459    0.6994908
#> 
#> Domain: Linear network with 701 vertices and 868 lines
#> Enclosing window: rectangle = [398470.4, 400124.7] x [5755557, 5757747] units

We observe that

exp(-5.57) 
#> [1] 0.00381048

which is quite close to the true value (i.e. 0.005). The other covariates are not significant since the points were generated at random.

Now the idea is to create a wrapper around the following code:

linnet_roxel <- as.linnet(sfn_roxel, sparse = TRUE)
ltess_roxel <- lintess(
  L = linnet_roxel, 
  df = data.frame(
    seg = seq_len(igraph::ecount(sfn_roxel)), 
    t0 = 0, 
    t1 = 1, 
    tile = sfn_roxel |> activate(edges) |> pull(type)
  )
)

Created on 2023-08-07 with reprex v2.0.2

Another example with linim (o im/raster) object:

# packages
suppressPackageStartupMessages({
  library(spatstat)
  library(stars)
  library(tidygraph)
  library(sfnetworks)
})

# create toy data
sfn_roxel <- as_sfnetwork(roxel, directed = FALSE) 
sfn_roxel <- sfn_roxel |> 
  st_transform(32632) |> 
  convert(to_spatial_subdivision) |> 
  convert(to_spatial_simple) |> 
  # This last step is quite important for spatstat object. See the corresponding
  # PR.
  convert(to_spatial_segmentation, .clean = TRUE)
#> Warning: to_spatial_subdivision assumes attributes are constant over geometries
#> Warning: to_spatial_segmentation assumes attributes are constant over
#> geometries

# add a toy variable to each segment which is just the X coordinate of the
# centroid of the segment
sfn_roxel <- sfn_roxel |> 
  activate(edges) |> 
  mutate(X = st_coordinates(st_centroid(.E()))[, 1])
#> Warning: There was 1 warning in `stopifnot()`.
#> ℹ In argument: `X = st_coordinates(st_centroid(.E()))[, 1]`.
#> Caused by warning:
#> ! st_centroid assumes attributes are constant over geometries

# Extract the relevant variable and convert it to raster
X_raster <- sfn_roxel |> st_as_sf("edges") |> select(X) |> st_rasterize()

# Extract the linear network
linnet_roxel <- as.linnet(sfn_roxel, sparse = TRUE)

# Convert to linim object
linim_roxel <- as.linim(X_raster, L = linnet_roxel)

# plot
par(mar = c(0, 0, 0, 3))
plot(linim_roxel, main = "")

Created on 2023-08-12 with reprex v2.0.2

A few notes:

  1. This approach can be used to include numerical covariates into a point process model defined into a linear network and estimate such model with spatstat code (see the example above);
  2. The to_spatial_segmentation is quite important here since, as already discussed in #210, the spatstat code does not exactly preserve the structure of the network so the discretization used to define the raster might exhibit some problem,
  3. Now we could wrap the code above into an S3 method for the generic as.linim. Not sure about the API.