R | Robin Lovelace

be seen dead

library(stats19)
crashes = get_stats19(year = 1979:2024, type = "crashes")

pak::pak("ropensci/stats19")

blogdown::shortcode_html("tweet", "1166628966410719232")

download.file("https://www.openstreetmap.org/trace/3046619/data", "track1.gpx")
sf::st_layers("track1.gpx")
track = sf::read_sf("track1.gpx", layer = "tracks")
mapview::mapview(track)

library(stplanr)

remotes::install_github("ropensci/stplanr", ref = "refactor-overline")

library(stplanr)
routes_fast_sf$value = 1
sl = routes_fast_sf[2:3, ]
sl$value = c(2, 5)
overline_sf2 = function(sl, attrib) {
 attrib = "value"
 attrib1 = paste0(attrib, ".1")
 sl_intersection = sf::st_intersection(sl[1, attrib], sl[2, attrib])
 sl_intersection[[attrib]] = sl_intersection[[attrib]] + sl_intersection[[attrib1]]
 sl_intersection[[attrib1]] = NULL
 sl_seg = sf::st_difference(sl[attrib], sf::st_geometry(sl_intersection))
 rnet = rbind(sl_intersection, sl_seg)
 return(rnet)
}

rnet = overline_sf(sl, "value")
plot(rnet["value"], lwd = rnet$value)
plot(sl["value"], lwd = sl$value, col = sf::sf.colors(2, alpha = 0.5))

sl3 = routes_fast_sf[4, ]
rnet = overline_sf2(rnet, sl)
plot(rnet$geometry, lwd = rnet$value)
plot(sl3, col = "red", add = TRUE)

attrib = "value"
rnet3 = rbind(rnet, sl3[attrib])
plot(rnet3$geometry, lwd = rnet3$value)

sl1_3 = as(routes_fast_sf[2:4, ], "Spatial")
rnet3_sp = overline(sl1_3, attrib = "value")
plot(rnet3_sp, lwd = rnet3_sp$value)

sl4_5 = routes_fast_sf[5:6, ]
plot(rnet3$geometry, lwd = rnet3$value)
plot(sl4_5$geometry, col = "red", add = TRUE)

relations = sf::st_relate(sl4_5, rnet3)
relations
unique(as.vector(relations))

relate_rnet_3 = sf::st_relate(rnet, sl3, pattern = "1F1F00102")
relate_rnet_3
any(lengths(relate_rnet_3))

sl4 = sl4_5[1, ]
relate_rnet_4 = sf::st_relate(rnet3, sl4, pattern = "1F1F00102")
relate_rnet_4
any(lengths(relate_rnet_4))

sel_overlaps = lengths(relate_rnet_4) > 0
rnet_overlaps = rnet3[sel_overlaps, ]
rnet3_tmp = rnet3[!sel_overlaps, ]

nrow(rnet_overlaps)

rnet_overlaps4 = overline_sf2(rbind(rnet_overlaps, sl4[attrib]))

rnet = rbind(rnet3_tmp, rnet_overlaps4)
plot(rnet$geometry, lwd = rnet$value)

stplanr::overline_sf

stplanr::overline_sf2

stplanr::overlaps
stplanr::to_linestring

r6 = routes_fast_sf[2:6, ]
rnet6 = overline_sf(r6, attrib = "value")
plot(rnet6)

bench::mark(check = FALSE,
 overline = stplanr::overline(r6, "value"),
 overline_sf = stplanr::overline_sf(r6, "value"),
 overline2 = stplanr::overline2(r6, "value")
)

library(stplanr)
sl_sp = routes_fast[2:3, ]
sl_sp@data = data.frame(value = c(2, 5))
plot(sl_sp, lwd = 9, col = "yellow")
rnet_sp = overline(sl_sp, attr = "value")
plot(rnet_sp, add = TRUE, lwd = rnet_sp$value)

library(stplanr)
sl = routes_fast_sf[2:3, ]
sl$value = c(2, 5)

sl_intersection = sf::st_intersection(sl[1, ], sl[2, ])
plot(sl$geometry, lwd = 9, col = sf::sf.colors(2, alpha = 0.5))
plot(sl_intersection, add = TRUE)

sl_intersection$value = sum(sl_intersection$value, sl_intersection$value.1)

sl_seg1 = sf::st_difference(sl[1, ], sl_intersection)
sl_seg2 = sf::st_difference(sl[2, ], sl_intersection)
plot(sl$geometry, lwd = 9, col = sf::sf.colors(2, alpha = 0.5))
plot(sl_seg1, add = TRUE)
plot(sl_seg2, add = TRUE)

