Closed AlexandraKapp closed 3 years ago
Thanks for that - it was missing because i initially didn't think those values could be inserted for mid_points
the way they were for end_points
, but actually they can, and so now are:
library (gtfsrouter)
gtfs <- extract_gtfs("vbb.zip")
#> ▶ Unzipping GTFS archive
#> ✔ Unzipped GTFS archive
#> ▶ Extracting GTFS feed✔ Extracted GTFS feed
#> ▶ Converting stop times to seconds✔ Converted stop times to seconds
#> ▶ Converting transfer times to seconds✔ Converted transfer times to seconds
gtfs <- gtfs_timetable (gtfs, day = "Monday")
from <- "Berlin, Amalienstr"
start_time <- 11 * 3600
end_time <- start_time + 10 * 60
r <- gtfs_isochrone (gtfs, from = from, start_time = start_time, end_time = end_time)
#> Loading required namespace: geodist
#> Loading required namespace: lwgeom
#> Registered S3 method overwritten by 'spatstat':
#> method from
#> print.boxx cli
#> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.2
r$mid_points
#> Simple feature collection with 40 features and 6 fields
#> geometry type: POINT
#> dimension: XY
#> bbox: xmin: 13.30608 ymin: 52.41771 xmax: 13.34632 ymax: 52.44144
#> geographic CRS: WGS 84
#> First 10 features:
#> stop_name stop_id departure arrival
#> 1 S Lichterfelde Ost Bhf (Berlin) 070101003452 11:06:00 11:08:00
#> 2 Berlin, Jungfernstieg 070101000136 11:06:00 11:10:00
#> 3 Berlin, Marienstr. 070101000886 11:06:00 11:11:00
#> 4 Berlin, Ostpreußendamm/Königsberger Str. 070101000395 11:06:00 11:12:00
#> 5 Berlin, Goerzallee/Drakestr. 070101000396 11:06:00 11:14:00
#> 6 S Lichterfelde Ost Bhf (Berlin) 070101003452 11:06:00 11:08:00
#> 7 Berlin, Jungfernstieg 070101003453 11:06:00 11:09:00
#> 8 Berlin, Hochbergweg 070101000925 11:06:00 11:10:00
#> 9 Berlin, Bogenstr. 070101003454 11:06:00 11:11:00
#> 10 Berlin, Giesensdorfer Str. 070101003455 11:06:00 11:12:00
#> duration transfers geometry
#> 1 00:02:00 0 POINT (13.32808 52.4291)
#> 2 00:04:00 1 POINT (13.32505 52.42804)
#> 3 00:05:00 1 POINT (13.32211 52.42927)
#> 4 00:06:00 1 POINT (13.3175 52.43078)
#> 5 00:08:00 1 POINT (13.30968 52.43137)
#> 6 00:02:00 0 POINT (13.32808 52.4291)
#> 7 00:03:00 0 POINT (13.32505 52.42804)
#> 8 00:04:00 0 POINT (13.3199 52.4266)
#> 9 00:05:00 0 POINT (13.31658 52.42564)
#> 10 00:06:00 0 POINT (13.31434 52.42398)
r$end_points
#> Simple feature collection with 9 features and 6 fields
#> geometry type: POINT
#> dimension: XY
#> bbox: xmin: 13.30214 ymin: 52.41436 xmax: 13.35007 ymax: 52.44425
#> geographic CRS: WGS 84
#> stop_name stop_id departure arrival duration
#> 1 Berlin, Karwendelstr. 070101000397 11:06:00 11:15:00 00:09:00
#> 2 Berlin, Ostpreußendamm Süd 070101001322 11:06:00 11:15:00 00:09:00
#> 3 S Osdorfer Str. (Berlin) 070101002577 11:06:00 11:15:00 00:09:00
#> 4 S Osdorfer Str. (Berlin) 060064256621 11:06:00 11:15:42 00:09:42
#> 5 Berlin, Grabenstr. 070101000388 11:06:00 11:15:00 00:09:00
#> 6 Berlin, Stanzer Zeile 070101003072 11:06:00 11:15:00 00:09:00
#> 7 Berlin, Eiswaldtstr. 070101000881 11:04:00 11:13:00 00:09:00
#> 8 Berlin, Leonorenstr./Siemensstr. 070101004143 11:04:00 11:12:00 00:08:00
#> 9 Berlin, Paul-Schneider-Str. 070101000705 11:04:00 11:13:00 00:09:00
#> transfers geometry
#> 1 1 POINT (13.30679 52.43304)
#> 2 0 POINT (13.30213 52.41436)
#> 3 1 POINT (13.31386 52.41837)
#> 4 1 POINT (13.31386 52.41837)
#> 5 1 POINT (13.32649 52.42126)
#> 6 1 POINT (13.33818 52.41664)
#> 7 1 POINT (13.34704 52.42858)
#> 8 0 POINT (13.33899 52.44425)
#> 9 1 POINT (13.35007 52.43425)
identical (names (r$mid_points), names (r$end_points))
#> [1] TRUE
Created on 2020-10-27 by the reprex package (v0.3.0)
with some requestst this works fine, with some I get an error
e.g. gtfs_isochrone(ttable, "Berlin Hauptbahnhof", start_time = 8 * 3600, end_time = 8*3600 + 30*60)
as the transfers = do.call(c, transfers)
(isochrone.R#246) seems to return less values than the other columns
I can't reproduce that, although I suspect that situation could well arise. Could you please paste a reprex
, and include both:
file.info("vbb.zip")$mtime # or whatever your GTFS zip file is called
packageVersion("gtfsrouter")
And for the error you can just call
x <- tryCatch (gtfs_isochrone (...),
error = function (e) e)
print (x)
Thanks!
I just downloaded the most recent VBB feed: https://www.vbb.de/unsere-themen/vbbdigital/api-entwicklerinfos/datensaetze
file.info("vbb_202010.zip")$mtime
#> [1] "2020-10-27 13:14:52 CET"
packageVersion("gtfsrouter")
#> [1] '0.0.4.27'
gtfs <- gtfsrouter::extract_gtfs("vbb_202010.zip")
#> > Unzipping GTFS archivev Unzipped GTFS archive
#> > Extracting GTFS feedv Extracted GTFS feed
#> > Converting stop times to secondsv Converted stop times to seconds
#> > Converting transfer times to secondsv Converted transfer times to seconds
timetable <- gtfsrouter::gtfs_timetable(gtfs, day = "tuesday")
x <- tryCatch (gtfsrouter::gtfs_isochrone(timetable, "Berlin Hauptbahnhof", start_time = 8 * 3600, end_time = 8*3600 + 10*60),
error = function (e) e)
#> Loading required namespace: geodist
#> Loading required namespace: lwgeom
#> Warning in `-.default`(arrival, departure): longer object length is not a
#> multiple of shorter object length
print (x)
#> <simpleError in (function (..., row.names = NULL, check.rows = FALSE, check.names = TRUE, fix.empty.names = TRUE, stringsAsFactors = default.stringsAsFactors()) { data.row.names <- if (check.rows && is.null(row.names)) function(current, new, i) { if (is.character(current)) new <- as.character(new) if (is.character(new)) current <- as.character(current) if (anyDuplicated(new)) return(current) if (is.null(current)) return(new) if (all(current == new) || all(current == "")) return(new) stop(gettextf("mismatch of row names in arguments of 'data.frame', item %d", i), domain = NA) } else function(current, new, i) { if (is.null(current)) { if (anyDuplicated(new)) { warning(gettextf("some row.names duplicated: %s --> row.names NOT used", paste(which(duplicated(new)), collapse = ",")), domain = NA) current } else new } else current } object <- as.list(substitute(list(...)))[-1L] mirn <- missing(row.names) mrn <- is.null(row.names) x <- list(...) n <- length(x) if (n < 1L) { if (!mrn) { if (is.object(row.names) || !is.integer(row.names)) row.names <- as.character(row.names) if (anyNA(row.names)) stop("row names contain missing values") if (anyDuplicated(row.names)) stop(gettextf("duplicate row.names: %s", paste(unique(row.names[duplicated(row.names)]), collapse = ", ")), domain = NA) } else row.names <- integer() return(structure(list(), names = character(), row.names = row.names, class = "data.frame")) } vnames <- names(x) if (length(vnames) != n) vnames <- character(n) no.vn <- !nzchar(vnames) vlist <- vnames <- as.list(vnames) nrows <- ncols <- integer(n) for (i in seq_len(n)) { xi <- if (is.character(x[[i]]) || is.list(x[[i]])) as.data.frame(x[[i]], optional = TRUE, stringsAsFactors = stringsAsFactors) else as.data.frame(x[[i]], optional = TRUE) nrows[i] <- .row_names_info(xi) ncols[i] <- length(xi) namesi <- names(xi) if (ncols[i] > 1L) { if (length(namesi) == 0L) namesi <- seq_len(ncols[i]) vnames[[i]] <- if (no.vn[i]) namesi else paste(vnames[[i]], namesi, sep = ".") } else if (length(namesi)) { vnames[[i]] <- namesi } else if (fix.empty.names && no.vn[[i]]) { tmpname <- deparse(object[[i]], nlines = 1L)[1L] if (startsWith(tmpname, "I(") && endsWith(tmpname, ")")) { ntmpn <- nchar(tmpname, "c") tmpname <- substr(tmpname, 3L, ntmpn - 1L) } vnames[[i]] <- tmpname } if (mirn && nrows[i] > 0L) { rowsi <- attr(xi, "row.names") if (any(nzchar(rowsi))) row.names <- data.row.names(row.names, rowsi, i) } nrows[i] <- abs(nrows[i]) vlist[[i]] <- xi } nr <- max(nrows) for (i in seq_len(n)[nrows < nr]) { xi <- vlist[[i]] if (nrows[i] > 0L && (nr%%nrows[i] == 0L)) { xi <- unclass(xi) fixed <- TRUE for (j in seq_along(xi)) { xi1 <- xi[[j]] if (is.vector(xi1) || is.factor(xi1)) xi[[j]] <- rep(xi1, length.out = nr) else if (is.character(xi1) && inherits(xi1, "AsIs")) xi[[j]] <- structure(rep(xi1, length.out = nr), class = class(xi1)) else if (inherits(xi1, "Date") || inherits(xi1, "POSIXct")) xi[[j]] <- rep(xi1, length.out = nr) else { fixed <- FALSE break } } if (fixed) { vlist[[i]] <- xi next } } stop(gettextf("arguments imply differing number of rows: %s", paste(unique(nrows), collapse = ", ")), domain = NA) } value <- unlist(vlist, recursive = FALSE, use.names = FALSE) vnames <- as.character(unlist(vnames[ncols > 0L])) if (fix.empty.names && any(noname <- !nzchar(vnames))) vnames[noname] <- paste0("Var.", seq_along(vnames))[noname] if (check.names) { if (fix.empty.names) vnames <- make.names(vnames, unique = TRUE) else { nz <- nzchar(vnames) vnames[nz] <- make.names(vnames[nz], unique = TRUE) } } names(value) <- vnames if (!mrn) { if (length(row.names) == 1L && nr != 1L) { if (is.character(row.names)) row.names <- match(row.names, vnames, 0L) if (length(row.names) != 1L || row.names < 1L || row.names > length(vnames)) stop("'row.names' should specify one of the variables") i <- row.names row.names <- value[[i]] value <- value[-i] } else if (!is.null(row.names) && length(row.names) != nr) stop("row names supplied are of the wrong length") } else if (!is.null(row.names) && length(row.names) != nr) { warning("row names were found from a short variable and have been discarded") row.names <- NULL } class(value) <- "data.frame" if (is.null(row.names)) attr(value, "row.names") <- .set_row_names(nr) else { if (is.object(row.names) || !is.integer(row.names)) row.names <- as.character(row.names) if (anyNA(row.names)) stop("row names contain missing values") if (anyDuplicated(row.names)) stop(gettextf("duplicate row.names: %s", paste(unique(row.names[duplicated(row.names)]), collapse = ", ")), domain = NA) row.names(value) <- row.names } value})(stop_name = c("S+U Jungfernheide Bhf (Berlin)", "S+U Berlin Hauptbahnhof (tief)", "Berlin, Döberitzer Str.", "Berlin, Heidestr.", "Berlin, Friedrich-Krause-Ufer", "Berlin, Fennbrücke", "Berlin, Kiautschoustr.", "S+U Friedrichstr. Bhf (Berlin)", "S Hackescher Markt (Berlin)", "S Hackescher Markt (Berlin)", "S+U Potsdamer Platz Bhf (Berlin)", "Berlin, Lesser-Ury-Weg", "Berlin, Invalidenpark", "U Naturkundemuseum (Berlin) [Invalidenstr.]", "Berlin, Invalidenpark", "Berlin, Charité - Campus Mitte", "Berlin, Schumannstr.", "S+U Friedrichstr. Bhf (Berlin)", "S Hackescher Markt (Berlin)", "S+U Alexanderplatz Bhf (Berlin)", "S+U Friedrichstr. Bhf (Berlin)", "S+U Friedrichstr. Bhf (Berlin)", "Berlin, Lehrter Str./Invalidenstr.", "Berlin, Seydlitzstr.", "Berlin, Invalidenpark", "U Naturkundemuseum (Berlin) [Chausseestr.]", "Berlin, Torstr./U Oranienburger Tor", "S Oranienburger Str. (Berlin)", "S+U Potsdamer Platz Bhf (Berlin)", "S+U Potsdamer Platz Bhf (Berlin)", "S Anhalter Bahnhof (Berlin)", "S+U Friedrichstr. Bhf (Berlin)", "S+U Friedrichstr. Bhf (Berlin)", "Berlin, Invalidenpark", "Berlin, Invalidenpark", "S Potsdamer Platz Bhf/Voßstr. (Berlin)", "S+U Potsdamer Platz (Bln) [Bus Stresemannstr.]", "Berlin, Abgeordnetenhaus", "Berlin, Lesser-Ury-Weg", "Berlin, Lesser-Ury-Weg", "S+U Friedrichstr. Bhf (Berlin)", "S+U Friedrichstr. Bhf (Berlin)", "S Bellevue (Berlin)", "S Tiergarten (Berlin)", "S+U Zoologischer Garten Bhf (Berlin)", "S+U Friedrichstr. Bhf (Berlin)", "S+U Friedrichstr. Bhf (Berlin)"), stop_id = c("000008011167", "000008098160", "070101002782", "070101001202", "070101002783", "070101002784", "070101004177", "060100001755", "060100002733", "070301008805", "710009100020", "070301008857", "070301008861", "070301008862", "070101005476", "070101005433", "070101006029", "060100001755", "060100002733", "060100003723", "060100001755", "060100000431", "070101000733", "070101000928", "070301008861", "070301008882", "070301009372", "070301009403", "710009100020", "060100020451", "060012101472", "060100001755", "070201063602", "070301008861", "070101005682", "070101006326", "070101006813", "070101003636", "070301008857", "070101002460", "060100001755", "060100000432", "060003102224", "060003103234", "060023201256", "060100001755", "070301009374"), departure = structure(c(29040, 29040, 29040, 29040, 29040, 28872, 28872, 28872, 29172, 28860, 28800, 28800, 28860, 28860, 28860, 28872, 28872, 28872, 28872, 28872, 28980, 28980, 28800, 28800, 28800, 28800, 29172, 29172, 29172, 28872, 28872, 28800, 28800, 28830, 28830, 28830, 28860, 28860, 28872, 28872, 28812, 28812, 28812, 28872, 28872), units = "secs", class = c("hms", "difftime")), arrival = structure(c(30000, 29700, 29160, 29220, 29280, 29340, 29520, 28986, 29124, 29124, 29316, 28980, 28920, 29160, 28980, 29100, 29160, 28986, 29124, 29226, 28986, 28986, 29100, 29160, 28920, 29040, 29100, 29220, 29316, 29316, 29490, 28986, 28986, 28920, 28920, 29160, 29220, 29280, 28980, 28980, 28986, 28986, 28938, 29064, 29178, 28986, 28986), units = "secs", class = c("hms", "difftime")), duration = structure(c(960, 660, 120, 180, 240, 468, 648, 114, -48, 264, 516, 180, 60, 300, 120, 228, 288, 114, 252, 354, 6, 6, 300, 360, 120, 240, -72, 48, 144, 444, 618, 186, 186, 90, 90, 330, 360, 420, 108, 108, 174, 174, 126, 192, 306, -54, -54), units = "secs", class = c("hms", "difftime")), transfers = c(1, 1, 1, 1, 1, 0, 0, 1, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 1, 1, 1, 0, 0, 0, 1, 1, 1, 1, 0, 0, 0, 0, 1), check.names = FALSE, fix.empty.names = TRUE, stringsAsFactors = FALSE): arguments imply differing number of rows: 47, 45>
Created on 2020-10-27 by the reprex package (v0.3.0)
Yep, that's a :bug: -- Incoming commit will fix.
sorry, found the same issue with different parameters again 😬
library(sf)
#> Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1
library(gtfsrouter)
file.info("vbb_202010.zip")$mtime
#> [1] "2020-10-27 13:14:52 CET"
packageVersion("gtfsrouter")
#> [1] '0.0.4.28'
gtfs <- gtfsrouter::extract_gtfs("vbb_202010.zip")
#> > Unzipping GTFS archive
#> v Unzipped GTFS archive
#> > Extracting GTFS feedv Extracted GTFS feed
#> > Converting stop times to secondsv Converted stop times to seconds
#> > Converting transfer times to secondsv Converted transfer times to seconds
timetable <- gtfsrouter::gtfs_timetable(gtfs, day = "tuesday")
# now works fine
iso <- gtfs_isochrone(timetable, "Berlin Hauptbahnhof", start_time = 8 * 3600, end_time = 8*3600 + 10*60)
#> Loading required namespace: geodist
#> Loading required namespace: lwgeom
# with 2h duration still the same bug
gtfs_isochrone(timetable, "Berlin Hauptbahnhof", start_time = 8 * 3600, end_time = 10*3600)
#> Error in (function (..., row.names = NULL, check.rows = FALSE, check.names = TRUE, : arguments imply differing number of rows: 25846, 25844
Created on 2020-10-27 by the reprex package (v0.3.0)
Yep, can confirm that, although it is definitely not the same issue. This was something I suspected would happen, and has a different cause to the previous one. Shall re-open and fix with subsequent commit. Thanks!
In this case, the cause was that some transfer stations were being erroneously kept in the isochrone records, leading to more stations than there were arrival times or trip_id
values. They've now been removed (which may also mean that you may see less mid_point
entries on some large queries that previously, but only very infrequently).