diff --git a/DESCRIPTION b/DESCRIPTION index 060ad51..610add6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: speedRT Title: Visualize speed from GTFS-RT data -Version: 0.1.1 +Version: 0.1.1-9000 Authors@R: c(person(given = "Joey", family = "Reid", diff --git a/NEWS.md b/NEWS.md index 7c4547f..4faf790 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,6 @@ +# speedRT 0.1.1-9000 +* Add travel time histogram to summary tab + # speedRT 0.1.1 * Added a `NEWS.md` file to track changes to the package. diff --git a/inst/SpeedApp/helpers.R b/inst/SpeedApp/helpers.R index b4c5127..9470d80 100644 --- a/inst/SpeedApp/helpers.R +++ b/inst/SpeedApp/helpers.R @@ -29,6 +29,18 @@ plotSpeedHistogram <- function(avl, compare) { p + labs(x = "Estimated Speed (m/s)", y = "Count") + theme_bw() } +plotTTHistogram <- function(avl, compare) { + if (compare == 'None') compare <- NULL + tt = avl[is.finite(timestamp), .(tt = diff(range(timestamp))/60), keyby = c('start_date', 'trip_id', 'shape_id', 'trip_desc', compare)] + p = ggplot(data = tt, aes(x = tt)) + p = if (is.null(compare)) { + p + stat_density(color = 'white', position = 'identity', alpha = 0.3) + } else { + p + stat_density(aes(fill = eval(as.name(compare))), color = 'white', position = 'identity', alpha = 0.3) + scale_fill_manual('', values = color_scales[[compare]]) + } + p + labs(x = "Travel time (minutes)", y = "Count") + theme_bw() + facet_grid(rows = vars(shape_id)) +} + ## Plot speed lines #### interpolateLatLon <- function(d, id, shapes, crs) { # generate spatial line from shape diff --git a/inst/SpeedApp/server.R b/inst/SpeedApp/server.R index d2e9e3e..724ddea 100644 --- a/inst/SpeedApp/server.R +++ b/inst/SpeedApp/server.R @@ -247,6 +247,16 @@ shinyServer(function(input, output, session) { avl <- avl[between(Time, input$time[1] * 3600, input$time[2] * 3600) & between(start_date, dr[1], dr[2])][as.data.table(rt_dir), on = c('route_short_name', 'direction_id')] plotSpeedHistogram(avl, input$compare) }) + + ## Travel time histogram + output$summary_tt <- renderPlot({ + req(avl <- matched(), input$rt_dir) + # filter on inputs: date range, day type, time range + dr <- as.integer(strftime(input$dr, '%Y%m%d')) + rt_dir <- tstrsplit(input$rt_dir, ' - ', fixed = TRUE, type.convert = TRUE, names = c('route_short_name', 'direction_id')) + avl <- avl[between(Time, input$time[1] * 3600, input$time[2] * 3600) & between(start_date, dr[1], dr[2])][as.data.table(rt_dir), on = c('route_short_name', 'direction_id')] + plotTTHistogram(avl, input$compare) + }) ## Map speeds #### # initialize map diff --git a/inst/SpeedApp/ui.R b/inst/SpeedApp/ui.R index a3c1dc5..1545973 100644 --- a/inst/SpeedApp/ui.R +++ b/inst/SpeedApp/ui.R @@ -148,13 +148,19 @@ fluidPage( ## summary tab #### tabItem( 'tab_summary', + fluidRow( + box( + width = 6, solidHeader = TRUE, status = "primary", title = "Speed Histogram", + plotOutput('summary_speed') + ), + box( + width = 6, solidHeader = TRUE, status = "primary", title = "Travel Time", + plotOutput('summary_tt') + ) + ), box( width = 6, solidHeader = TRUE, status = "primary", title = "Polling Rate", plotOutput('summary_polling_hist', height = '200px') - ), - box( - width = 6, solidHeader = TRUE, status = "primary", title = "Speed Histogram", - plotOutput('summary_speed') ) ), ## speed map tab ####