rnet = rbind(sl_seg1, sl_seg2, sl_intersection)

attrib = "value"
attrib1 = paste0(attrib, ".1")
sl_intersection = sf::st_intersection(sl[1, attrib], sl[2, attrib])
sl_intersection[[attrib]] = sl_intersection[[attrib]] + sl_intersection[[attrib1]]
sl_intersection[[attrib1]] = NULL

sl_seg = sf::st_difference(sl[attrib], sf::st_geometry(sl_intersection))
rnet = rbind(sl_intersection, sl_seg)

plot(rnet, lwd = rnet$value)

overline_sf2 = function(sl, attrib) {
 attrib = "value"
 attrib1 = paste0(attrib, ".1")
 sl_intersection = sf::st_intersection(sl[1, attrib], sl[2, attrib])
 sl_intersection[[attrib]] = sl_intersection[[attrib]] + sl_intersection[[attrib1]]
 sl_intersection[[attrib1]] = NULL
 sl_seg = sf::st_difference(sl[attrib], sf::st_geometry(sl_intersection))
 rnet = rbind(sl_intersection, sl_seg)
 return(rnet)
}

bench::mark(check = F,
 overline.sp = overline(sl_sp, attrib = "value"),
 overline.sf = overline(sl, attrib = "value"),
 overline_sf2 = overline_sf2(sl, attrib = "value")
 )

plot(1:9)

u = "http://geostat-course.org/system/files/data_0.zip"
download.file(u, "data_0.zip")
unzip("data_0.zip")

old = setwd("~/repos/geostat2016-rl/")
library(raster)

## Loading required package: sp

bbo = shapefile("data/bbo.shp")
buildings = shapefile("data/buildings.shp")
deaths = shapefile("data/deaths.shp")
b_pump = shapefile("data/b_pump.shp")
nb_pump = shapefile("data/nb_pump.shp")
plot(buildings)

setwd(old)

library(sp)
x <- c(4,7,3,8)
y <- c(9,6,12,11)
xy <- data.frame(x, y)
SpatialPoints(xy)

## class : SpatialPoints
## features : 4
## extent : 3, 8, 6, 12 (xmin, xmax, ymin, ymax)
## coord. ref. : NA

d = data.frame(v1 = 1:4, v2 = LETTERS[1:4])
spd = SpatialPointsDataFrame(coords = xy, data = d)
plot(spd)

library(raster)
r = raster(nc = 10, nr = 10)
values(r) = 1:ncell(r)
plot(r)

as.matrix(r)

## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
## [1,] 1 2 3 4 5 6 7 8 9 10
## [2,] 11 12 13 14 15 16 17 18 19 20
## [3,] 21 22 23 24 25 26 27 28 29 30
## [4,] 31 32 33 34 35 36 37 38 39 40
## [5,] 41 42 43 44 45 46 47 48 49 50
## [6,] 51 52 53 54 55 56 57 58 59 60
## [7,] 61 62 63 64 65 66 67 68 69 70
## [8,] 71 72 73 74 75 76 77 78 79 80
## [9,] 81 82 83 84 85 86 87 88 89 90
## [10,] 91 92 93 94 95 96 97 98 99 100

q = sqrt(r)
plot(q)

x = q + r
s = stack(r, q, x)
ss = s * r # r is recycled so each layer is multiplied by r
1:3 * 2 # here 2 is recycled

## [1] 2 4 6

library(dismo)
g = gmap("Albacete, Spain", scale = T, lonlat = T)

## Loading required namespace: XML

plot(g, interpolate = T)

dismo::geocode("Universidad Castilla la Mancha")

## originalPlace
## 1 Universidad Castilla la Mancha
## interpretedPlace longitude
## 1 Paseo Universidad, 13005 Ciudad Real, Cdad. Real, Spain -3.921711
## latitude xmin xmax ymin ymax uncertainty
## 1 38.99035 -3.922007 -3.919309 38.98919 38.99189 131

install.packages("units")

library(units)
m = with(ud_units, m)
s = with(ud_units, s)
km = with(ud_units, km)
h = with(ud_units, h)
x = 1:3 * m/s

from <- 'Leeds station, New Station Street, Leeds LS1 5DL, United Kingdom'
to <- 'LS2 9JT'
route_df <- route(from, to, structure = 'route', mode = 'walking')

