Update activity vignette

R/ab_scenario.R

@@ -125,7 +125,7 @@ ab_scenario = function(
 #' Note: the departure time in seconds is multiplied by 10000 on conversion
 #' to a .json list object for compatibility with the A/B Street schema.
 #'
-#' @param desire_lines_out OD data represented as geographic lines created by
+#' @param desire_lines OD data represented as geographic lines created by
 #' [ab_scenario()].
 #' @param mode_column The column name in the desire lines data that contains
 #' the mode of transport. `"mode_baseline"` by default.
@@ -155,12 +155,12 @@ ab_scenario = function(
 #'
 #' # Starting with JSON data from A/B Street (multiple trips per person)
 #' f = system.file("extdata/minimal_scenario2.json", package = "abstr")
-#' desire_lines_out = ab_sf(f)
-#' desire_lines_out
-#' json_list = ab_json(desire_lines_out)
+#' desire_lines = ab_sf(f)
+#' desire_lines
+#' json_list = ab_json(desire_lines)
 #' json_list
 ab_json = function(
- desire_lines_out,
+ desire_lines,
  mode_column = NULL,
  time_fun = ab_time_normal,
  scenario_name = "test",
@@ -175,36 +175,37 @@ ab_json = function(
  if(is.null(mode_column)) {
  mode_column = "mode"
  }
- n = nrow(desire_lines_out)
+ n = nrow(desire_lines)
 
- if(is.null(desire_lines_out$departure)) {
- desire_lines_out$departure = time_fun(n = n, ...)
+ if(is.null(desire_lines$departure)) {
+ desire_lines$departure = time_fun(n = n, ...)
  }
 
  # Do not multiply by 10k if the maximum number is already greater than 7 days
- if(max(desire_lines_out$departure) > 7 * 24 * 60 * 60) {
+ if(max(desire_lines$departure) > 7 * 24 * 60 * 60) {
  stop(
  "Values greater than 604800 found in the input for departure timesT Try:\n",
- "desire_lines_out$departure = desire_lines_out$departure / 10000 \n",
+ "desire_lines$departure = desire_lines$departure / 10000 \n",
  "if the original input was in 10,000th of a second (used internally by A/B Street)"
  )
  }
+ desire_lines$departure = desire_lines$departure * 10000
 
- start_points = lwgeom::st_startpoint(desire_lines_out) %>% sf::st_coordinates()
- end_points = lwgeom::st_endpoint(desire_lines_out) %>% sf::st_coordinates()
+ start_points = lwgeom::st_startpoint(desire_lines) %>% sf::st_coordinates()
+ end_points = lwgeom::st_endpoint(desire_lines) %>% sf::st_coordinates()
  colnames(start_points) = c("ox", "oy")
  colnames(end_points) = c("dx", "dy")
 
 
  ddf = cbind(
- sf::st_drop_geometry(desire_lines_out),
+ sf::st_drop_geometry(desire_lines),
  start_points,
  end_points
  )
- if(is.null(desire_lines_out$person)) {
- ddf$person = seq(nrow(desire_lines_out))
+ if(is.null(desire_lines$person)) {
+ ddf$person = seq(nrow(desire_lines))
  }
- if(is.null(desire_lines_out$purpose)) {
+ if(is.null(desire_lines$purpose)) {
  ddf$purpose = default_purpose
  }
  # Base R approach (tried tidyverse briefly to no avail)
@@ -283,7 +284,8 @@ ab_sf = function(
  sf_data = subset(trip_data, select = -c(origin, destination))
  sf_linestring = sf::st_sf(
  sf_data,
- geometry = linestrings
+ geometry = linestrings,
+ crs = 4326
  )
  # Give departure time more user friendly units:
  sf_linestring$departure = sf_linestring$departure / 10000

inst/extdata/activity_leeds.json

@@ -0,0 +1,94 @@
+{
+ "scenario_name": "activity",
+ "people": [
+ {
+ "trips": [
+ {
+ "departure": 313400000,
+ "origin": {
+ "Position": {
+ "longitude": -1.524,
+ "latitude": 53.819
+ }
+ },
+ "destination": {
+ "Position": {
+ "longitude": -1.552,
+ "latitude": 53.807
+ }
+ },
+ "mode": "Bike",
+ "purpose": "Work"
+ },
+ {
+ "departure": 410950000,
+ "origin": {
+ "Position": {
+ "longitude": -1.552,
+ "latitude": 53.807
+ }
+ },
+ "destination": {
+ "Position": {
+ "longitude": -1.56,
+ "latitude": 53.812
+ }
+ },
+ "mode": "Walk",
+ "purpose": "Work"
+ },
+ {
+ "departure": 442960000,
+ "origin": {
+ "Position": {
+ "longitude": -1.56,
+ "latitude": 53.812
+ }
+ },
+ "destination": {
+ "Position": {
+ "longitude": -1.556,
+ "latitude": 53.802
+ }
+ },
+ "mode": "Walk",
+ "purpose": "Work"
+ },
+ {
+ "departure": 462420000,
+ "origin": {
+ "Position": {
+ "longitude": -1.556,
+ "latitude": 53.802
+ }
+ },
+ "destination": {
+ "Position": {
+ "longitude": -1.552,
+ "latitude": 53.807
+ }
+ },
+ "mode": "Walk",
+ "purpose": "Work"
+ },
+ {
+ "departure": 614180000,
+ "origin": {
+ "Position": {
+ "longitude": -1.552,
+ "latitude": 53.807
+ }
+ },
+ "destination": {
+ "Position": {
+ "longitude": -1.524,
+ "latitude": 53.819
+ }
+ },
+ "mode": "Bike",
+ "purpose": "Work"
+ }
+ ]
+ }
+ ]
+}

vignettes/activity.Rmd

@@ -14,6 +14,8 @@ knitr::opts_chunk$set(
 )
 ```
 
+# Introduction
+
 Simple representations of transport systems based on origin-destination data often represent daily travel patterns as a single main trip per day, without distinguishing between multiple stages in a multi-stage trip (walk -> bus -> walk -> destination trips are simply represented as bus -> destination) or even multiple trips during the course of the day (omitting the fact that many people take a lunchtime trip to get lunch or simply to stretch their legs each day).
 
 The concept of an 'activity model' aims to address these limitations by representing the complete list of activities undertaken by people throughout the day in the activity model.
@@ -24,17 +26,16 @@ This 5 trip activity is more realistic that simple OD based models that just rep
 
 ![](od-sketch.png)
 
-
 How to get this information into a format for modelling?
-This article demonstrates how the data can be represented in R, and then converted into a format that can be imported by A/B Street.
+This article demonstrates how the data can be represented in R with the `abstr` package, and then converted into a format that can be imported by A/B Street.
 
 ```{r setup}
 library(abstr)
 ```
 
+# Minimal example
 
-In R code, this can be represented as follows:
-
+In R code, the minimal example shown above can be represented as two data frames (tabular datasets), one representing trip origins and destinations and the other representing movement between them, as follows:
 
 ```{r getlocations, eval=FALSE, echo=FALSE}
 home = stplanr::geo_code("potternewton park")
@@ -45,7 +46,6 @@ cafe = stplanr::geo_code("worsley building leeds")
 ```
 
 
-
 ```{r places}
 places = tibble::tribble(
  ~name, ~x, ~y,
@@ -82,16 +82,24 @@ od = tibble::tribble(
  "Cafe", "Work", "Walk", "12:45", 1,
  "Work", "Home", "Bike", "17:00", 1
 )
+```
+
+The two datasets can be joined, giving spatial attributes (origin and destination locations creating a straight line) for each OD pairs, using the `od_to_sf()` function from the `od` package as follows:
+
+```{r}
 od_sf = od::od_to_sf(od, places_sf)
 plot(od_sf["departure"], reset = FALSE, key.pos = 1, lwd = 6:2)
 plot(places_sf$geometry, pch = places$name, add = TRUE, cex =2)
 # mapview::mapview(od_sf["departure"])
 ```
 
-```{r, eval=FALSE}
-od::od_coordinates(od_sf)
+As an aside, another way of representing the spatial attributes of the OD data: four columns with 'X' and 'Y' coordinates for both origins and destinations:
+
+```{r}
+(od::od_coordinates(od_sf))
 ```
 
+We will assign departure times and randomise the exact time (representing the fact that people rarely depart when they plan to, let alone exactly on the hour) with the `ab_time_normal()` function as follows:
 
 
 ```{r}
@@ -102,19 +110,34 @@ departure_times = c(
  12.75,
  17
 )
+set.seed(42) # if you want deterministic results, set a seed.
 od_sf$departure = ab_time_normal(hr = departure_times, sd = 0.15, n = length(departure_times))
-od_json1 = ab_json(desire_lines_out = od_sf[1, ], scenario_name = "activity")
-od_json2 = ab_json(desire_lines_out = od_sf[1:2, ], scenario_name = "activity")
-od_json = ab_json(desire_lines_out = od_sf, scenario_name = "activity")
 ```
 
-```{r, results='asis'}
+The `ab_json()` function converts the 'spatial data frame' representation of activity patterns shown above into the 'nested list' format required by A/B Street as follows (with the first line converting only the first row and the second line converting all 5 OD pairs):
+
+```{r}
+od_json1 = ab_json(od_sf[1, ], scenario_name = "activity")
+od_json = ab_json(od_sf, scenario_name = "activity")
+```
+
+Finally, the list representation can be saved as a `.json` file as follows:
+
+```{r absave}
 ab_save(od_json1, f = "scenario1.json")
-# readChar("scenario1.json", nchars = 1e9)
-# file.edit("scenario1.json")
 ```
 
-That results in the following file:
+```{r, eval=FALSE, echo=FALSE}
+ab_save(od_json, "inst/extdata/activity_leeds.json")
+```
+
+
+That results in the following file (see [activity_leeds.json](https:/a-b-street/abstr/blob/main/inst/extdata/activity_leeds.json) in the package's external data for the full dataset in JSON form):
+
+```{r, eval=FALSE}
+file.edit("scenario1.json")
+```
+
 
 ```json
 {
@@ -123,7 +146,7 @@ That results in the following file:
  {
  "trips": [
  {
- "departure": 304770000,
+ "departure": 313400000,
  "origin": {
  "Position": {
  "longitude": -1.524,
@@ -137,18 +160,22 @@ That results in the following file:
  }
  },
  "mode": "Bike",
- "purpose": "Shopping"
+ "purpose": "Work"
  }
  ]
  }
  ]
 }
-
 ```
 
-What do the first 2 trips look like?
+You can check the 'round trip' conversion of this JSON representation back into the data frame representation as follows:
+
+<!-- Todo: these are not totally identical, only the geomtry is: -->
 
 ```{r}
-ab_save(od_json2, "scenario2.json")
-# file.edit("scenario2.json")
+od_sf_roundtrip = ab_sf(json = system.file("extdata/activity_leeds.json", package = "abstr"))
+identical(od_sf$geometry, od_sf_roundtrip$geometry) 
 ```
+
+
+