renamed to tpm package

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 = "[email protected]",
            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

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]

R/pm3.R → 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

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

tests/testthat.R

@@ -1,4 +1,4 @@
 library(testthat)
-library(pm3)
+library(tpm)
 
-test_check("pm3")
+test_check("tpm")