qmap('Merrion Centre', zoom = 15) +
 geom_path(
 aes(x = lon, y = lat), colour = 'red', size = 1.5,
 data = route_df, lineend = 'round')

rquiet <- gLines2CyclePath(l = rlines, plan = "quietest")
plot(rquiet[1,]) # route from Leeds station to Leeds University (North - South)
plot(rquiet[2,]) # route from Leeds to Manchester!

setwd("../")
library(rgdal)
stations <- readOGR("data", "lnd-stns")
## OGR data source with driver: ESRI Shapefile
## Source: "data", layer: "lnd-stns"
## with 2532 features and 27 fields
## Feature type: wkbPoint with 2 dimensions
zones <- readOGR("data", "london_sport")
## OGR data source with driver: ESRI Shapefile
## Source: "data", layer: "london_sport"
## with 33 features and 4 fields
## Feature type: wkbPolygon with 2 dimensions

M <- matrix(1:10, ncol = 5)
M[2, 3:5]
## [1] 6 8 10

stations <- spTransform(stations, CRS(proj4string(zones))) # transform CRS
plot(zones)
points(stations)

stations_subset <- stations[zones, ]

plot(zones)
points(stations_subset)

b <- bbox(zones)
b[1, ] <- (b[1, ] - mean(b[1, ])) * 0.5 + mean(b[1, ])
b[2, ] <- (b[2, ] - mean(b[2, ])) * 0.5 + mean(b[2, ])
b <- bbox(t(b))
plot(zones, xlim = b[1, ], ylim = b[2, ])

library(raster)
library(rgeos)
## rgeos version: 0.3-5, (SVN revision 447)
## GEOS runtime version: 3.4.2-CAPI-1.8.2 r3921
## Polygon checking: TRUE
gClip <- function(shp, bb){
if(class(bb) == "matrix") b_poly <- as(extent(as.vector(t(bb))), "SpatialPolygons")
else b_poly <- as(extent(bb), "SpatialPolygons")
gIntersection(shp, b_poly, byid = T)
}
zones_clipped <- gClip(zones, b)
## Warning: spgeom1 and spgeom2 have different proj4 strings
plot(zones_clipped)

westminster <- zones[grep("West", zones$name),]
zones_clipped_w <- gClip(zones, westminster)
## Warning: spgeom1 and spgeom2 have different proj4 strings
plot(zones_clipped_w); plot(westminster, col = "red", add = T)

