diff --git a/DESCRIPTION b/DESCRIPTION index 71b0923..9adf92d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,13 +1,13 @@ -Package: pm3 -Title: FHWA PM3 Score Calculation Functions -Version: 1.1.0 +Package: tpm +Title: FHWA TPM Score Calculation Functions +Version: 1.2.0 Authors@R: person(given = "Mark", family = "Egge", role = c("aut", "cre"), email = "egge@highstreetconsulting.com", comment = c(ORCID = "YOUR-ORCID-ID")) -Description: Contains functions for calculating Level of Travel Time Reliability and Truck Travel Time Reliability metric scores from NPMRDS travel time data and for calculating statewide reliability performance measures. +Description: Contains functions for calculating TPM PM3 Level of Travel Time Reliability and Truck Travel Time Reliability metric scores from NPMRDS travel time data and for calculating statewide reliability performance measures. License: Mozilla Public License Version 2.0 Encoding: UTF-8 URL: https://github.com/markegge/fhwa_pm3/ @@ -18,7 +18,7 @@ Depends: Imports: data.table (>= 1.13), fasttime -RoxygenNote: 7.1.1 +RoxygenNote: 7.3.1 Suggests: testthat (>= 3.0.0) Config/testthat/edition: 3 diff --git a/R/functions.R b/R/functions.R index f485cf6..6851c50 100644 --- a/R/functions.R +++ b/R/functions.R @@ -324,7 +324,7 @@ phed <- function(travel_time_readings, tmc_identification, tmcs[, road_class := ifelse(f_system == 1, "freeway", "non_freeway")] # for volume factors - stopifnot(nrow(tmcs) > 5) + stopifnot(nrow(tmcs) > 1) # # calculate volume (persons) per 15 mins @@ -352,6 +352,10 @@ phed <- function(travel_time_readings, tmc_identification, stopifnot(c("tmc", "speed_limit") %in% colnames(speed_limits)) tmcs <- merge(tmcs, speed_limits[, c("tmc", "speed_limit")], by = "tmc", all.x = TRUE) + if(any(is.na(tmcs$speed_limit))) { + warning(paste("Speed limits missing for ", tmcs[is.na(speed_limit)]$tmc)) + } + # calculate threshold travel times tmcs[, threshold_speed := pmax(20, speed_limit * 0.6)] tmcs[, threshold_travel_time := (miles / threshold_speed) * 3600] @@ -377,23 +381,24 @@ phed <- function(travel_time_readings, tmc_identification, setnames(travel_time, "tmc_code", "tmc") - # join in threshold travel times with TMC inner join + # join in threshold travel times with TMCs travel_time <- merge(travel_time, tmcs[, .(tmc, road_class, aadp, threshold_travel_time)], by = "tmc") - delay <- travel_time[travel_time_seconds > threshold_travel_time] - - # 900 seconds max delay per FHWA's rule: - delay[, delay_seconds := pmin(travel_time_seconds - threshold_travel_time, 900)] + # 0 seconds min, 900 seconds max delay per FHWA's rule: + travel_time[, delay_seconds := pmax(0, pmin(travel_time_seconds - threshold_travel_time, 900))] # calculate person hours - delay <- merge(delay, period_factors, by = c("road_class", "month", "day", "hour")) + travel_time <- merge(travel_time, period_factors, by = c("road_class", "month", "day", "hour")) # multiply by 0.25 because each observation is a quarter of an hour - delay[, delay_person_hours := (delay_seconds / 3600) * aadp * factor * 0.25] + travel_time[, delay_person_hours := (delay_seconds / 3600) * aadp * factor * 0.25] + + tmc_delay <- travel_time[, .(delay = round(sum(delay_person_hours), 3)), by = tmc] - tmc_delay <- delay[, .(delay = round(sum(delay_person_hours), 3)), by = tmc] + # join TMC back to TMCs to capture any TMCs without travel time info + tmc_delay <- merge(tmcs, tmc_delay, by = "tmc", all.x = TRUE) - rm(travel_time); rm(delay) # R doesn't seem to garbage collect + rm(travel_time); # R doesn't seem to garbage collect # Results ---- # PHED per Capita: @@ -443,7 +448,7 @@ hpms <- function(tmc_identification, lottr_scores, tttr_scores, phed_scores = NU state <- unique(toupper(DT$state)) stopifnot(length(state) == 1) - state_fips <- pm3:::fips_lookup[Postal_Code == state]$FIPS_Code + state_fips <- tpm:::fips_lookup[Postal_Code == state]$FIPS_Code # Set NHS Value appropriately - no zeros allowed by FHWA! DT[isprimary == "0", nhs := -1] diff --git a/R/pm3.R b/R/tpm.R similarity index 89% rename from R/pm3.R rename to R/tpm.R index e30083d..482ce17 100644 --- a/R/pm3.R +++ b/R/tpm.R @@ -1,4 +1,4 @@ -#' PM3 Tools: A package for calculating PM3 Travel Time Reliability Scores from NPMRDS Data +#' TPM Tools: A package for calculating TPM PM3 Travel Time Reliability Scores from NPMRDS Data #' #' This package will provides functions needed to calculate PM3 System Reliability #' and Freight and CMAQ Congestion Federal TPM Performance measures @@ -17,7 +17,7 @@ #' #' #' @docType package -#' @name pm3 +#' @name tpm #' #' @import data.table #' @importFrom stats quantile time diff --git a/README.md b/README.md index 222d1d4..a637a5a 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,6 @@ -# NPMRDS Processing Tools for Assessing System Performance, Freight Movement, and CMAQ Improvement Program +# Federal Transportation Performance Management Data Processing Tools + +### This package provides NPMRDS Processing Tools for Assessing System Performance, Freight Movement, and CMAQ Improvement Program This repository provides some scripts and tools written in R for effectively working with voluminous NPMRDS data for calculating the FHWA Transportation Performance Management (TPM) PM3 System Reliability, Freight, and CMAQ Congestion Performance Performance Measures. For use with NPMRDS (2016 – Present) downloaded from https://npmrds.ritis.org/ @@ -14,7 +16,7 @@ The package consists of the following: ```r library(devtools) devtools::install_github("markegge/fhwa_pm3") -library(pm3) +library(tpm) ``` ### A Minimal Example @@ -23,7 +25,7 @@ _To run the example below, create a RITIS NPMRDS export using the instructions b ```R library(data.table) -library(pm3) +library(tpm) # Calculate segment-level LOTTR and TTTR scores # Using "All Vehicles" readings file only for demo purposes @@ -230,5 +232,6 @@ License: Mozilla Public License Version 2.0 ## What's New +* May 2024: Renamed package from "pm3" to "tpm." Updated for compatibility with R 4.4+ * June 15, 2022: Refactored function calls to provide greater consistency between measures. LOTTR and TTTR are now scored using `lottr()` and `tttr()` respectively, rather than `score()`. HPMS function now accepts PHED scores. * June 10, 2022: Added PHED function to calculate PHED given a travel time readings file and speed limits diff --git a/man/pm3.Rd b/man/tpm.Rd similarity index 63% rename from man/pm3.Rd rename to man/tpm.Rd index 747c724..0dc06db 100644 --- a/man/pm3.Rd +++ b/man/tpm.Rd @@ -1,9 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/pm3.R +% Please edit documentation in R/tpm.R \docType{package} -\name{pm3} -\alias{pm3} -\title{PM3 Tools: A package for calculating PM3 Travel Time Reliability Scores from NPMRDS Data} +\name{tpm} +\alias{tpm-package} +\alias{tpm} +\title{TPM Tools: A package for calculating TPM PM3 Travel Time Reliability Scores from NPMRDS Data} \description{ This package will provides functions needed to calculate PM3 System Reliability and Freight and CMAQ Congestion Federal TPM Performance measures @@ -23,3 +24,15 @@ The functions \code{\link{hpms}} generates an HPMS submission file in pipe delimited format } +\seealso{ +Useful links: +\itemize{ + \item \url{https://github.com/markegge/fhwa_pm3/} + \item Report bugs at \url{https://github.com/markegge/fhwa_pm3/issues} +} + +} +\author{ +\strong{Maintainer}: Mark Egge \email{egge@highstreetconsulting.com} (\href{https://orcid.org/YOUR-ORCID-ID}{ORCID}) + +} diff --git a/tests/testthat.R b/tests/testthat.R index 949bda0..5e1b360 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,4 +1,4 @@ library(testthat) -library(pm3) +library(tpm) -test_check("pm3") +test_check("tpm") diff --git a/pm3.Rproj b/tpm.Rproj similarity index 100% rename from pm3.Rproj rename to tpm.Rproj