`, etc.) that has more than one element. Defaults to 1 (for ``).
76 | getTopLevel: function($scope) {
77 | for (var i = 1; i <= 6; i++) {
78 | var $headings = this.findOrFilter($scope, 'h' + i);
79 | if ($headings.length > 1) {
80 | return i;
81 | }
82 | }
83 |
84 | return 1;
85 | },
86 |
87 | // returns the elements for the top level, and the next below it
88 | getHeadings: function($scope, topLevel) {
89 | var topSelector = 'h' + topLevel;
90 |
91 | var secondaryLevel = topLevel + 1;
92 | var secondarySelector = 'h' + secondaryLevel;
93 |
94 | return this.findOrFilter($scope, topSelector + ',' + secondarySelector);
95 | },
96 |
97 | getNavLevel: function(el) {
98 | return parseInt(el.tagName.charAt(1), 10);
99 | },
100 |
101 | populateNav: function($topContext, topLevel, $headings) {
102 | var $context = $topContext;
103 | var $prevNav;
104 |
105 | var helpers = this;
106 | $headings.each(function(i, el) {
107 | var $newNav = helpers.generateNavItem(el);
108 | var navLevel = helpers.getNavLevel(el);
109 |
110 | // determine the proper $context
111 | if (navLevel === topLevel) {
112 | // use top level
113 | $context = $topContext;
114 | } else if ($prevNav && $context === $topContext) {
115 | // create a new level of the tree and switch to it
116 | $context = helpers.createChildNavList($prevNav);
117 | } // else use the current $context
118 |
119 | $context.append($newNav);
120 |
121 | $prevNav = $newNav;
122 | });
123 | },
124 |
125 | parseOps: function(arg) {
126 | var opts;
127 | if (arg.jquery) {
128 | opts = {
129 | $nav: arg
130 | };
131 | } else {
132 | opts = arg;
133 | }
134 | opts.$scope = opts.$scope || $(document.body);
135 | return opts;
136 | }
137 | },
138 |
139 | // accepts a jQuery object, or an options object
140 | init: function(opts) {
141 | opts = this.helpers.parseOps(opts);
142 |
143 | // ensure that the data attribute is in place for styling
144 | opts.$nav.attr('data-toggle', 'toc');
145 |
146 | var $topContext = this.helpers.createChildNavList(opts.$nav);
147 | var topLevel = this.helpers.getTopLevel(opts.$scope);
148 | var $headings = this.helpers.getHeadings(opts.$scope, topLevel);
149 | this.helpers.populateNav($topContext, topLevel, $headings);
150 | }
151 | };
152 |
153 | $(function() {
154 | $('nav[data-toggle="toc"]').each(function(i, el) {
155 | var $nav = $(el);
156 | Toc.init($nav);
157 | });
158 | });
159 | })();
160 |
--------------------------------------------------------------------------------
/R/helper-functions.R:
--------------------------------------------------------------------------------
1 | #' Convert a datetime returned by the PTV API into Melbourne time
2 | #'
3 | #' @param datetime A datetime returned by the PTV API
4 | #'
5 | #' @return A datetime in the Melbourne timezone.
6 | #'
7 | #' @keywords internal
8 | #'
9 | convert_to_melbourne_time <- function(datetime) {
10 |
11 | if (is.null(datetime)) {
12 | na_datetime <- as.POSIXct(NA)
13 | attr(na_datetime, "tzone") <- "Australia/Melbourne"
14 | return(na_datetime)
15 | }
16 |
17 | converted <- as.POSIXct(
18 | datetime,
19 | tz = "GMT",
20 | format = "%Y-%m-%dT%H:%M:%OS"
21 | )
22 | attr(converted, "tzone") <- "Australia/Melbourne"
23 | converted
24 | }
25 |
26 | #' Convert a POSIXct or character datetime to a format ready for a URL
27 | #'
28 | #' Datetimes accepted by the API need to be given in UTC. This function will
29 | #' accept a datetime or a character with a suitable datetime format, and output
30 | #' a character that is suitable for a URL. All URL input and output in this
31 | #' package should be in Melbourne time, and the UTC conversion should happen
32 | #'
33 | #' The API seems to accept both "%Y-%m-%dT%H:%M:%OS" and "%Y-%m-%d %H:%M:%OS",
34 | #' but we opt for the former.
35 | #'
36 | #' @param datetime POSIXct or Character.
37 | #'
38 | #' @return Character.
39 | #'
40 | #' @keywords internal
41 | #'
42 | to_datetime <- function(datetime) {
43 | if (is.character(datetime)) {
44 | datetime <- as.POSIXct(
45 | datetime,
46 | tz = "Australia/Melbourne",
47 | tryFormats = c("%Y-%m-%dT%H:%M:%OS",
48 | "%Y-%m-%d %H:%M:%OS",
49 | "%Y/%m/%d %H:%M:%OS",
50 | "%Y-%m-%d %H:%M",
51 | "%Y/%m/%d %H:%M",
52 | "%Y-%m-%d",
53 | "%Y/%m/%d")
54 | )
55 | }
56 |
57 | assertthat::assert_that(
58 | inherits(datetime, "POSIXct"),
59 | msg = "datetime must be POSIXct, or character that parses as POSIXct"
60 | )
61 |
62 | datetime
63 | }
64 |
65 | #' Map and rbind a list of data frames
66 | #'
67 | #' This function is a simple combination of `purrr::map` and `purrr::reduce`
68 | #' using `rbind`. This differs from `purrr::map_dfr`, which uses
69 | #' `dplyr::map_dfr` and therefore introduces `dplyr` as a dependency. If the
70 | #' provided list is empty, then an empty tibble will be returned.
71 | #'
72 | #' @param .x A list of data frames or tibbles.
73 | #' @param .f A function.
74 | #' @param ... Additional arguments passed to the function.
75 | #'
76 | #' @return A data frame or tibble.
77 | #'
78 | #' @keywords internal
79 | #'
80 | map_and_rbind <- function(.x, .f, ...) {
81 | if (length(.x) == 0) {
82 | return(tibble::tibble())
83 | }
84 | do.call(rbind, lapply(.x, .f, ...))
85 | }
86 |
87 | #' Assert that the API has returned the expected attributes
88 | #'
89 | #' The attributes returned by the API calls should be follow the API schema.
90 | #' This function compares received attributes against a vector of expected
91 | #' attributes, and returns an error if the two do not match. Unfortunately,
92 | #' there is no easy fix for this error: the package developer(s) must be
93 | #' notified, so that they can align the functions against the API schema.
94 | #'
95 | #' @param received_attributes A character vector of attributes, in order.
96 | #' @param expected_attributes A character vector of expected attributes, in
97 | #' order.
98 | #'
99 | #' @return An error if the column names are not as expected.
100 | #'
101 | #' @keywords internal
102 | #'
103 | assert_correct_attributes <- function(received_attributes,
104 | expected_attributes) {
105 | assertthat::assert_that(
106 | identical(received_attributes, expected_attributes),
107 | msg = paste(
108 | "The attributes returned by the API were not as expected.",
109 | "Please contact the package developer.",
110 | "Expected", paste(expected_attributes, collapse = ", "),
111 | "but got", paste(received_attributes, collapse = ", ")
112 | )
113 | )
114 | }
115 |
116 | #' Strictly convert an object to an integer
117 | #'
118 | #' R does not have a built-in function to determine if a value is an integer
119 | #' (`is.integer` will check if the class of an object is "integer", but
120 | #' `is.integer(3)` will return FALSE). This helper function fills that gap. It
121 | #' will attempt to convert the input to an integer, but will error on any input
122 | #' that cannot be confidently expressed as an integer. It serves as a stricter
123 | #' version of `as.integer`. For example, the function will convert `3` or `"3"`
124 | #' to integers, but will error on `3.5` or `"three"`.
125 | #'
126 | #' @param x An input of any type.
127 | #'
128 | #' @return An integer interpretation of `x`, if possible.
129 | #'
130 | #' @keywords internal
131 | #'
132 | to_integer <- function(x) {
133 | if (missing(x)) {
134 | stop("Error in to_integer() : argument \"x\" is missing, with no default")
135 | }
136 |
137 | if (!(typeof(x) %in% c("integer", "double", "character"))) {
138 | stop(paste("Cannot convert", typeof(x), "to an integer"))
139 | }
140 |
141 | error_message <- paste("Cannot convert", x, "to an integer")
142 |
143 | # Try numeric first, then cast to integer
144 | x_numeric <- suppressWarnings(as.numeric(x))
145 | if (is.na(x_numeric)) stop(error_message)
146 | x_integer <- as.integer(x_numeric)
147 | if (x_integer != x_numeric) stop(error_message)
148 | x_integer
149 | }
150 |
--------------------------------------------------------------------------------
/docs/LICENSE-text.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 | License • ptvapi
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
55 |
56 |
57 |
58 |
59 |
60 |
61 |
62 |
63 |
105 |
106 |
107 |
108 |
109 |
110 |
111 |
112 |
113 | License
114 |
115 |
116 | YEAR: 2020
117 | COPYRIGHT HOLDER: David Neuzerling
118 |
119 |
120 |
121 |
122 |
127 |
128 |
129 |
130 |
131 |
132 |
142 |
143 |
144 |
145 |
146 |
147 |
148 |
149 |
150 |
151 |
--------------------------------------------------------------------------------
/docs/404.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 | Page not found (404) • ptvapi
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
32 |
33 |
34 |
35 |
36 |
37 |
38 |
39 |
40 |
41 |
42 |
43 |
44 |
45 |
46 |
47 |
48 |
49 |
50 |
51 |
55 |
56 |
57 |
58 |
59 |
60 |
61 |
62 |
63 |
105 |
106 |
107 |
108 |
109 |
110 |
111 |
112 |
113 | Page not found (404)
114 |
115 |
116 | Content not found. Please use links in the navbar.
117 |
118 |
119 |
120 |
125 |
126 |
127 |
128 |
129 |
130 |
140 |
141 |
142 |
143 |
144 |
145 |
146 |
147 |
148 |
149 |
--------------------------------------------------------------------------------
/R/routes.R:
--------------------------------------------------------------------------------
1 | #' Information for a given route
2 | #'
3 | #' @inheritParams directions_on_route
4 | #' @inheritParams PTVGET
5 | #' @param include_geopath Logical. Whether to populate the `geopath` column.
6 | #' Defaults to FALSE.
7 | #' @param geopath_utc Date, or character that can be converted to a date. The
8 | #' UTC date for which the geopaths are effective. Defaults to the current
9 | #' date. Has no effect if `include_geopath = FALSE`. It's uncertain how much
10 | #' historical or future-dated data is available.
11 | #'
12 | #' @inherit route_to_tibble return
13 | #'
14 | #' @export
15 | #'
16 | #' @examples \dontrun{
17 | #' route_information(6)
18 | #' route_information(6, include_geopath = TRUE)
19 | #' route_information(6, include_geopath = TRUE, geopath_utc = "2020-07-01")
20 | #' }
21 | #'
22 | route_information <- function(route_id,
23 | include_geopath = FALSE,
24 | geopath_utc = NULL,
25 | user_id = determine_user_id(),
26 | api_key = determine_api_key()) {
27 | route_id <- to_integer(route_id)
28 | if (!include_geopath && !is.null(geopath_utc)) {
29 | warning("`geopath_utc` is ignored when `include_geopath` is `TRUE`")
30 | geopath_utc <- NULL
31 | }
32 | if (!is.null(geopath_utc)) {
33 | geopath_utc <- as.Date(geopath_utc)
34 | }
35 |
36 | request <- add_parameters(
37 | glue::glue("routes/{route_id}"),
38 | include_geopath = include_geopath,
39 | geopath_utc = geopath_utc
40 | )
41 | response <- PTVGET(request, user_id = user_id, api_key = api_key)
42 | content <- response$content
43 |
44 | assert_correct_attributes(names(content), c("route", "status"))
45 | parsed <- route_to_tibble(content$route) # may be an empty tibble
46 | parsed$route_type_description <- purrr::map_chr(
47 | parsed$route_type,
48 | describe_route_type,
49 | user_id = user_id,
50 | api_key = api_key
51 | )
52 | new_ptvapi_tibble(response, parsed)
53 | }
54 |
55 | #' Information for all routes
56 | #'
57 | #' @inheritParams stops_nearby
58 | #' @param route_name Character. Optionally filter by route name. Partial matches
59 | #' are accepted, and the matches are not case sensitive.
60 | #' @inheritParams PTVGET
61 | #'
62 | #' @inherit route_to_tibble return
63 | #'
64 | #' @export
65 | #'
66 | #' @examples \dontrun{
67 | #' routes()
68 | #' routes(route_types = "Train")
69 | #' routes(route_types = 0)
70 | #' routes(route_types = c("Train", "Tram"))
71 | #' routes(route_name = "Frankston")
72 | #' routes(route_name = "Craigie")
73 | #' routes(route_name = "werribee")
74 | #' }
75 | routes <- function(route_types = NULL,
76 | route_name = NULL,
77 | user_id = determine_user_id(),
78 | api_key = determine_api_key()) {
79 | if (!is.null(route_types)) {
80 | route_types <- purrr::map_int(
81 | route_types,
82 | translate_route_type,
83 | user_id = user_id,
84 | api_key = api_key
85 | )
86 | }
87 | if (!is.null(route_name)) assertthat::assert_that(is.character(route_name))
88 |
89 | request <- add_parameters(
90 | "routes",
91 | route_types = route_types,
92 | route_name = route_name
93 | )
94 | response <- PTVGET(request, user_id = user_id, api_key = api_key)
95 | content <- response$content
96 | parsed <- map_and_rbind(content$routes, route_to_tibble)
97 | parsed$route_type_description <- purrr::map_chr(
98 | parsed$route_type,
99 | describe_route_type,
100 | user_id = user_id,
101 | api_key = api_key
102 | )
103 | new_ptvapi_tibble(response, parsed)
104 | }
105 |
106 | #' Convert a single route to a tibble
107 | #'
108 | #' This function is designed to parse the content returned by the interior steps
109 | #' of the \code{\link{routes}} function. Service status information may be `NA`,
110 | #' depending on the API call that was used to populate the information.
111 | #'
112 | #' @param route A route, as a list, returned by the \code{\link{routes}} API
113 | #' call.
114 | #'
115 | #' @return A tibble of routes, with the following columns:
116 | #' \itemize{
117 | #' \item `route_id`
118 | #' \item `route_gtfs_id`
119 | #' \item `route_name`
120 | #' \item `route_type`
121 | #' \item `route_type_description`
122 | #' \item `route_number`
123 | #' \item `geopath`
124 | #' \item `service_status`
125 | #' \item `service_status_timestamp`
126 | #' }
127 | #'
128 | #' @keywords internal
129 | #'
130 | route_to_tibble <- function(route) {
131 | if (is.null(route)) {
132 | return(
133 | tibble::tibble(
134 | route_id = integer(),
135 | route_gtfs_id = character(),
136 | route_name = character(),
137 | route_type = integer(),
138 | route_type_description = character(),
139 | route_number = character(),
140 | geopaths = list(),
141 | service_status = character(),
142 | service_status_timestamp = as.POSIXct(NA)
143 | )
144 | )
145 | }
146 | tibble::tibble(
147 | route_id = route$route_id,
148 | route_gtfs_id = route$route_gtfs_id,
149 | route_name = route$route_name,
150 | route_type = route$route_type,
151 | route_type_description = NA_character_,
152 | route_number = ifelse(
153 | # Not always a number, eg. "745a"
154 | route$route_number == "", NA_character_, route$route_number
155 | ),
156 | geopath = if (is.null(route$geopath)) {
157 | list(geopath_to_tibble(NULL))
158 | } else {
159 | list(purrr::map_dfr(route$geopath, geopath_to_tibble))
160 | },
161 | service_status = ifelse(
162 | is.null(route$route_service_status$description),
163 | NA_character_,
164 | route$route_service_status$description
165 | ),
166 | service_status_timestamp = convert_to_melbourne_time(
167 | route$route_service_status$timestamp
168 | )
169 | )
170 | }
171 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 |
2 | # ptvapi 
3 |
4 |
5 | [](https://cran.r-project.org/package=ptvapi)
6 | [](https://cran.r-project.org/package=ptvapi)
7 | [](https://github.com/mdneuzerling/ptvapi/tree/main)
8 | [](https://github.com/mdneuzerling/ptvapi/actions)
9 | [](https://github.com/mdneuzerling/ptvapi/actions?query=workflow%3Alint)
10 | [](https://app.codecov.io/gh/mdneuzerling/ptvapi?branch=main)
11 | [](https://choosealicense.com/licenses/mit/)
12 |
13 |
14 |
15 | This package provides a friendly interface to the Public Transport Victoria (PTV) Timetable API. Results are returned as data frames --- using real-time data where available --- and authentication is handled under the hood.
16 |
17 | **This package is an unofficial wrapper of the Public Transport Victoria timetable API. The authors of this package are not associated with Public Transport Victoria.**
18 |
19 | ## Installing
20 |
21 | ### CRAN version
22 |
23 | ```
24 | install.packages("ptvapi")
25 | ```
26 |
27 | ### Development version
28 |
29 | ```
30 | remotes::install_github("mdneuzerling/ptvapi")
31 | ```
32 |
33 | ## Authentication
34 |
35 | Using the API requires a user ID (also called a `devid`) and an API key from Public Transport Victoria. These can be requested in an email. Refer to the [PTV website](https://www.ptv.vic.gov.au/footer/data-and-reporting/datasets/ptv-timetable-api/) for instructions.
36 |
37 | The user ID and API key be provided directly to the functions, for example:
38 | ```
39 | routes(
40 | user_id = 1234567,
41 | api_key = "xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx"
42 | )
43 | ```
44 |
45 | Alternatively, this information can be set as environment variables. These can be configured directly within R:
46 | ```
47 | Sys.setenv("PTV_USER_ID" = 1234567)
48 | Sys.setenv("PTV_API_KEY" = "xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx")
49 | ```
50 |
51 | If a `user_id` or `api_key` value is not provided to the functions within this package, then they will be retrieved from the "PTV_USER_ID" and "PTV_API_KEY" environment variables, if possible.
52 |
53 | ## Example usage
54 |
55 | The code examples below assume that you've set environment variables for authentication.
56 |
57 | ```r
58 | # tibble of all routes
59 | routes()
60 | # A tibble: 828 x 7
61 | # route_id route_gtfs_id route_name route_type route_number service_status
62 | #
63 | ```
64 |
65 | ```r
66 | # Search for routes by name (case insensitive, partial matching supported)
67 | routes(route_name = "Frankston")
68 | # A tibble: 27 x 7
69 | # route_id route_gtfs_id route_name route_type route_number service_status
70 | #
71 | ```
72 |
73 | ```r
74 | # All current disruptions
75 | disruptions(disruption_status = "current")
76 | # A tibble: 244 x 17
77 | disruption_mode disruption_mode… disruption_id title url description
78 |
79 | # … with 177 more rows, and 17 more variables …
80 | ```
81 |
82 | ```r
83 | # Train stops near Flinders Street Station
84 | stops_nearby(
85 | latitude = -37.8183,
86 | longitude = 144.9671,
87 | route_types = "Train"
88 | )
89 | # # A tibble: 1 x 8
90 | # stop_id stop_name stop_suburb route_type stop_sequence stop_latitude stop_longitude
91 | #
92 | ```
93 |
94 | ```r
95 | # Upcoming train departures from Flinders Street Station
96 | > departures(stop_id = 1071, route_type = "Train")
97 | # A tibble: 75 x 12
98 | direction_id stop_id route_id run_id run_ref platform_number at_platform
99 |
100 | # … with 65 more rows, and 5 more variables: departure_sequence ,
101 | # scheduled_departure , estimated_departure , flags ,
102 | # disruption_ids
103 | ```
104 |
105 | ## A note about route types
106 |
107 | The API recognises five route types: "Train", "Tram", "Bus", "Vline", and "Night Bus". Many functions have arguments such as `route_type` and `route_types` that expect a non-negative integer code representing these route types. To simplify calling the API, these functions will also accept a character description like those above. Under the hood, the functions will translate these descriptions to the non-negative integer codes that the API expects. For example, `routes(route_type = "Train")` is automatically translated to `routes(route_type = 0)`.
108 |
109 | ## Available functions
110 |
111 | All API calls have been implemented. Some API calls have been combined into a single function with arguments, and some have been split into multiple functions. The following functions are available through this package:
112 |
113 | * `departures`
114 | * `directions`
115 | * `directions_on_route`
116 | * `disruption_information`
117 | * `disruption_modes`
118 | * `disruptions`
119 | * `disruptions_at_stop`
120 | * `disruptions_on_route`
121 | * `fare_estimate`
122 | * `outlets`
123 | * `outlets_nearby`
124 | * `patterns`
125 | * `route_information`
126 | * `route_types`
127 | * `routes`
128 | * `run_information`
129 | * `runs_on_route`
130 | * `search_outlets`
131 | * `search_routes`
132 | * `search_stops`
133 | * `stop_information`
134 | * `stops_nearby`
135 | * `stops_on_route`
136 |
137 | ---
138 |
139 | Hex logo by Phizz Leeder
140 |
--------------------------------------------------------------------------------
/R/route-types.R:
--------------------------------------------------------------------------------
1 | #' Retrieve a translation from route type number to name
2 | #'
3 | #' Route types (tram, train, etc.) are provided to the PTV API as an integer
4 | #' code. This function retrieves a named vector in which the values are the
5 | #' route type descriptions, and the names of the vector are the route type
6 | #' numbers. Note that "Night Bus" is a separate route type.
7 | #'
8 | #' @inheritParams PTVGET
9 | #'
10 | #' @return A named integer vector in which the values are the route type
11 | #' descriptions, and the names of the vector are the route type numbers.
12 | #'
13 | #' @export
14 | #'
15 | #' @examples \dontrun{
16 | #' route_types()
17 | #' }
18 | #'
19 | route_types <- function(user_id = determine_user_id(),
20 | api_key = determine_api_key()) {
21 | response <- PTVGET(
22 | request = "route_types",
23 | user_id = user_id,
24 | api_key = api_key
25 | )
26 | content_route_types <- response$content$route_types
27 |
28 | route_type_names <- purrr::map_chr(
29 | content_route_types,
30 | function(x) x$route_type_name
31 | )
32 | route_type_numbers <- purrr::map_int(
33 | content_route_types,
34 | function(x) x$route_type
35 | )
36 | names(route_type_names) <- route_type_numbers
37 | route_type_names
38 | }
39 |
40 | #' Retrieve route types, using cached values if possible
41 | #'
42 | #' @inheritParams PTVGET
43 | #'
44 | #' @description
45 | #' Route types will change extraordinarily rarely --- this would require PTV to
46 | #' add a new route type akin to "train" or "bus". To avoid querying the API too
47 | #' much, we prefer to use cached values for route type translation wherever
48 | #' possible. This function effectively wraps `route_types`, returning cached
49 | #' results if possible or caching results otherwise. Note that if a user
50 | #' specifically calls `route_types` then we do _not_ return cached results.
51 | #'
52 | #' We use the `pkg_env` as a cache, which is an environment created on package
53 | #' load. This is not truly private --- users could still access this as an
54 | #' internal value. But it's effectively "out of the way".
55 | #'
56 | #' @inherit route_types return
57 | #'
58 | #' @keywords internal
59 | cached_route_types <- function(user_id = determine_user_id(),
60 | api_key = determine_api_key()) {
61 | if (is.null(pkg_env$route_types)) {
62 | pkg_env$route_types <- route_types(user_id = user_id, api_key = api_key)
63 | }
64 | pkg_env$route_types
65 | }
66 |
67 | #' Translate a route type input into a numerical route type
68 | #'
69 | #' Many API calls require a route type (eg. "Tram" or "Train"). These must be
70 | #' provided as integers, which are translated to route type descriptions with
71 | #' the `route_types() function/API call. This function will: \itemize{
72 | #' \item Translate a case-insensitive description such as "Tram" or "Train" to
73 | #' the corresponding route type code
74 | #' \item Check a given integer to see if it is a valid route type code,
75 | #' returning it if so and erroring otherwise
76 | #' \item Return NULL on NULL input
77 | #' }
78 | #' This function is _not_ vectorised.
79 | #'
80 | #' @inheritParams PTVGET
81 | #' @param route_type A route type which can be provided either as a non-negative
82 | #' integer code, or as a character: "Tram", "Train", "Bus", "Vline" or "Night
83 | #' Bus". Character inputs are not case-sensitive. Use the
84 | #' \code{\link{route_types}} function to extract a vector of all route types.
85 | #'
86 | #' @return An integer route type code, or NULL if the input is NULL
87 | #'
88 | #' @keywords internal
89 | #'
90 | translate_route_type <- function(route_type,
91 | user_id = determine_user_id(),
92 | api_key = determine_api_key()) {
93 |
94 | route_type_vector <- cached_route_types(user_id = user_id, api_key = api_key)
95 |
96 | if (is.numeric(route_type)) {
97 | if (as.character(route_type) %in% names(route_type_vector)) {
98 | translation <- route_type
99 | } else {
100 | stop(
101 | route_type,
102 | " is not a valid route type code. Valid codes are ",
103 | paste(names(route_type_vector), collapse = ", ")
104 | )
105 | }
106 | } else if (is.character(route_type)) {
107 | if (toupper(route_type) %in% toupper(route_type_vector)) {
108 | translation <- names(
109 | route_type_vector[
110 | which(toupper(route_type_vector) == toupper(route_type))]
111 | )
112 | } else {
113 | stop(
114 | route_type,
115 | " is not a valid route type description. Valid descriptions are ",
116 | paste(route_type_vector, collapse = ", ")
117 | )
118 | }
119 | } else {
120 | stop(
121 | "Couldn't determine route type code. Route types can be provided either ",
122 | "as a non-negative integer code, or as a character: \"Tram\", ",
123 | "\"Train\" \"Bus\", \"Vline\" or \"Night Bus\". Character inputs are ",
124 | "not case-sensitive."
125 | )
126 | }
127 |
128 | as.integer(translation)
129 | }
130 |
131 | #' Convert a numeric route type to a human-friendly description
132 | #'
133 | #' This function effectively wraps the results of \code{\link{route_types}} to
134 | #' translate a route type to a human-readable form, such as translating `0` to
135 | #' `"Train"`. This function is _not_ vectorised.
136 | #'
137 | #' @param route_type Atomic integer or character.
138 | #' @inheritParams PTVGET
139 | #'
140 | #' @return character
141 | #' @keywords Internal
142 | describe_route_type <- function(route_type,
143 | user_id = determine_user_id(),
144 | api_key = determine_api_key()) {
145 | route_type <- to_integer(route_type)
146 | route_type_vector <- cached_route_types(user_id = user_id, api_key = api_key)
147 | if (!(as.character(route_type) %in% names(route_type_vector))) {
148 | stop(glue::glue("Route type {route_type} doesn't exist"))
149 | }
150 | unname(route_type_vector[as.character(route_type)])
151 | }
152 |
--------------------------------------------------------------------------------
/R/fare-estimate.R:
--------------------------------------------------------------------------------
1 | #' Calculate a fare estimate between zones
2 | #'
3 | #' Retrieve fare information for a journey through the given zones. Also
4 | #' supports journey touch on and off times, to accommodate for discounts.
5 | #'
6 | #' @param min_zone Integer. Minimum zone travelled through.
7 | #' @param max_zone Integer. Maximum zone travelled through.
8 | #' @param journey_touch_on,journey_touch_off POSIXct or Character. Optionally
9 | #' filter results to a journey time. Values to both must be provided.
10 | #' Characters are automatically converted to datetimes, and are assumed to be
11 | #' given as Melbourne time.
12 | #' @param journey_in_free_tram_zone Boolean. Defaults to `FALSE`.
13 | #' @param travelled_route_types Integer or character vector. Optionally filter
14 | #' by a vector of route types. A route type can be provided either as a
15 | #' non-negative integer code, or as a character: "Tram", "Train", "Bus",
16 | #' "Vline" or "Night Bus". Character inputs are not case-sensitive. Use the
17 | #' \code{\link{route_types}} function to extract a vector of all route types.
18 | #' @inheritParams PTVGET
19 | #'
20 | #' @inherit parse_fare_estimate_content return
21 | #'
22 | #' @export
23 | #'
24 | #' @examples \dontrun{
25 | #' fare_estimate(min_zone = 1, max_zone = 2)
26 | #'
27 | #' fare_estimate(min_zone = 1, max_zone = 1, journey_in_free_tram_zone = TRUE)
28 | #'
29 | #' fare_estimate(
30 | #' min_zone = 1,
31 | #' max_zone = 2,
32 | #' travelled_route_types = c("Train", "Tram")
33 | #' )
34 | #'
35 | #' fare_estimate(
36 | #' min_zone = 1,
37 | #' max_zone = 2,
38 | #' journey_touch_on = "2020-06-21 07:31:00",
39 | #' journey_touch_off = "2020-06-21 08:45:00"
40 | #' )
41 | #' }
42 | #'
43 | fare_estimate <- function(min_zone,
44 | max_zone,
45 | journey_touch_on = NULL,
46 | journey_touch_off = NULL,
47 | journey_in_free_tram_zone = FALSE,
48 | travelled_route_types = NULL,
49 | user_id = determine_user_id(),
50 | api_key = determine_api_key()) {
51 | min_zone <- to_integer(min_zone)
52 | max_zone <- to_integer(max_zone)
53 |
54 | if (xor(is.null(journey_touch_on), is.null(journey_touch_off))) {
55 | stop("If providing journey touch on/off times, both must be provided")
56 | }
57 | if (!is.null(journey_touch_on)) {
58 | journey_touch_on <- to_datetime(journey_touch_on)
59 | journey_touch_off <- to_datetime(journey_touch_off)
60 | journey_touch_on_url <- format(
61 | journey_touch_on, format = "%Y-%m-%dT%H:%M:%OS", tz = "UTC"
62 | )
63 | journey_touch_off_url <- format(
64 | journey_touch_off, format = "%Y-%m-%dT%H:%M:%OS", tz = "UTC"
65 | )
66 | } else {
67 | journey_touch_on_url <- NULL
68 | journey_touch_off_url <- NULL
69 | }
70 |
71 | if (!is.null(travelled_route_types)) {
72 | travelled_route_types <- purrr::map_int(
73 | travelled_route_types,
74 | translate_route_type,
75 | user_id = user_id,
76 | api_key = api_key
77 | )
78 | }
79 |
80 | request <- add_parameters(
81 | glue::glue("fare_estimate/min_zone/{min_zone}/max_zone/{max_zone}"),
82 | journey_touch_on_utc = journey_touch_on_url,
83 | journey_touch_off_utc = journey_touch_off_url,
84 | is_journey_in_free_tram_zone = journey_in_free_tram_zone,
85 | travelled_route_types = travelled_route_types
86 | )
87 |
88 | response <- PTVGET(request, user_id = user_id, api_key = api_key)
89 | content <- response$content
90 | assert_correct_attributes(
91 | names(content),
92 | c("FareEstimateResultStatus", "FareEstimateResult")
93 | )
94 |
95 | parsed <- parse_fare_estimate_content(content$FareEstimateResult)
96 | new_ptvapi_tibble(response, parsed)
97 | }
98 |
99 | #' Parse content of fare estimates API call
100 | #'
101 | #' This function is designed to parse the content returned by the interior
102 | #' steps of the \code{\link{fare_estimate}} function.
103 | #'
104 | #' @param fare_estimate_content A direction, as a list, returned by the
105 | #' \code{\link{fare_estimate}} API call.
106 | #'
107 | #' @return A data frame consisting of one row for each `passenger_type`, and the
108 | #' following columns: \itemize{
109 | #' \item `min_zone`
110 | #' \item `max_zone`
111 | #' \item `unique_zones`
112 | #' \item `early_bird`
113 | #' \item `free_tram_zone`
114 | #' \item `weekend_journey`
115 | #' \item `passenger_type`
116 | #' \item `fare_2_hour_peak`
117 | #' \item `fare_2_hour_off_peak`
118 | #' \item `fare_daily_peak`
119 | #' \item `fare_daily_off_peak`
120 | #' \item `pass_7_days`
121 | #' \item `pass_28_to_69_day_per_day`
122 | #' \item `pass_70_plus_day_per_day`
123 | #' \item `weekend_cap`
124 | #' \item `holiday_cap`
125 | #' }
126 | #'
127 | #' @keywords internal
128 | #'
129 | parse_fare_estimate_content <- function(fare_estimate_content) {
130 | assert_correct_attributes(
131 | names(fare_estimate_content),
132 | c("IsEarlyBird", "IsJourneyInFreeTramZone", "IsThisWeekendJourney",
133 | "ZoneInfo", "PassengerFares")
134 | )
135 |
136 | base_columns <- tibble::tibble(
137 | min_zone = fare_estimate_content$ZoneInfo$MinZone,
138 | max_zone = fare_estimate_content$ZoneInfo$MaxZone,
139 | unique_zones = list(unlist(fare_estimate_content$ZoneInfo$UniqueZones)),
140 | early_bird = fare_estimate_content$IsEarlyBird,
141 | free_tram_zone = fare_estimate_content$IsJourneyInFreeTramZone,
142 | weekend_journey = fare_estimate_content$IsThisWeekendJourney
143 | )
144 | passenger_fares <- map_and_rbind(
145 | fare_estimate_content$PassengerFares,
146 | function(x) {
147 | tibble::tibble(
148 | passenger_type = x$PassengerType,
149 | fare_2_hour_peak = x$Fare2HourPeak,
150 | fare_2_hour_off_peak = x$Fare2HourOffPeak,
151 | fare_daily_peak = x$FareDailyPeak,
152 | fare_daily_off_peak = x$FareDailyOffPeak,
153 | pass_7_days = x$Pass7Days,
154 | pass_28_to_69_day_per_day = x$Pass28To69DayPerDay,
155 | pass_70_plus_day_per_day = x$Pass70PlusDayPerDay,
156 | weekend_cap = x$WeekendCap,
157 | holiday_cap = x$HolidayCap
158 | )
159 | }
160 | )
161 |
162 | # cbind converts to data.frame, but this shouldn't matter
163 | cbind(base_columns, passenger_fares)
164 | }
165 |
--------------------------------------------------------------------------------
62 |
63 |
105 |
106 |
107 |
108 |
109 |
110 |
143 |
144 |
145 |
146 |
147 |
148 |
149 |
150 |
151 |
--------------------------------------------------------------------------------
/docs/404.html:
--------------------------------------------------------------------------------
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
111 |
129 |
130 |
131 |
132 |
142 |
112 |
121 |
122 |
127 |
128 |
113 |
115 |
116 | License
114 |YEAR: 2020 117 | COPYRIGHT HOLDER: David Neuzerling 118 |119 | 120 |
62 |
63 |
105 |
106 |
107 |
108 |
109 |
110 |
141 |
142 |
143 |
144 |
145 |
146 |
147 |
148 |
149 |
--------------------------------------------------------------------------------
/R/routes.R:
--------------------------------------------------------------------------------
1 | #' Information for a given route
2 | #'
3 | #' @inheritParams directions_on_route
4 | #' @inheritParams PTVGET
5 | #' @param include_geopath Logical. Whether to populate the `geopath` column.
6 | #' Defaults to FALSE.
7 | #' @param geopath_utc Date, or character that can be converted to a date. The
8 | #' UTC date for which the geopaths are effective. Defaults to the current
9 | #' date. Has no effect if `include_geopath = FALSE`. It's uncertain how much
10 | #' historical or future-dated data is available.
11 | #'
12 | #' @inherit route_to_tibble return
13 | #'
14 | #' @export
15 | #'
16 | #' @examples \dontrun{
17 | #' route_information(6)
18 | #' route_information(6, include_geopath = TRUE)
19 | #' route_information(6, include_geopath = TRUE, geopath_utc = "2020-07-01")
20 | #' }
21 | #'
22 | route_information <- function(route_id,
23 | include_geopath = FALSE,
24 | geopath_utc = NULL,
25 | user_id = determine_user_id(),
26 | api_key = determine_api_key()) {
27 | route_id <- to_integer(route_id)
28 | if (!include_geopath && !is.null(geopath_utc)) {
29 | warning("`geopath_utc` is ignored when `include_geopath` is `TRUE`")
30 | geopath_utc <- NULL
31 | }
32 | if (!is.null(geopath_utc)) {
33 | geopath_utc <- as.Date(geopath_utc)
34 | }
35 |
36 | request <- add_parameters(
37 | glue::glue("routes/{route_id}"),
38 | include_geopath = include_geopath,
39 | geopath_utc = geopath_utc
40 | )
41 | response <- PTVGET(request, user_id = user_id, api_key = api_key)
42 | content <- response$content
43 |
44 | assert_correct_attributes(names(content), c("route", "status"))
45 | parsed <- route_to_tibble(content$route) # may be an empty tibble
46 | parsed$route_type_description <- purrr::map_chr(
47 | parsed$route_type,
48 | describe_route_type,
49 | user_id = user_id,
50 | api_key = api_key
51 | )
52 | new_ptvapi_tibble(response, parsed)
53 | }
54 |
55 | #' Information for all routes
56 | #'
57 | #' @inheritParams stops_nearby
58 | #' @param route_name Character. Optionally filter by route name. Partial matches
59 | #' are accepted, and the matches are not case sensitive.
60 | #' @inheritParams PTVGET
61 | #'
62 | #' @inherit route_to_tibble return
63 | #'
64 | #' @export
65 | #'
66 | #' @examples \dontrun{
67 | #' routes()
68 | #' routes(route_types = "Train")
69 | #' routes(route_types = 0)
70 | #' routes(route_types = c("Train", "Tram"))
71 | #' routes(route_name = "Frankston")
72 | #' routes(route_name = "Craigie")
73 | #' routes(route_name = "werribee")
74 | #' }
75 | routes <- function(route_types = NULL,
76 | route_name = NULL,
77 | user_id = determine_user_id(),
78 | api_key = determine_api_key()) {
79 | if (!is.null(route_types)) {
80 | route_types <- purrr::map_int(
81 | route_types,
82 | translate_route_type,
83 | user_id = user_id,
84 | api_key = api_key
85 | )
86 | }
87 | if (!is.null(route_name)) assertthat::assert_that(is.character(route_name))
88 |
89 | request <- add_parameters(
90 | "routes",
91 | route_types = route_types,
92 | route_name = route_name
93 | )
94 | response <- PTVGET(request, user_id = user_id, api_key = api_key)
95 | content <- response$content
96 | parsed <- map_and_rbind(content$routes, route_to_tibble)
97 | parsed$route_type_description <- purrr::map_chr(
98 | parsed$route_type,
99 | describe_route_type,
100 | user_id = user_id,
101 | api_key = api_key
102 | )
103 | new_ptvapi_tibble(response, parsed)
104 | }
105 |
106 | #' Convert a single route to a tibble
107 | #'
108 | #' This function is designed to parse the content returned by the interior steps
109 | #' of the \code{\link{routes}} function. Service status information may be `NA`,
110 | #' depending on the API call that was used to populate the information.
111 | #'
112 | #' @param route A route, as a list, returned by the \code{\link{routes}} API
113 | #' call.
114 | #'
115 | #' @return A tibble of routes, with the following columns:
116 | #' \itemize{
117 | #' \item `route_id`
118 | #' \item `route_gtfs_id`
119 | #' \item `route_name`
120 | #' \item `route_type`
121 | #' \item `route_type_description`
122 | #' \item `route_number`
123 | #' \item `geopath`
124 | #' \item `service_status`
125 | #' \item `service_status_timestamp`
126 | #' }
127 | #'
128 | #' @keywords internal
129 | #'
130 | route_to_tibble <- function(route) {
131 | if (is.null(route)) {
132 | return(
133 | tibble::tibble(
134 | route_id = integer(),
135 | route_gtfs_id = character(),
136 | route_name = character(),
137 | route_type = integer(),
138 | route_type_description = character(),
139 | route_number = character(),
140 | geopaths = list(),
141 | service_status = character(),
142 | service_status_timestamp = as.POSIXct(NA)
143 | )
144 | )
145 | }
146 | tibble::tibble(
147 | route_id = route$route_id,
148 | route_gtfs_id = route$route_gtfs_id,
149 | route_name = route$route_name,
150 | route_type = route$route_type,
151 | route_type_description = NA_character_,
152 | route_number = ifelse(
153 | # Not always a number, eg. "745a"
154 | route$route_number == "", NA_character_, route$route_number
155 | ),
156 | geopath = if (is.null(route$geopath)) {
157 | list(geopath_to_tibble(NULL))
158 | } else {
159 | list(purrr::map_dfr(route$geopath, geopath_to_tibble))
160 | },
161 | service_status = ifelse(
162 | is.null(route$route_service_status$description),
163 | NA_character_,
164 | route$route_service_status$description
165 | ),
166 | service_status_timestamp = convert_to_melbourne_time(
167 | route$route_service_status$timestamp
168 | )
169 | )
170 | }
171 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 |
2 | # ptvapi
111 |
127 |
128 |
129 |
130 |
140 |
112 |
119 |
120 |
125 |
126 |
113 |
115 |
116 | Content not found. Please use links in the navbar.
117 |
118 | Page not found (404)
114 |
3 |
4 |
5 | [](https://cran.r-project.org/package=ptvapi)
6 | [](https://cran.r-project.org/package=ptvapi)
7 | [](https://github.com/mdneuzerling/ptvapi/tree/main)
8 | [](https://github.com/mdneuzerling/ptvapi/actions)
9 | [](https://github.com/mdneuzerling/ptvapi/actions?query=workflow%3Alint)
10 | [](https://app.codecov.io/gh/mdneuzerling/ptvapi?branch=main)
11 | [](https://choosealicense.com/licenses/mit/)
12 |
13 |
14 |
15 | This package provides a friendly interface to the Public Transport Victoria (PTV) Timetable API. Results are returned as data frames --- using real-time data where available --- and authentication is handled under the hood.
16 |
17 | **This package is an unofficial wrapper of the Public Transport Victoria timetable API. The authors of this package are not associated with Public Transport Victoria.**
18 |
19 | ## Installing
20 |
21 | ### CRAN version
22 |
23 | ```
24 | install.packages("ptvapi")
25 | ```
26 |
27 | ### Development version
28 |
29 | ```
30 | remotes::install_github("mdneuzerling/ptvapi")
31 | ```
32 |
33 | ## Authentication
34 |
35 | Using the API requires a user ID (also called a `devid`) and an API key from Public Transport Victoria. These can be requested in an email. Refer to the [PTV website](https://www.ptv.vic.gov.au/footer/data-and-reporting/datasets/ptv-timetable-api/) for instructions.
36 |
37 | The user ID and API key be provided directly to the functions, for example:
38 | ```
39 | routes(
40 | user_id = 1234567,
41 | api_key = "xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx"
42 | )
43 | ```
44 |
45 | Alternatively, this information can be set as environment variables. These can be configured directly within R:
46 | ```
47 | Sys.setenv("PTV_USER_ID" = 1234567)
48 | Sys.setenv("PTV_API_KEY" = "xxxxxxxx-xxxx-xxxx-xxxx-xxxxxxxxxxxx")
49 | ```
50 |
51 | If a `user_id` or `api_key` value is not provided to the functions within this package, then they will be retrieved from the "PTV_USER_ID" and "PTV_API_KEY" environment variables, if possible.
52 |
53 | ## Example usage
54 |
55 | The code examples below assume that you've set environment variables for authentication.
56 |
57 | ```r
58 | # tibble of all routes
59 | routes()
60 | # A tibble: 828 x 7
61 | # route_id route_gtfs_id route_name route_type route_number service_status
62 | # -
103 | ```
104 |
105 | ## A note about route types
106 |
107 | The API recognises five route types: "Train", "Tram", "Bus", "Vline", and "Night Bus". Many functions have arguments such as `route_type` and `route_types` that expect a non-negative integer code representing these route types. To simplify calling the API, these functions will also accept a character description like those above. Under the hood, the functions will translate these descriptions to the non-negative integer codes that the API expects. For example, `routes(route_type = "Train")` is automatically translated to `routes(route_type = 0)`.
108 |
109 | ## Available functions
110 |
111 | All API calls have been implemented. Some API calls have been combined into a single function with arguments, and some have been split into multiple functions. The following functions are available through this package:
112 |
113 | * `departures`
114 | * `directions`
115 | * `directions_on_route`
116 | * `disruption_information`
117 | * `disruption_modes`
118 | * `disruptions`
119 | * `disruptions_at_stop`
120 | * `disruptions_on_route`
121 | * `fare_estimate`
122 | * `outlets`
123 | * `outlets_nearby`
124 | * `patterns`
125 | * `route_information`
126 | * `route_types`
127 | * `routes`
128 | * `run_information`
129 | * `runs_on_route`
130 | * `search_outlets`
131 | * `search_routes`
132 | * `search_stops`
133 | * `stop_information`
134 | * `stops_nearby`
135 | * `stops_on_route`
136 |
137 | ---
138 |
139 | Hex logo by Phizz Leeder
140 |
--------------------------------------------------------------------------------
/R/route-types.R:
--------------------------------------------------------------------------------
1 | #' Retrieve a translation from route type number to name
2 | #'
3 | #' Route types (tram, train, etc.) are provided to the PTV API as an integer
4 | #' code. This function retrieves a named vector in which the values are the
5 | #' route type descriptions, and the names of the vector are the route type
6 | #' numbers. Note that "Night Bus" is a separate route type.
7 | #'
8 | #' @inheritParams PTVGET
9 | #'
10 | #' @return A named integer vector in which the values are the route type
11 | #' descriptions, and the names of the vector are the route type numbers.
12 | #'
13 | #' @export
14 | #'
15 | #' @examples \dontrun{
16 | #' route_types()
17 | #' }
18 | #'
19 | route_types <- function(user_id = determine_user_id(),
20 | api_key = determine_api_key()) {
21 | response <- PTVGET(
22 | request = "route_types",
23 | user_id = user_id,
24 | api_key = api_key
25 | )
26 | content_route_types <- response$content$route_types
27 |
28 | route_type_names <- purrr::map_chr(
29 | content_route_types,
30 | function(x) x$route_type_name
31 | )
32 | route_type_numbers <- purrr::map_int(
33 | content_route_types,
34 | function(x) x$route_type
35 | )
36 | names(route_type_names) <- route_type_numbers
37 | route_type_names
38 | }
39 |
40 | #' Retrieve route types, using cached values if possible
41 | #'
42 | #' @inheritParams PTVGET
43 | #'
44 | #' @description
45 | #' Route types will change extraordinarily rarely --- this would require PTV to
46 | #' add a new route type akin to "train" or "bus". To avoid querying the API too
47 | #' much, we prefer to use cached values for route type translation wherever
48 | #' possible. This function effectively wraps `route_types`, returning cached
49 | #' results if possible or caching results otherwise. Note that if a user
50 | #' specifically calls `route_types` then we do _not_ return cached results.
51 | #'
52 | #' We use the `pkg_env` as a cache, which is an environment created on package
53 | #' load. This is not truly private --- users could still access this as an
54 | #' internal value. But it's effectively "out of the way".
55 | #'
56 | #' @inherit route_types return
57 | #'
58 | #' @keywords internal
59 | cached_route_types <- function(user_id = determine_user_id(),
60 | api_key = determine_api_key()) {
61 | if (is.null(pkg_env$route_types)) {
62 | pkg_env$route_types <- route_types(user_id = user_id, api_key = api_key)
63 | }
64 | pkg_env$route_types
65 | }
66 |
67 | #' Translate a route type input into a numerical route type
68 | #'
69 | #' Many API calls require a route type (eg. "Tram" or "Train"). These must be
70 | #' provided as integers, which are translated to route type descriptions with
71 | #' the `route_types() function/API call. This function will: \itemize{
72 | #' \item Translate a case-insensitive description such as "Tram" or "Train" to
73 | #' the corresponding route type code
74 | #' \item Check a given integer to see if it is a valid route type code,
75 | #' returning it if so and erroring otherwise
76 | #' \item Return NULL on NULL input
77 | #' }
78 | #' This function is _not_ vectorised.
79 | #'
80 | #' @inheritParams PTVGET
81 | #' @param route_type A route type which can be provided either as a non-negative
82 | #' integer code, or as a character: "Tram", "Train", "Bus", "Vline" or "Night
83 | #' Bus". Character inputs are not case-sensitive. Use the
84 | #' \code{\link{route_types}} function to extract a vector of all route types.
85 | #'
86 | #' @return An integer route type code, or NULL if the input is NULL
87 | #'
88 | #' @keywords internal
89 | #'
90 | translate_route_type <- function(route_type,
91 | user_id = determine_user_id(),
92 | api_key = determine_api_key()) {
93 |
94 | route_type_vector <- cached_route_types(user_id = user_id, api_key = api_key)
95 |
96 | if (is.numeric(route_type)) {
97 | if (as.character(route_type) %in% names(route_type_vector)) {
98 | translation <- route_type
99 | } else {
100 | stop(
101 | route_type,
102 | " is not a valid route type code. Valid codes are ",
103 | paste(names(route_type_vector), collapse = ", ")
104 | )
105 | }
106 | } else if (is.character(route_type)) {
107 | if (toupper(route_type) %in% toupper(route_type_vector)) {
108 | translation <- names(
109 | route_type_vector[
110 | which(toupper(route_type_vector) == toupper(route_type))]
111 | )
112 | } else {
113 | stop(
114 | route_type,
115 | " is not a valid route type description. Valid descriptions are ",
116 | paste(route_type_vector, collapse = ", ")
117 | )
118 | }
119 | } else {
120 | stop(
121 | "Couldn't determine route type code. Route types can be provided either ",
122 | "as a non-negative integer code, or as a character: \"Tram\", ",
123 | "\"Train\" \"Bus\", \"Vline\" or \"Night Bus\". Character inputs are ",
124 | "not case-sensitive."
125 | )
126 | }
127 |
128 | as.integer(translation)
129 | }
130 |
131 | #' Convert a numeric route type to a human-friendly description
132 | #'
133 | #' This function effectively wraps the results of \code{\link{route_types}} to
134 | #' translate a route type to a human-readable form, such as translating `0` to
135 | #' `"Train"`. This function is _not_ vectorised.
136 | #'
137 | #' @param route_type Atomic integer or character.
138 | #' @inheritParams PTVGET
139 | #'
140 | #' @return character
141 | #' @keywords Internal
142 | describe_route_type <- function(route_type,
143 | user_id = determine_user_id(),
144 | api_key = determine_api_key()) {
145 | route_type <- to_integer(route_type)
146 | route_type_vector <- cached_route_types(user_id = user_id, api_key = api_key)
147 | if (!(as.character(route_type) %in% names(route_type_vector))) {
148 | stop(glue::glue("Route type {route_type} doesn't exist"))
149 | }
150 | unname(route_type_vector[as.character(route_type)])
151 | }
152 |
--------------------------------------------------------------------------------
/R/fare-estimate.R:
--------------------------------------------------------------------------------
1 | #' Calculate a fare estimate between zones
2 | #'
3 | #' Retrieve fare information for a journey through the given zones. Also
4 | #' supports journey touch on and off times, to accommodate for discounts.
5 | #'
6 | #' @param min_zone Integer. Minimum zone travelled through.
7 | #' @param max_zone Integer. Maximum zone travelled through.
8 | #' @param journey_touch_on,journey_touch_off POSIXct or Character. Optionally
9 | #' filter results to a journey time. Values to both must be provided.
10 | #' Characters are automatically converted to datetimes, and are assumed to be
11 | #' given as Melbourne time.
12 | #' @param journey_in_free_tram_zone Boolean. Defaults to `FALSE`.
13 | #' @param travelled_route_types Integer or character vector. Optionally filter
14 | #' by a vector of route types. A route type can be provided either as a
15 | #' non-negative integer code, or as a character: "Tram", "Train", "Bus",
16 | #' "Vline" or "Night Bus". Character inputs are not case-sensitive. Use the
17 | #' \code{\link{route_types}} function to extract a vector of all route types.
18 | #' @inheritParams PTVGET
19 | #'
20 | #' @inherit parse_fare_estimate_content return
21 | #'
22 | #' @export
23 | #'
24 | #' @examples \dontrun{
25 | #' fare_estimate(min_zone = 1, max_zone = 2)
26 | #'
27 | #' fare_estimate(min_zone = 1, max_zone = 1, journey_in_free_tram_zone = TRUE)
28 | #'
29 | #' fare_estimate(
30 | #' min_zone = 1,
31 | #' max_zone = 2,
32 | #' travelled_route_types = c("Train", "Tram")
33 | #' )
34 | #'
35 | #' fare_estimate(
36 | #' min_zone = 1,
37 | #' max_zone = 2,
38 | #' journey_touch_on = "2020-06-21 07:31:00",
39 | #' journey_touch_off = "2020-06-21 08:45:00"
40 | #' )
41 | #' }
42 | #'
43 | fare_estimate <- function(min_zone,
44 | max_zone,
45 | journey_touch_on = NULL,
46 | journey_touch_off = NULL,
47 | journey_in_free_tram_zone = FALSE,
48 | travelled_route_types = NULL,
49 | user_id = determine_user_id(),
50 | api_key = determine_api_key()) {
51 | min_zone <- to_integer(min_zone)
52 | max_zone <- to_integer(max_zone)
53 |
54 | if (xor(is.null(journey_touch_on), is.null(journey_touch_off))) {
55 | stop("If providing journey touch on/off times, both must be provided")
56 | }
57 | if (!is.null(journey_touch_on)) {
58 | journey_touch_on <- to_datetime(journey_touch_on)
59 | journey_touch_off <- to_datetime(journey_touch_off)
60 | journey_touch_on_url <- format(
61 | journey_touch_on, format = "%Y-%m-%dT%H:%M:%OS", tz = "UTC"
62 | )
63 | journey_touch_off_url <- format(
64 | journey_touch_off, format = "%Y-%m-%dT%H:%M:%OS", tz = "UTC"
65 | )
66 | } else {
67 | journey_touch_on_url <- NULL
68 | journey_touch_off_url <- NULL
69 | }
70 |
71 | if (!is.null(travelled_route_types)) {
72 | travelled_route_types <- purrr::map_int(
73 | travelled_route_types,
74 | translate_route_type,
75 | user_id = user_id,
76 | api_key = api_key
77 | )
78 | }
79 |
80 | request <- add_parameters(
81 | glue::glue("fare_estimate/min_zone/{min_zone}/max_zone/{max_zone}"),
82 | journey_touch_on_utc = journey_touch_on_url,
83 | journey_touch_off_utc = journey_touch_off_url,
84 | is_journey_in_free_tram_zone = journey_in_free_tram_zone,
85 | travelled_route_types = travelled_route_types
86 | )
87 |
88 | response <- PTVGET(request, user_id = user_id, api_key = api_key)
89 | content <- response$content
90 | assert_correct_attributes(
91 | names(content),
92 | c("FareEstimateResultStatus", "FareEstimateResult")
93 | )
94 |
95 | parsed <- parse_fare_estimate_content(content$FareEstimateResult)
96 | new_ptvapi_tibble(response, parsed)
97 | }
98 |
99 | #' Parse content of fare estimates API call
100 | #'
101 | #' This function is designed to parse the content returned by the interior
102 | #' steps of the \code{\link{fare_estimate}} function.
103 | #'
104 | #' @param fare_estimate_content A direction, as a list, returned by the
105 | #' \code{\link{fare_estimate}} API call.
106 | #'
107 | #' @return A data frame consisting of one row for each `passenger_type`, and the
108 | #' following columns: \itemize{
109 | #' \item `min_zone`
110 | #' \item `max_zone`
111 | #' \item `unique_zones`
112 | #' \item `early_bird`
113 | #' \item `free_tram_zone`
114 | #' \item `weekend_journey`
115 | #' \item `passenger_type`
116 | #' \item `fare_2_hour_peak`
117 | #' \item `fare_2_hour_off_peak`
118 | #' \item `fare_daily_peak`
119 | #' \item `fare_daily_off_peak`
120 | #' \item `pass_7_days`
121 | #' \item `pass_28_to_69_day_per_day`
122 | #' \item `pass_70_plus_day_per_day`
123 | #' \item `weekend_cap`
124 | #' \item `holiday_cap`
125 | #' }
126 | #'
127 | #' @keywords internal
128 | #'
129 | parse_fare_estimate_content <- function(fare_estimate_content) {
130 | assert_correct_attributes(
131 | names(fare_estimate_content),
132 | c("IsEarlyBird", "IsJourneyInFreeTramZone", "IsThisWeekendJourney",
133 | "ZoneInfo", "PassengerFares")
134 | )
135 |
136 | base_columns <- tibble::tibble(
137 | min_zone = fare_estimate_content$ZoneInfo$MinZone,
138 | max_zone = fare_estimate_content$ZoneInfo$MaxZone,
139 | unique_zones = list(unlist(fare_estimate_content$ZoneInfo$UniqueZones)),
140 | early_bird = fare_estimate_content$IsEarlyBird,
141 | free_tram_zone = fare_estimate_content$IsJourneyInFreeTramZone,
142 | weekend_journey = fare_estimate_content$IsThisWeekendJourney
143 | )
144 | passenger_fares <- map_and_rbind(
145 | fare_estimate_content$PassengerFares,
146 | function(x) {
147 | tibble::tibble(
148 | passenger_type = x$PassengerType,
149 | fare_2_hour_peak = x$Fare2HourPeak,
150 | fare_2_hour_off_peak = x$Fare2HourOffPeak,
151 | fare_daily_peak = x$FareDailyPeak,
152 | fare_daily_off_peak = x$FareDailyOffPeak,
153 | pass_7_days = x$Pass7Days,
154 | pass_28_to_69_day_per_day = x$Pass28To69DayPerDay,
155 | pass_70_plus_day_per_day = x$Pass70PlusDayPerDay,
156 | weekend_cap = x$WeekendCap,
157 | holiday_cap = x$HolidayCap
158 | )
159 | }
160 | )
161 |
162 | # cbind converts to data.frame, but this shouldn't matter
163 | cbind(base_columns, passenger_fares)
164 | }
165 |
--------------------------------------------------------------------------------