u <- "https://github.com/Robinlovelace/lilacPlot/raw/master/F2.csv"
f <- read.csv(u)
knitr::kable(f[1:3, ])
library(ggplot2)
(p <- ggplot(f, aes(x = H, y = Allocation)) + geom_bar(color = "black", stat = "identity",
width = 1))
p + coord_polar()
w <- f$Value
pos <- 0.5 * (cumsum(w) + cumsum(c(0, w[-length(w)])))
(p <- ggplot(f, aes(x = pos)) + geom_bar(aes(y = Allocation), width = w, color = "black",
stat = "identity"))
p + coord_polar(theta = "x") + scale_x_continuous(labels = f$H, breaks = pos)
f$Deposit/f$Value
## [1] 0.09999573 0.09999759 0.10000314 0.09999837 0.10000120 0.10000000
## [7] 0.10000311 0.10000085 0.10000511 0.10000356 0.09999676 0.09999700
## [13] 0.09999812 0.10000511 0.10000085 0.10000240 0.10000000 0.10000694
## [19] 0.09999901 0.09999883
# add 10% in there
p <- ggplot(f)
p + geom_bar(aes(x = pos, y = Allocation), width = w, color = "black", stat = "identity") +
geom_bar(aes(x = pos, y = 0.1), width = w, color = "black", stat = "identity",
fill = "green") + coord_polar()
# make proportional to area
f$Allo <- sqrt(f$Allocation)
p <- ggplot(f)
p + geom_bar(aes(x = pos, y = Allo, width = w), color = "black", stat = "identity") +
geom_bar(aes(x = pos, y = sqrt(0.1), width = w), color = "black", stat = "identity",
fill = "green") + coord_polar()
## Warning: Ignoring unknown aesthetics: width
## Warning: Ignoring unknown aesthetics: width
# add capital
capital <- (f$Captial + f$Deposit)/(f$Value) * f$Allocation
capital <- sqrt(capital)
p + geom_bar(aes(x = pos, y = Allo, width = w), color = "black", stat = "identity") +
geom_bar(aes(x = pos, y = capital, width = w), color = "black", stat = "identity",
fill = "red") + geom_bar(aes(x = pos, y = sqrt(0.1), width = w), color = "black",
stat = "identity", fill = "green") + coord_polar() + scale_x_continuous(labels = f$H,
breaks = pos)
## Warning: Ignoring unknown aesthetics: width
## Warning: Ignoring unknown aesthetics: width
## Warning: Ignoring unknown aesthetics: width
# add ablines
p + geom_bar(aes(x = pos, y = Allo, width = w), color = "grey40", stat = "identity",
fill = "lightgrey") + geom_bar(aes(x = pos, y = capital, width = w), color = "grey40",
stat = "identity", fill = "red") + geom_bar(aes(x = pos, y = sqrt(0.1),
width = w), color = "grey40", stat = "identity", fill = "green") + geom_abline(intercept = 1,
slope = 0, linetype = 2) + geom_abline(intercept = sqrt(1.1), slope = 0,
linetype = 3) + geom_abline(intercept = sqrt(0.9), slope = 0, linetype = 3)
## Warning: Ignoring unknown aesthetics: width
## Warning: Ignoring unknown aesthetics: width
## Warning: Ignoring unknown aesthetics: width
# calculate vertical ablines of divisions
v1 <- 0.51 * f$Value[1]
v2 <- cumsum(f$Value)[17] + f$Value[18] * 0.31
v3 <- cumsum(f$Value)[17] + f$Value[18] * 0.64
p + geom_bar(aes(x = pos, y = Allo, width = w), color = "grey40", stat = "identity",
fill = "lightgrey") +
geom_vline(x = v1, linetype = 5, xintercept = 0) +
geom_vline(x = v2, linetype = 5, xintercept = 0) +
geom_vline(x = v3, linetype = 5, xintercept = 0) +
coord_polar()
## Warning: Ignoring unknown aesthetics: width
## Warning: Ignoring unknown parameters: x
## Warning: Ignoring unknown parameters: x
## Warning: Ignoring unknown parameters: x
# putting it all together
p <- ggplot(f)
p + geom_bar(aes(x = pos, y = Allo, width = w), color = "grey40", stat = "identity",
fill = "lightgrey") + geom_bar(aes(x = pos, y = capital, width = w), color = "grey40",
stat = "identity", fill = "red") + geom_bar(aes(x = pos, y = sqrt(0.1),
width = w), color = "grey40", stat = "identity", fill = "green") + geom_abline(intercept = 1,
slope = 0, linetype = 2) + geom_abline(intercept = sqrt(1.1), slope = 0,
linetype = 3) + geom_abline(intercept = sqrt(0.9), slope = 0, linetype = 3) +
geom_vline(x = v1, linetype = 5, xintercept = 0) +
geom_vline(x = v2, linetype = 5, xintercept = 0) +
geom_vline(x = v3, linetype = 5, xintercept = 0) +
coord_polar() + scale_x_continuous(labels = f$H, breaks = pos) +
theme_classic()
## Warning: Ignoring unknown aesthetics: width
## Warning: Ignoring unknown aesthetics: width
## Warning: Ignoring unknown aesthetics: width
## Warning: Ignoring unknown parameters: x
## Warning: Ignoring unknown parameters: x
## Warning: Ignoring unknown parameters: x
theme_infog <- theme_classic() + theme(axis.line = element_blank(), axis.title = element_blank(),
axis.ticks = element_blank(), axis.text.y = element_blank())
last_plot() + theme_infog
f$Cap.r <- f$Cap/mean(f$Cap) * 0.1 + 1.2
f$Cont.r <- f$Contribution/mean(f$Cap) * 0.1 + 1.2
f$Rep.r <- f$Cont.r + f$Repayments/mean(f$Cap) * 0.1
f$H <- c("a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n",
"o", "p", "q", "r", "s", "t")
p <- ggplot(f)
p + geom_bar(aes(x = pos, y = Allo, width = w), color = "grey40", stat = "identity",
fill = "lightgrey")
## Warning: Ignoring unknown aesthetics: width
# we need the axes to be bigger for starters - try 1.3 to 1.5
p + geom_bar(aes(x = pos, y = Cap.r, width = w), color = "grey40", stat = "identity",
fill = "white") + geom_bar(aes(x = pos, y = Rep.r, width = w), color = "grey40",
stat = "identity", fill = "grey80") + geom_bar(aes(x = pos, y = Cont.r,
width = w), color = "grey40", stat = "identity", fill = "grey30") + geom_bar(aes(x = pos,
y = 1.196, width = w), color = "white", stat = "identity", fill = "white")
## Warning: Ignoring unknown aesthetics: width
## Warning: Ignoring unknown aesthetics: width
## Warning: Ignoring unknown aesthetics: width
## Warning: Ignoring unknown aesthetics: width
last_plot() + geom_bar(aes(x = pos, y = Allo, width = w), color = "grey40",
stat = "identity", fill = "grey80") + geom_bar(aes(x = pos, y = capital,
width = w), color = "grey40", stat = "identity", fill = "grey30") + geom_bar(aes(x = pos,
y = sqrt(0.1), width = w), color = "grey40", stat = "identity", fill = "black") +
geom_abline(intercept = 1, slope = 0, linetype = 5) + geom_abline(intercept = sqrt(1.1),
slope = 0, linetype = 3) + geom_abline(intercept = sqrt(0.9), slope = 0,
linetype = 3) + coord_polar() + scale_x_continuous(labels = f$H, breaks = pos) +
theme_infog
## Warning: Ignoring unknown aesthetics: width
## Warning: Ignoring unknown aesthetics: width
## Warning: Ignoring unknown aesthetics: width
p <- ggplot(f)
p + geom_bar(aes(x = pos, y = Allo, width = w), color = "grey40", stat = "identity",
fill = "grey80") + geom_bar(aes(x = pos, y = capital, width = w), color = "grey40",
stat = "identity", fill = "grey30") + geom_bar(aes(x = pos, y = sqrt(0.1),
width = w), color = "grey40", stat = "identity", fill = "black") + geom_abline(intercept = 1,
slope = 0, linetype = 5) + geom_abline(intercept = sqrt(1.1), slope = 0,
linetype = 3) + geom_abline(intercept = sqrt(0.9), slope = 0, linetype = 3) +
coord_polar() + scale_x_continuous(labels = f$H, breaks = pos) + theme_infog
## Warning: Ignoring unknown aesthetics: width
## Warning: Ignoring unknown aesthetics: width
## Warning: Ignoring unknown aesthetics: width
ggsave("just-inner.png", width = 7, height = 7, dpi = 800)

Session	Speaker	Title	link
Movement & transport	Rocio Joo	Navigating through the R packages for movement	http://www.user2019.fr/static/pres/t258615.pdf
Movement & transport	Mohammad Mehdi Moradi	Classes, methods and data analysis for trajectories	http://www.user2019.fr/static/pres/t251784.pdf
Movement & transport	Christine Thomas-Agnan	Modelling spatial flows with R	http://www.user2019.fr/static/pres/t256726.pdf
Movement & transport	Robin Lovelace	R for Transport Planning	https://www.robinlovelace.net/presentations/user2019-r-for-transport-planning.html

H	Value	Value.P	Allocation	Deposit	Captial	Debt	Cap	Contribution	Repayments
q	163827	0.065	0.979	16382	147445	0	2457.405	1287.24	0.00
a	165994	0.066	1.022	16599	5488	138847	2489.910	208.02	208.02
z	159425	0.063	0.933	15943	76632	63601	2391.375	995.46	995.46

R | Robin Lovelace

stats19 v4.0.0: 45 Years of UK Road Crash Data, Unified

Unified schema

Parsing fixes

Missing values

Performance

New functions

Multi-year downloads

Feedback wanted

Acknowledgements

Links

Installing spatial R packages on Ubuntu

CASA summer school on geographic data

Six great things about UseR! 2019

1. Diverse formats

2. Worldwide dissemination

3. Relaxed atmosphere

4. The host city of Toulouse

5. UseR! 2019 socials

6. Meeting collaborators and online acquaintances

My talk

Conclusion

stplanr paper published

References

Aggregating lines, part II

Set-up

Dealing with many lines

Another benchmark

Aggregating lines, Part I

Introduction

Why aggregate lines?

Aggregating lines with overline() MKI

Aggregating lines with sf

A benchmark

Next steps

References

Switching to blogdown

Geostat2016 Albacete: a write-up

Day 1

Day 2

Day 3

Day 4

Day 5

Summary

R vs QGIS for sustainable transport planning

R for transport applications

Routing with R

Large gps datasets with PostGIS

A hackathon

Summary

Acknowledgements

References

Clipping spatial data in R

Loading the data

The wonder of spatial subsetting in R

Clipping by a bounding box

Conclusion

Update

Coxcomb plots and 'spiecharts' in R

Reading and looking at the data

Adding the 10 %

Create theme with no axes

Creating a ring

Just inner