diff --git a/sources/modules/VEHouseholdVehicles-old/.Rbuildignore b/sources/modules/VEHouseholdVehicles-old/.Rbuildignore new file mode 100644 index 000000000..91114bf2f --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/.Rbuildignore @@ -0,0 +1,2 @@ +^.*\.Rproj$ +^\.Rproj\.user$ diff --git a/sources/modules/VEHouseholdVehicles-old/.gitignore b/sources/modules/VEHouseholdVehicles-old/.gitignore new file mode 100644 index 000000000..5b6a06525 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/.gitignore @@ -0,0 +1,4 @@ +.Rproj.user +.Rhistory +.RData +.Ruserdata diff --git a/sources/modules/VEHouseholdVehicles-old/DESCRIPTION b/sources/modules/VEHouseholdVehicles-old/DESCRIPTION new file mode 100644 index 000000000..bc74be0f9 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/DESCRIPTION @@ -0,0 +1,32 @@ +Package: VEHouseholdVehicles +Type: Package +Title: Model household vehicles +Version: 0.9.7 +Date: 6/5/20 +Author: Brian Gregor [aut, cre], Aditya Gore [cre] +Maintainer: Brian Gregor , Aditya Gore +Copyright: AASHTO +URL: https://github.com/gregorbj/VisionEval/sources/modules/VEVehicleOwnership +Description: This package contains modules which predict household vehicle + ownership, including the number owned, body types, and ages. It also + identifies car service accessibility by household (High & Low) and + substitutes car service (e.g. car sharing or transportation network company) + for owning a household vehicle for households that have a high level of car + service availability and the cost of owning a car per mile of travel is + higher than the cost per mile of using a car service. The cost of owning + vehicles is calculated as a function of the vehicle age, type, and vehicle + miles traveled. +License: file LICENSE +LazyData: TRUE +Depends: R (>= 3.6.0) +Imports: + visioneval, + ordinal, + reshape2, + usethis, + VE2001NHTS +Suggests: + knitr +Encoding: UTF-8 +VignetteBuilder: knitr +RoxygenNote: 6.1.1 diff --git a/sources/modules/VEHouseholdVehicles-old/LICENSE b/sources/modules/VEHouseholdVehicles-old/LICENSE new file mode 100644 index 000000000..d64569567 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/LICENSE @@ -0,0 +1,202 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/sources/modules/VEHouseholdVehicles-old/NAMESPACE b/sources/modules/VEHouseholdVehicles-old/NAMESPACE new file mode 100644 index 000000000..6b59f9f1e --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/NAMESPACE @@ -0,0 +1,30 @@ +# Generated by roxygen2: do not edit by hand + +export(AdjustVehicleOwnership) +export(AssignDrivers) +export(AssignVehicleAge) +export(AssignVehicleFeatures) +export(AssignVehicleFeaturesFuture) +export(AssignVehicleOwnership) +export(AssignVehicleType) +export(CalculateVehicleOwnCost) +export(CreateVehicleTable) +export(adjAgeDistribution) +export(adjustAgeDistribution) +export(apportionDvmt) +export(assignFuelEconomy) +export(calcAdValoremTax) +export(calcAgeDistributionByInc) +export(calcVehAgePropByInc) +export(calcVehDepr) +export(calcVehFin) +export(calcVehPropByIncome) +export(calcVehicleAges) +export(findMeanAge) +export(predictLtTruckOwn) +export(predictVehicleOwnership) +import(ordinal) +import(reshape2) +import(stats) +import(visioneval) +importFrom(utils,capture.output) diff --git a/sources/modules/VEHouseholdVehicles-old/R/AdjustVehicleOwnership.R b/sources/modules/VEHouseholdVehicles-old/R/AdjustVehicleOwnership.R new file mode 100644 index 000000000..63bd40d72 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/R/AdjustVehicleOwnership.R @@ -0,0 +1,492 @@ +#======================== +#AdjustVehicleOwnership.R +#======================== +# +# +# +## AdjustVehicleOwnership Module +#### November 23, 2018 +# +#This module adjusts household vehicle ownership based on a comparison of the cost of owning a vehicle per mile of travel compared to the cost per mile of using a car service where the level of service is high. The determination of whether car services are substituted for ownership also depends on input assumptions regarding the average likelihood that an owner would substitute car services for a household vehicle. +# +### Model Parameter Estimation +# +#This module has no estimated parameters. +# +### How the Module Works +# +#The module loads car service cost and substitution probability datasets that are inputs to the CreateVehicleTable module, car service service levels that are inputs from the AssignCarSvcAvailability module, and household vehicle ownership cost data that are outputs of the CalculateVehicleOwnCost module. The module compares the vehicle ownership cost per mile of travel for all vehicles of households living in zones where there is a high level of car service with the cost per mile of using a car service. The module flags all all vehicles where car service is high and the car service use cost is lower than the ownership cost. For those flagged vehicles, the module randomly changes their status from ownership to car service where the probability of change is the substitution probability. For example, if the user believes that only a quarter of light truck owners would substitute car services for owning a light truck (because car services wouldn't enable them to use their light truck as they intend, such as towing a trailer), then the substitution probability would be 0.25. For vehicles where it is determined that car services will substitute for a household vehicle, then the vehicle status is changed from 'Own' to 'HighCarSvc' and the ownership and insurance costs are changed as well. The household's vehicle totals are changed as well. +# +# + + +#============================================= +#SECTION 1: ESTIMATE AND SAVE MODEL PARAMETERS +#============================================= +#This module has no estimated model parameters. + + +#================================================ +#SECTION 2: DEFINE THE MODULE DATA SPECIFICATIONS +#================================================ + +#Define the data specifications +#------------------------------ +AdjustVehicleOwnershipSpecifications <- list( + #Level of geography module is applied at + RunBy = "Region", + #Specify new tables to be created by Inp if any + #Specify new tables to be created by Set if any + #Specify input data + #Specify data to be loaded from data store + Get = items( + item( + NAME = "Azone", + TABLE = "Azone", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = + items( + "HighCarSvcCost", + "LowCarSvcCost"), + TABLE = "Azone", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "AveCarSvcVehicleAge", + TABLE = "Azone", + GROUP = "Year", + TYPE = "time", + UNITS = "YR", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = + items( + "LtTrkCarSvcSubProp", + "AutoCarSvcSubProp"), + TABLE = "Azone", + GROUP = "Year", + TYPE = "double", + UNITS = "proportion", + PROHIBIT = c("NA", "< 0", "> 1"), + ISELEMENTOF = "" + ), + item( + NAME = "HhId", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = items( + "Vehicles", + "NumLtTrk", + "NumAuto"), + TABLE = "Household", + GROUP = "Year", + TYPE = "vehicles", + UNITS = "VEH", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "CarSvcLevel", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBIT = "", + ISELEMENTOF = c("Low", "High") + ), + item( + NAME = "Azone", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "NA", + ISELEMENTOF = "" + ), + item( + NAME = "HhId", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "NA", + ISELEMENTOF = "" + ), + item( + NAME = "VehId", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "NA", + ISELEMENTOF = "" + ), + item( + NAME = "VehicleAccess", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBIT = "", + ISELEMENTOF = c("Own", "LowCarSvc", "HighCarSvc") + ), + item( + NAME = "Type", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBIT = "NA", + ISELEMENTOF = c("Auto", "LtTrk") + ), + item( + NAME = "Age", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "time", + UNITS = "YR", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "OwnCost", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "OwnCostPerMile", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "InsCost", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ) + ), + #Specify data to saved in the data store + Set = items( + item( + NAME = "Age", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "time", + UNITS = "YR", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Vehicle age in years" + ), + item( + NAME = "VehicleAccess", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + NAVALUE = "NA", + PROHIBIT = "", + ISELEMENTOF = c("Own", "LowCarSvc", "HighCarSvc"), + SIZE = 10, + DESCRIPTION = "Identifier whether vehicle is owned by household (Own), if vehicle is low level car service (LowCarSvc), or if vehicle is high level car service (HighCarSvc)" + ), + item( + NAME = "OwnCost", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Annual cost of vehicle ownership including depreciation, financing, insurance, taxes, and residential parking in dollars" + ), + item( + NAME = "OwnCostPerMile", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Annual cost of vehicle ownership per mile of vehicle travel (dollars per mile)" + ), + item( + NAME = "InsCost", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Annual vehicle insurance cost in dollars" + ), + item( + NAME = "SwitchToCarSvc", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "integer", + UNITS = "binary", + NAVALUE = -1, + PROHIBIT = "", + ISELEMENTOF = c(0, 1), + SIZE = 0, + DESCRIPTION = "Identifies whether a vehicle was switched from owned to car service" + ), + item( + NAME = "OwnCostSavings", + TABLE = "Household", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD", + NAVALUE = "NA", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Annual vehicle ownership cost (depreciation, finance, insurance, taxes) savings in dollars resulting from substituting the use of car services for a household vehicle" + ), + item( + NAME = "OwnCost", + TABLE = "Household", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD", + NAVALUE = "NA", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Annual household vehicle ownership cost (depreciation, finance, insurance, taxes) savings in dollars" + ), + item( + NAME = items( + "Vehicles", + "NumLtTrk", + "NumAuto", + "NumHighCarSvc"), + TABLE = "Household", + GROUP = "Year", + TYPE = "vehicles", + UNITS = "VEH", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = items( + "Number of automobiles and light trucks owned or leased by the household including high level car service vehicles available to driving-age persons", + "Number of light trucks (pickup, sport-utility vehicle, and van) owned or leased by household", + "Number of automobiles (i.e. 4-tire passenger vehicles that are not light trucks) owned or leased by household", + "Number of high level service car service vehicles available to the household (difference between number of vehicles owned by the household and number of driving age persons for households having availability of high level car services" + ) + ) + ) +) + +#Save the data specifications list +#--------------------------------- +#' Specifications list for AdjustVehicleOwnership module +#' +#' A list containing specifications for the AdjustVehicleOwnership module. +#' +#' @format A list containing 4 components: +#' \describe{ +#' \item{RunBy}{the level of geography that the module is run at} +#' \item{Inp}{model inputs to be saved to the datastore} +#' \item{Get}{module inputs to be read from the datastore} +#' \item{Set}{module outputs to be written to the datastore} +#' } +#' @source AdjustVehicleOwnership.R script. +"AdjustVehicleOwnershipSpecifications" +usethis::use_data(AdjustVehicleOwnershipSpecifications, overwrite = TRUE) + + +#======================================================= +#SECTION 3: DEFINE FUNCTIONS THAT IMPLEMENT THE SUBMODEL +#======================================================= +#This module adjusts household vehicle ownership based on a comparison of the +#cost of owning a vehicle per mile of travel compared to the cost per mile of +#using a car service where the level of service is high. The determination of +#whether car services are substituted for ownership also depends on input +#assumptions regarding the average likelihood that an owner would substitute +#car services for a household vehicle. The user inputs the likelihood by vehicle +#type. For example, if the user believes that a quarter of light truck owners +#would not substitute car services for owning a light truck because of how they +#use their light truck (e.g. pulling a recreational trailer, rough road travel, +#etc.), then the substitition probability would be 0.75. When it is determined +#that car services will substitute for a household vehicle, then the vehicle +#status is changed from 'Own' to 'HighCarSvc' and the ownership and insurance +#costs are changed as well. The household's vehicle totals are changed as well. + +#Main module function to adjust household vehicle ownership +#---------------------------------------------------------- +#' Adjust household vehicle ownership when car service cost is less. +#' +#' \code{AdjustVehicleOwnership} adjusts household vehicle ownership by +#' substituting use of car service when the level of car service is high and +#' when cost per mile to use car service is less than the cost per mile to +#' own vehicle +#' +#' This function calculates the ownership cost per mile for household vehicles +#' and compares with the cost per mile to use car service vehicles if the level +#' of car service is high. If ownership is more costly for a vehicle, +#' substitution is determined by random draw using the car service substitution +#' probability for the vehicle type. If a substitution is made, the vehicle +#' access status is changed from 'Own' to 'HighCarSvc'. The ownership cost is +#' changed to 0 as is the insurance cost. The household vehicle inventory is +#' also updated. +#' +#' @param L A list containing the components listed in the Get specifications +#' for the module. +#' @return A list containing the components specified in the Set +#' specifications for the module. +#' @name AdjustVehicleOwnership +#' @import visioneval +#' @export +#' +AdjustVehicleOwnership <- function(L) { + #Set the seed for random draws + set.seed(L$G$Seed) + #Household to vehicle index + HhToVehIdx_Ve <- match(L$Year$Vehicle$HhId, L$Year$Household$HhId) + #Azone to vehicle index + AzToVehIdx_Ve <- match(L$Year$Vehicle$Azone, L$Year$Azone$Azone) + + #Identify the vehicles that will be changed from owned to car service + #-------------------------------------------------------------------- + #Identify the car service level corresponding to each vehicle + NumVeh <- length(L$Year$Vehicle$VehId) + CarSvcLvl_Ve <- L$Year$Household$CarSvcLevel[HhToVehIdx_Ve] + #Identify candidates for swapping owned vehicle for car services + IsOwnedVeh <- L$Year$Vehicle$VehicleAccess == "Own" + IsHighCS <- CarSvcLvl_Ve == "High" + CSIsLess <- + L$Year$Azone$HighCarSvcCost[AzToVehIdx_Ve] < L$Year$Vehicle$OwnCostPerMile + IsCandidate <- IsOwnedVeh & IsHighCS & CSIsLess + #Get the change probabilities + ChangeProb_Ve <- L$Year$Azone$AutoCarSvcSubProp[AzToVehIdx_Ve] + IsLtTrk <- L$Year$Vehicle$Type == "LtTrk" + ChangeProb_Ve[IsLtTrk] <- L$Year$Azone$LtTrkCarSvcSubProp[AzToVehIdx_Ve][IsLtTrk] + #Identify vehicles to change + DoChange <- logical(NumVeh) + DoChange[IsCandidate] <- runif(sum(IsCandidate)) < ChangeProb_Ve[IsCandidate] + + #Modify vehicle values to reflect change to change in ownership + #-------------------------------------------------------------- + Out_ls <- initDataList() + Out_ls$Year$Vehicle <- + L$Year$Vehicle[c("Age", "VehicleAccess", "OwnCost", "OwnCostPerMile", "InsCost")] + Out_ls$Year$Vehicle$Age[DoChange] <- L$Year$Azone$AveCarSvcVehicleAge[AzToVehIdx_Ve][DoChange] + Out_ls$Year$Vehicle$VehicleAccess[DoChange] <- "HighCarSvc" + Out_ls$Year$Vehicle$OwnCost[DoChange] <- 0 + Out_ls$Year$Vehicle$OwnCostPerMile[DoChange] <- 0 + Out_ls$Year$Vehicle$InsCost[DoChange] <- 0 + Out_ls$Year$Vehicle$SwitchToCarSvc <- as.integer(DoChange) + + #Tabulate household values to reflect changes + #-------------------------------------------- + #Faster tapply to sum up to household level + NumHh <- length(L$Year$Household$HhId) + sumToHousehold <- function(Data_, Index_) { + Data_Hh <- numeric(NumHh) + Data_Hx <- tapply(Data_, Index_, sum) + Data_Hh[as.numeric(names(Data_Hx))] <- Data_Hx + Data_Hh + } + #Populate outputs list + Out_ls$Year$Household <- list() + VehCat_Ve <- L$Year$Vehicle$Type + VehCat_Ve[Out_ls$Year$Vehicle$VehicleAccess == "HighCarSvc"] <- "HighCarSvc" + VehCat_Ve[Out_ls$Year$Vehicle$VehicleAccess == "LowCarSvc"] <- "LowCarSvc" + Out_ls$Year$Household$NumAuto <- sumToHousehold(VehCat_Ve == "Auto", HhToVehIdx_Ve) + Out_ls$Year$Household$NumLtTrk <- sumToHousehold(VehCat_Ve == "LtTrk", HhToVehIdx_Ve) + Out_ls$Year$Household$NumHighCarSvc <- sumToHousehold(VehCat_Ve == "HighCarSvc", HhToVehIdx_Ve) + Out_ls$Year$Household$Vehicles <- + with(Out_ls$Year$Household, NumAuto + NumLtTrk + NumHighCarSvc) + Out_ls$Year$Household$OwnCost <- sumToHousehold(Out_ls$Year$Vehicle$OwnCost, HhToVehIdx_Ve) + Out_ls$Year$Household$OwnCostSavings <- + sumToHousehold(L$Year$Vehicle$OwnCost * DoChange, HhToVehIdx_Ve) + + #Return the outputs list + #----------------------- + Out_ls +} + + +#=============================================================== +#SECTION 4: MODULE DOCUMENTATION AND AUXILLIARY DEVELOPMENT CODE +#=============================================================== +#Run module automatic documentation +#---------------------------------- +documentModule("AdjustVehicleOwnership") + +#Test code to check specifications, loading inputs, and whether datastore +#contains data needed to run module. Return input list (L) to use for developing +#module functions +#------------------------------------------------------------------------------- +# #Load packages and test functions +# library(filesstrings) +# library(visioneval) +# library(ordinal) +# source("tests/scripts/test_functions.R") +# #Set up test environment +# TestSetup_ls <- list( +# TestDataRepo = "../Test_Data/VE-State", +# DatastoreName = "Datastore.tar", +# LoadDatastore = TRUE, +# TestDocsDir = "vestate", +# ClearLogs = TRUE, +# # SaveDatastore = TRUE +# SaveDatastore = FALSE +# ) +# setUpTests(TestSetup_ls) +# #Run test module +# TestDat_ <- testModule( +# ModuleName = "AdjustVehicleOwnership", +# LoadDatastore = TRUE, +# SaveDatastore = FALSE, +# DoRun = FALSE +# ) +# L <- TestDat_$L +# R <- AdjustVehicleOwnership(TestDat_$L) +# +# #Run test module +# TestDat_ <- testModule( +# ModuleName = "AdjustVehicleOwnership", +# LoadDatastore = TRUE, +# SaveDatastore = TRUE, +# DoRun = TRUE +# ) diff --git a/sources/modules/VEHouseholdVehicles-old/R/AssignDrivers.R b/sources/modules/VEHouseholdVehicles-old/R/AssignDrivers.R new file mode 100644 index 000000000..a075054b8 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/R/AssignDrivers.R @@ -0,0 +1,699 @@ +#=============== +#AssignDrivers.R +#=============== +# +# +# +## AssignDrivers Module +#### September 6, 2018 +# +#This module assigns drivers by age group to each household as a function of the numbers of persons and workers by age group, the household income, land use characteristics, and public transit availability. Users may specify the relative driver licensing rate relative to the model estimation data year in order to account for observed or projected changes in licensing rates. +# +### Model Parameter Estimation +# +#Binary logit models are estimated to predict the probability that a person has a drivers license. Two versions of the model are estimated, one for persons in a metropolitan (i.e. urbanized) area, and another for persons located in non-metropolitan areas. There are different versions because the estimation data have more information about transportation system and land use characteristics for households located in urbanized areas. In both versions, the probability that a person has a drivers license is a function of the age group of the person, whether the person is a worker, the number of persons in the household, the income and squared income of the household, whether the household lives in a single-family dwelling, and the population density of the Bzone where the person lives. In the metropolitan area model, the bus-equivalent transit revenue miles and whether the household resides in an urban mixed-use neighborhood are significant factors. Following are the summary statistics for the metropolitan model: +# +# +# +#Following are the summary statistics for the non-metropolitan model: +# +# +# +#The models are estimated using the *Hh_df* (household) and *Per_df* (person) datasets in the VE2001NHTS package. Information about these datasets and how they were developed from the 2001 National Household Travel Survey public use dataset is included in that package. +# +### How the Module Works +# +#The module iterates through each age group excluding the 0-14 year age group and creates a temporary set of person records for households in the region. For each household there are as many person records as there are persons in the age group in the household. A worker status attribute is added to each record based on the number of workers in the age group in the household. For example, if a household has 2 persons and 1 worker in the 20-29 year age group, one of the records would have its worker status attribute equal to 1 and the other would have its worker status attribute equal to 0. The person records are also populated with the household characteristics used in the model. The binomial logit model is applied to the person records to determine the probability that each person is a driver. The driver status of each person is determined by random draws with the modeled probability determining the likelihood that the person is determined to be a driver. The resulting number of drivers in the age group is then tabulated by household. +# +# + + +#============================================= +#SECTION 1: ESTIMATE AND SAVE MODEL PARAMETERS +#============================================= +# +#' @importFrom utils capture.output +# +#Define a function to estimate driver choice model +#------------------------------------------------- +estimateDriverModel <- function(Data_df, StartTerms_, ValidationProp) { + #Define function to prepare inputs for estimating model + prepIndepVar <- + function(In_df) { + Out_df <- In_df + Out_df$IncomeSq <- In_df$Income ^ 2 + Out_df$IsSF <- as.numeric(In_df$HouseType == "SF") + Out_df$Age15to19 <- as.numeric(In_df$AgeGroup == "Age15to19") + Out_df$Age20to29 <- as.numeric(In_df$AgeGroup == "Age20to29") + Out_df$Age30to54 <- as.numeric(In_df$AgeGroup == "Age30to54") + Out_df$Age55to64 <- as.numeric(In_df$AgeGroup == "Age55to64") + Out_df$Age65Plus <- as.numeric(In_df$AgeGroup == "Age65Plus") + Out_df$Intercept <- 1 + Out_df + } + EstData_df <- prepIndepVar(Data_df) + #Define function to make the model formula + makeFormula <- + function(StartTerms_) { + FormulaString <- + paste("Driver ~ ", paste(StartTerms_, collapse = "+")) + as.formula(FormulaString) + } + #Split data into training and validation data sets + if (ValidationProp > 0.5) { + stop("The proportion of the Data_df reserved for validation (ValidationProp) must be no greater than 0.5.") + } + NumCases <- nrow(EstData_df) + ValidateIdx <- sample(1:NumCases, round(ValidationProp * NumCases)) + TrainIdx <- (1:NumCases)[!(1:NumCases %in% ValidateIdx)] + #Estimate model + DriverModel <- + glm(makeFormula(StartTerms_), family = binomial, data = EstData_df[TrainIdx,]) + #Check validation + PredProb_ <- + predict(DriverModel, newdata = EstData_df[ValidateIdx,], type = "response") + Pred_ <- ifelse(PredProb_ > 0.5, 1, 0) + Obs_ <- EstData_df[ValidateIdx, "Driver"] + Compare_tbl <- table(Obs_, Pred_) + #Return model + list( + Type = "binomial", + Formula = makeModelFormulaString(DriverModel), + Choices = c(1, 0), + PrepFun = prepIndepVar, + Summary = capture.output(summary(DriverModel)), + Anova = anova(DriverModel, test = "Chisq"), + PropCorrectlyPredicted = sum(diag(Compare_tbl)) / sum(Compare_tbl) + ) +} + +#Set up data estimate models +#--------------------------- +#Load NHTS household data +Hh_df <- VE2001NHTS::Hh_df +#Identify records used for estimating metropolitan area models +Hh_df$IsMetro <- Hh_df$Msacat %in% c("1", "2") +#Load NHTS person data to use for model estimation +Per_df <- VE2001NHTS::Per_df[, c("Houseid", "Driver", "AgeGroup", "Worker")] +#Join person data with select household data +ModelVars_ <- + c("Houseid", "Hbppopdn", "Income", "Hhsize", "Hometype", "UrbanDev", + "BusEqRevMiPC", "Hhvehcnt", "IsMetro", "FwyLnMiPC") +D_df <- merge( Per_df, Hh_df[, ModelVars_], "Houseid") +#Define variables consistent with other module names +D_df$HouseType <- "MF" +D_df$HouseType[D_df$Hometype == "Single Family"] <- "SF" +D_df$HhSize <- D_df$Hhsize +D_df$PopDensity <- D_df$Hbppopdn +D_df$IsUrbanMixNbrhd <- D_df$UrbanDev +D_df$TranRevMiPC <- D_df$BusEqRevMiPC + +#Estimate metropolitan and non-metropolitan driver models +#-------------------------------------------------------- +#Estimate the metropolitan model +DriverModelTerms_ <- + c( + "Age15to19", + "Age20to29", + "Age30to54", + "Age55to64", + "Age65Plus", + "Worker", + "HhSize", + "Income", + "IncomeSq", + "IsSF", + "PopDensity", + "IsUrbanMixNbrhd", + "TranRevMiPC" + ) +MetroDriverModel_ls <- + estimateDriverModel( + Data_df = D_df[D_df$IsMetro,], + StartTerms_ = DriverModelTerms_, + ValidationProp = 0.2) +MetroDriverModel_ls$SearchRange <- c(-10, 10) +rm(DriverModelTerms_) +#Estimate the nonmetropolitan model +DriverModelTerms_ <- + c( + "Age15to19", + "Age20to29", + "Age30to54", + "Age55to64", + "Age65Plus", + "Worker", + "HhSize", + "Income", + "IncomeSq", + "IsSF", + "PopDensity" + ) +NonMetroDriverModel_ls <- + estimateDriverModel( + D_df[!D_df$IsMetro,], + DriverModelTerms_, + ValidationProp = 0.2) +NonMetroDriverModel_ls$SearchRange <- c(-10, 10) +rm(DriverModelTerms_) +#Combine the models +DriverModel_ls <- list( + Metro = MetroDriverModel_ls, + NonMetro = NonMetroDriverModel_ls +) + +#Save the driver choice model +#---------------------------- +#' Driver choice model +#' +#' A list containing the driver choice models for metropolitan and +#' non-metropolitan areas. Includes model equations and other information +#' needed to implement the driver choice model. +#' +#' @format A list having having Metro and NonMetro components, with each having the following components: +#' \describe{ +#' \item{Type}{a string identifying the type of model} +#' \item{Formula}{a string representation of the model formula} +#' \item{PrepFun}{a function that prepares inputs to be applied in the model} +#' \item{Summary}{the summary of the binomial logit model estimation results} +#' \item{Anova}{results of analysis of variance of the model} +#' \item{PropCorrectlyPredicted}{proportion of cases of validation dataset correctly predicted by model} +#' \item{SearchRange}{a two-element vector specifying the range of search values} +#' } +#' @source AssignDrivers.R script. +"DriverModel_ls" +usethis::use_data(DriverModel_ls, overwrite = TRUE) + + +#================================================ +#SECTION 2: DEFINE THE MODULE DATA SPECIFICATIONS +#================================================ + +#Define the data specifications +#------------------------------ +AssignDriversSpecifications <- list( + #Level of geography module is applied at + RunBy = "Region", + #Specify new tables to be created by Inp if any + #Specify new tables to be created by Set if any + #Specify input data + Inp = items( + item( + NAME = + items( + "Drv15to19AdjProp", + "Drv20to29AdjProp", + "Drv30to54AdjProp", + "Drv55to64AdjProp", + "Drv65PlusAdjProp"), + FILE = "region_hh_driver_adjust_prop.csv", + TABLE = "Region", + GROUP = "Year", + TYPE = "double", + UNITS = "proportion", + NAVALUE = -1, + SIZE = 0, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + UNLIKELY = c("> 1.5"), + TOTAL = "", + DESCRIPTION = + items( + "Target proportion of unadjusted model number of drivers 15 to 19 years old (1 = no adjustment)", + "Target proportion of unadjusted model number of drivers 20 to 29 years old (1 = no adjustment)", + "Target proportion of unadjusted model number of drivers 30 to 54 years old (1 = no adjustment)", + "Target proportion of unadjusted model number of drivers 55 to 64 years old (1 = no adjustment)", + "Target proportion of unadjusted model number of drivers 65 or older (1 = no adjustment)" + ), + OPTIONAL = TRUE + ) + ), + #Specify data to be loaded from data store + Get = items( + item( + NAME = + items( + "Drv15to19AdjProp", + "Drv20to29AdjProp", + "Drv30to54AdjProp", + "Drv55to64AdjProp", + "Drv65PlusAdjProp"), + TABLE = "Region", + GROUP = "Year", + TYPE = "double", + UNITS = "proportion", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + OPTIONAL = TRUE + ), + item( + NAME = "Marea", + TABLE = "Marea", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "TranRevMiPC", + TABLE = "Marea", + GROUP = "Year", + TYPE = "compound", + UNITS = "MI/PRSN/YR", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "Bzone", + TABLE = "Bzone", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "D1B", + TABLE = "Bzone", + GROUP = "Year", + TYPE = "compound", + UNITS = "PRSN/SQMI", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "Marea", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "Bzone", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "HhId", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = + items("Age15to19", + "Age20to29", + "Age30to54", + "Age55to64", + "Age65Plus"), + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = + items("Wkr15to19", + "Wkr20to29", + "Wkr30to54", + "Wkr55to64", + "Wkr65Plus"), + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "Income", + TABLE = "Household", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD.2001", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "HhSize", + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + PROHIBIT = c("NA", "<= 0"), + ISELEMENTOF = "" + ), + item( + NAME = "HouseType", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBIT = "", + ISELEMENTOF = c("SF", "MF", "GQ") + ), + item( + NAME = "IsUrbanMixNbrhd", + TABLE = "Household", + GROUP = "Year", + TYPE = "integer", + UNITS = "binary", + PROHIBIT = "NA", + ISELEMENTOF = c(0, 1) + ), + item( + NAME = "LocType", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBIT = "NA", + ISELEMENTOF = c("Urban", "Town", "Rural") + ) + ), + #Specify data to saved in the data store + Set = items( + item( + NAME = items( + "Drv15to19", + "Drv20to29", + "Drv30to54", + "Drv55to64", + "Drv65Plus" + ), + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = items( + "Number of drivers 15 to 19 years old", + "Number of drivers 20 to 29 years old", + "Number of drivers 30 to 54 years old", + "Number of drivers 55 to 64 years old", + "Number of drivers 65 or older") + ), + item( + NAME = "Drivers", + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Number of drivers in household" + ), + item( + NAME = "DrvAgePersons", + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Number of people 15 year old or older in the household" + ) + ) +) + +#Save the data specifications list +#--------------------------------- +#' Specifications list for PredictHousing module +#' +#' A list containing specifications for the PredictHousing module. +#' +#' @format A list containing 4 components: +#' \describe{ +#' \item{RunBy}{the level of geography that the module is run at} +#' \item{Inp}{scenario input data to be loaded into the datastore for this +#' module} +#' \item{Get}{module inputs to be read from the datastore} +#' \item{Set}{module outputs to be written to the datastore} +#' } +#' @source AssignDrivers.R script. +"AssignDriversSpecifications" +usethis::use_data(AssignDriversSpecifications, overwrite = TRUE) + + +#======================================================= +#SECTION 3: DEFINE FUNCTIONS THAT IMPLEMENT THE SUBMODEL +#======================================================= +# The module assigns the number of drivers in each age group (except 0 - 14) to +# each household. It applies the driver model by age group and if the driver +# adjustment proportion for the age group is not 0, it calculates the modelled +# driver proportion and multiplies that by the adjustment proportion to get a +# new target proportion. It then adjusts the model until the adjusted target +# proportion is achieved. The purpose of the adjustment proportion is to account +# for trends in licensing among different age groups. For example, the rates of +# licensing of teenagers and young adults has fallen in recent years. + +#Main module function that assigns drivers by age group to each household +#------------------------------------------------------------------------ +#' Main module function to assign drivers by age group to each household. +#' +#' \code{AssignDrivers} assigns number of drivers by age group to each household. +#' +#' This function assigns the number of drivers in each age group to each +#' household. It also computes the total number of drivers in the household. +#' +#' @param L A list containing the components listed in the Get specifications +#' for the module. +#' @return A list containing the components specified in the Set +#' specifications for the module. +#' @name AssignDrivers +#' @import visioneval stats +#' @export +AssignDrivers <- function(L) { + + #Set up + #------ + #Fix seed as synthesis involves sampling + set.seed(L$G$Seed) + #Initialize outputs list + Bins_ <- c("15to19", "20to29", "30to54", "55to64", "65Plus") + OutBinNames_ <- paste0("Drv", Bins_) + NumHh <- length(L$Year$Household$HhId) + Out_ls <- initDataList() + for (OutName in OutBinNames_) { + Out_ls$Year$Household[[OutName]] <- rep(0, NumHh) + } + + #Function to make a model dataset for an age bin + #----------------------------------------------- + makeModelDataset <- function(Bin) { + # Make data frame for households that have persons in the age group + Hh_df <- data.frame( + HhId = L$Year$Household$HhId, + Pop = L$Year$Household[[paste0("Age", Bin)]], + Wkr = L$Year$Household[[paste0("Wkr", Bin)]], + stringsAsFactors = FALSE + ) + # Limit to households that have population in the age category + Hh_df <- Hh_df[Hh_df$Pop != 0, ] + # Initialize a person dataset to be used in estimating model + Per_df <- data.frame( + HhId = rep(Hh_df$HhId, Hh_df$Pop), + stringsAsFactors = FALSE + ) + # Add worker assignments + assignWorkers <- function(Pop, Wkr) { + c(rep(1, Wkr), rep(0, Pop - Wkr)) + } + Per_df$Worker <- unlist(mapply(assignWorkers, Hh_df$Pop, Hh_df$Wkr)) + # Add age group + Per_df$AgeGroup <- paste0("Age", Bin) + # Add household attributes + getHhAttribute <- function(AttrName) { + L$Year$Household[[AttrName]][match(Per_df$HhId, L$Year$Household$HhId)] + } + AttrNames_ <- + c("HhSize", "Income", "HouseType", "IsUrbanMixNbrhd", "LocType", "Bzone", "Marea") + for (AttrName in AttrNames_) { + Per_df[[AttrName]] <- getHhAttribute(AttrName) + } + # Add Bzone attributes + Per_df$PopDensity <- + L$Year$Bzone$D1B[match(Per_df$Bzone, L$Year$Bzone$Bzone)] + # Add Marea attributes + Per_df$TranRevMiPC <- + L$Year$Marea$TranRevMiPC[match(Per_df$Marea, L$Year$Marea$Marea)] + # Return the result + Per_df + } + + #Define a function to adjust drivers to match target ratio + #--------------------------------------------------------- + adjustDrivers <- + function(Driver_, DriverProb_, TargetDriverProp) { + NumDriver <- sum(Driver_) + TargetNumDriver <- round(length(Driver_) * TargetDriverProp) + NumDriverChg <- TargetNumDriver - NumDriver + if (NumDriverChg > 0) { + IsChgCandidate_ <- which(Driver_ == 0) + AddDriverIdx_ <- + sample(IsChgCandidate_, NumDriverChg, prob = DriverProb_[IsChgCandidate_]) + Driver_[AddDriverIdx_] <- 1 + } + if (NumDriverChg < 0) { + IsChgCandidate_ <- which(Driver_ == 1) + RmDriverIdx_ <- + sample(IsChgCandidate_, abs(NumDriverChg), prob = 1 - DriverProb_[IsChgCandidate_]) + Driver_[RmDriverIdx_] <- 0 + } + Driver_ + } + + #Assign drivers to households by age bin + #--------------------------------------- + for (Bin in Bins_) { + # Name the bin + BinName <- paste0("Drv", Bin) + # Create model dataset for Bin + Per_df <- makeModelDataset(Bin) + # Initialize a vector to identify drivers (1) and non-drivers (0) + Driver_ <- rep(0, nrow(Per_df)) + # Identify whether person is in an urban location type + IsUrban_ <- Per_df$LocType == "Urban" + # Run metropolitan model for persons in urban areas + if (any(IsUrban_)) { + Driver_[IsUrban_] <- applyBinomialModel( + DriverModel_ls$Metro, + Per_df[IsUrban_,] + ) + } + # Run non-metropolitan model for persons in rural and town areas + if (any(!IsUrban_)) { + Driver_[!IsUrban_] <- applyBinomialModel( + DriverModel_ls$NonMetro, + Per_df[!IsUrban_,] + ) + } + # Get the driver age category adjustment prop + DrvAdjPropName <- paste0("Drv", Bin, "AdjProp") + if (!is.null(L$Year$Region[[DrvAdjPropName]])) { + DrvAdjProp <- L$Year$Region[[DrvAdjPropName]] + } else { + DrvAdjProp <- 1 + } + # If the adjustment prop is not 1, then adjust drivers + if (DrvAdjProp != 1) { + ModelDriverProp <- sum(Driver_) / length(Driver_) + TargetDriverProp <- DrvAdjProp * ModelDriverProp + MaxDrvAdjProp <- 1 / ModelDriverProp + #If the target driver proportion is >= 1 all are drivers and error + if (TargetDriverProp >= 1) { + #Make all persons drivers + Driver_[] <- 1 + #Add error message + Msg <- paste0( + "Error during run of AssignDrivers module! ", + "The value of ", DrvAdjPropName, " will result in ", + round(TargetDriverProp, 3), + " times more drivers than people in that age category. ", + "Reduce the value of ", DrvAdjPropName, + " in the 'region_hh_driver_adjust_prop.csv' input file ", + "to be no greater than ", round(MaxDrvAdjProp, 3), ".") + addErrorMsg("Out_ls", Msg) + rm(Msg) + } else { + DriverProb_ <- rep(0, length(Driver_)) + DriverProb_[IsUrban_] <- applyBinomialModel( + Model_ls = DriverModel_ls$Metro, + Data_df = Per_df[IsUrban_,], + ReturnProbs = TRUE + ) + DriverProb_[!IsUrban_] <- applyBinomialModel( + Model_ls = DriverModel_ls$NonMetro, + Data_df = Per_df[!IsUrban_,], + ReturnProbs = TRUE + ) + Driver_ <- adjustDrivers(Driver_, DriverProb_, TargetDriverProp) + rm(DriverProb_) + } + rm(ModelDriverProp, TargetDriverProp) + } + NumDrivers_Hh <- tapply(Driver_, Per_df$HhId, sum) + HhIdx <- match(names(NumDrivers_Hh), L$Year$Household$HhId) + Out_ls$Year$Household[[BinName]][HhIdx] <- unname(NumDrivers_Hh) + rm(BinName, Per_df, Driver_, IsUrban_, DrvAdjPropName, NumDrivers_Hh, HhIdx) + } + + #Tabulate number of driving age persons in each household + #-------------------------------------------------------- + DrvAgePersons_Hh <- + with(L$Year$Household, + Age15to19 + Age20to29 + Age30to54 + Age55to64 + Age65Plus) + + #Return list of results + #---------------------- + #Calculate total number of drivers by household + Drivers_ <- rowSums(do.call(cbind, Out_ls$Year$Household[OutBinNames_])) + Out_ls$Year$Household$Drivers <- Drivers_ + Out_ls$Year$Household$DrvAgePersons <- DrvAgePersons_Hh + Out_ls +} + + +#=============================================================== +#SECTION 4: MODULE DOCUMENTATION AND AUXILLIARY DEVELOPMENT CODE +#=============================================================== +#Run module automatic documentation +#---------------------------------- +documentModule("AssignDrivers") + +#Test code to check specifications, loading inputs, and whether datastore +#contains data needed to run module. Return input list (L) to use for developing +#module functions +#------------------------------------------------------------------------------- +# #Load packages and test functions +# library(filesstrings) +# library(visioneval) +# library(ordinal) +# source("tests/scripts/test_functions.R") +# #Set up test environment +# TestSetup_ls <- list( +# TestDataRepo = "../Test_Data/VE-State", +# DatastoreName = "Datastore.tar", +# LoadDatastore = TRUE, +# TestDocsDir = "vestate", +# ClearLogs = TRUE, +# # SaveDatastore = TRUE +# SaveDatastore = FALSE +# ) +# setUpTests(TestSetup_ls) +# #Run test module +# TestDat_ <- testModule( +# ModuleName = "AssignDrivers", +# LoadDatastore = TRUE, +# SaveDatastore = TRUE, +# DoRun = FALSE +# ) +# L <- TestDat_$L +# R <- AssignDrivers(L) +# +# #Run test module +# TestDat_ <- testModule( +# ModuleName = "AssignDrivers", +# LoadDatastore = TRUE, +# SaveDatastore = TRUE, +# DoRun = TRUE +# ) diff --git a/sources/modules/VEHouseholdVehicles-old/R/AssignVehicleAge.R b/sources/modules/VEHouseholdVehicles-old/R/AssignVehicleAge.R new file mode 100644 index 000000000..626bd37d7 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/R/AssignVehicleAge.R @@ -0,0 +1,662 @@ +#================== +#AssignVehicleAge.R +#================== +# +# +# +## AssignVehicleAge Module +#### September 7, 2018 +# +#This module assigns vehicle ages to each household vehicle. Vehicle age is assigned as a function of the vehicle type (auto or light truck), household income, and assumed mean vehicle age by vehicle type and Azone. Car service vehicles are assigned an age based on input assumptions with no distinction between vehicle type. +# +### Model Parameter Estimation +# +#The models are estimated using the *Hh_df* (household) and *Veh_df* (vehicle) datasets in the VE2001NHTS package. Information about these datasets and how they were developed from the 2001 National Household Travel Survey public use dataset is included in that package. For each vehicle type (auto, light truck), tabulations are made of cumulative proportions of vehicles by age (i.e. proportion of vehicles less than or equal to the age) and the joint proportion of vehicles by age and income group. For these tabulations, the maximum vehicle age was set at 30 years. This ignores about 1.5% of the vehicle records. +# +#The following figure shows the cumulative proportions of vehicles by vehicle age. +# +# +# +#The following figure compares the age proportions of automobiles by income group. It can be seen that as income decreases, the age distribution shifts towards older vehicles. The 6 income groups are $0 to $20,000, $20,000 to $40,000, $40,000 to $60,000, $60,000 to $80,000, $80,000 to $100,000, $100,000 plus. +# +# +# +#The following figure compares the age proportions of light trucks by income group. As with automobiles, as increases, the age distributions shifts to older vehicles. +# +# +# +### How the Module Works +# +#The module auto and light truck vehicle age distributions which match user inputs for mean auto age and mean light truck age. The module adjusts the cumulative age distribution to match a target mean age. This is done by either expanding the age interval (i.e. a year is 10% longer) if the mean age increases, or compressing the age interval if the mean age decreases. A binary search function is used to determine the amount of expansion or compression of the estimated age distribution is necessary in order to match the input mean age. The age distribution for the vehicles is derived from the adjusted cumulative age distribution. +# +#Once the age distribution for a vehicle type has been determined, the module calculates vehicle age distributions by household income group. It takes marginal distributions of vehicles by age and vehicles by household income group along with a seed matrix of the joint probability distribution of vehicles by age and income group, and then uses iterative proportional fitting to adjust the joint probabilities to match the margins. The age probability by income group is calculated from the joint probability matrix. These probabilities are then used as sampling distributions to determine the age of each household vehicle as a function of the vehicle type and the household income. +# +# + + +#============================================= +#SECTION 1: ESTIMATE AND SAVE MODEL PARAMETERS +#============================================= +#This model predicts vehicle age as a function of the vehicle type, household +#income, and census region the household is located in. It uses a tabulation +#of vehicles from the 2001 NHTS to create two probability tables for each +#vehicle type. The first is a table of the cumulative probability of vehicles by +#age. This table is used in the model to create vehicle age distributions by +#type based on input assumptions regarding the mean vehicle age by type. The +#second tables is the joint probabilities of vehicles by vehicle age and income +#group. + +#Prepare 2001 NHTS data +#---------------------- +#Load 2001 NHTS household and vehicle data +Hh_df <- VE2001NHTS::Hh_df +Veh_df <- VE2001NHTS::Veh_df +#Create a vehicle age variable and cap at 30 years +MaxAge <- 30 +Veh_df$VehAge <- 2002 - Veh_df$Vehyear +Veh_df <- Veh_df[Veh_df$VehAge <= MaxAge,] +#Recode the vehicle type field +Veh_df$Type[Veh_df$Type == "LightTruck"] <- "LtTrk" +#Select fields to keep and join household and vehicle datasets +HhVars_ <- c("Houseid", "Census_r", "Expfllhh", "Expflhhn", "IncGrp") +VehVars_ <- c("Houseid", "Type", "VehAge") +Data_df <- merge(Veh_df[VehVars_], Hh_df[HhVars_], "Houseid") +Data_df <- Data_df[complete.cases(Data_df),] +#Create a weighing variable from the household expansion factor +Data_df$Weight <- Data_df$Expfllhh / 100 +rm(Hh_df, Veh_df, HhVars_, VehVars_) + +#Create joint distributions of vehicles by age and income by type +#---------------------------------------------------------------- +#Tabulate vehicle weights by vehicle age, household income, vehicle type +TotWt_AgIgTy <- + tapply(Data_df$Weight, as.list(Data_df[c("VehAge", "IncGrp", "Type")]), sum) +#Calculate joint distribution of proportion of vehicles by age and income for +#each vehicle type +AgeIncJointProp_AgIgTy <- + sweep(TotWt_AgIgTy, 3, apply(TotWt_AgIgTy, 3, sum), "/") + +#Auto Calculations +#----------------- +AutoAgeIncDF_AgIg <- AgeIncJointProp_AgIgTy[,,"Auto"] +AutoAgeIncDF_AgIg <- + apply(AutoAgeIncDF_AgIg, 2, function(x) { + smooth.spline(0:MaxAge, x, df=8)$y}) +rownames(AutoAgeIncDF_AgIg) <- 0:30 +AutoAgeCDF_Ag <- cumsum(rowSums(AutoAgeIncDF_AgIg)) + +#Light Truck Calculations +#------------------------ +LtTrkAgeIncDF_AgIg <- AgeIncJointProp_AgIgTy[,,"LtTrk"] +LtTrkAgeIncDF_AgIg <- + apply(LtTrkAgeIncDF_AgIg, 2, function(x) { + smooth.spline(0:MaxAge, x, df=8)$y}) +rownames(LtTrkAgeIncDF_AgIg) <- 0:30 +LtTrkAgeCDF_Ag <- cumsum(rowSums(LtTrkAgeIncDF_AgIg)) + +#Document vehicle age proportions +#-------------------------------- +#Cumulate age proportions +png("data/cum_age_props_by_veh-type.png", height = 480, width = 480) +plot(0:30, AutoAgeCDF_Ag, type = "l", xlab = "Vehicle Age (years)", + ylab = "Proportion of Vehicles", + main = "Cumulative Proportion of Vehicles by Age") +lines(0:30, LtTrkAgeCDF_Ag, lty = 2) +legend("bottomright", lty = c(1,2), legend = c("Auto", "Light Truck"), + bty = "n") +dev.off() +#Document auto age proportions by household income group +png("data/auto_age_props_by_inc.png", height = 480, width = 480) +Temp_AgIg <- sweep(AutoAgeIncDF_AgIg, 2, colSums(AutoAgeIncDF_AgIg), "/") +matplot(Temp_AgIg, type = "l", xlab = "Vehicle Age (years)", + ylab = "Proportion of Vehicles", + main = "Proportions of Automobiles by Age by Household Income") +legend("topright", lty = 1:6, col = 1:6, legend = colnames(AutoAgeIncDF_AgIg)) +rm(Temp_AgIg) +dev.off() +#Document light truck age proportions by household income group +png("data/lttrk_age_props_by_inc.png", height = 480, width = 480) +Temp_AgIg <- sweep(LtTrkAgeIncDF_AgIg, 2, colSums(LtTrkAgeIncDF_AgIg), "/") +matplot(Temp_AgIg, type = "l", xlab = "Vehicle Age (years)", + ylab = "Proportion of Vehicles", + main = "Proportions of Light Trucks by Age by Household Income") +legend("topright", lty = 1:6, col = 1:6, legend = colnames(LtTrkAgeIncDF_AgIg)) +rm(Temp_AgIg) +dev.off() + +#Save model parameters in a list +#------------------------------- +VehicleAgeModel_ls <- + list( + Auto = list( + AgeCDF_Ag = AutoAgeCDF_Ag, + AgeIncJointProp_AgIg = AutoAgeIncDF_AgIg + ), + LtTrk = list( + AgeCDF_Ag = LtTrkAgeCDF_Ag, + AgeIncJointProp_AgIg = LtTrkAgeIncDF_AgIg + ) + ) +rm(MaxAge, TotWt_AgIgTy, AgeIncJointProp_AgIgTy, AutoAgeIncDF_AgIg, + AutoAgeCDF_Ag, LtTrkAgeIncDF_AgIg, LtTrkAgeCDF_Ag, Data_df) + +#Save the vehicle age model +#-------------------------- +#' Vehicle age model +#' +#' A list containing the vehicle age model probability tables +#' needed to implement the vehicle age model. +#' +#' @format A list having the following components: +#' \describe{ +#' \item{Auto$AgeCDF_Ag}{a vector of cumulative probability of autos by age} +#' \item{Auto$AgeIncJointProp_AgIg}{a matrix of the joint probability of autos by age and household income} +#' \item{LtTrk$AgeCDF_Ag}{a vector of cumulative probability of light trucks by age} +#' \item{LtTrk$AgeIncJointProp_AgIg}{a matrix of the joint probability of light trucks by age and household income} +#' } +#' @source AssignVehicleAge.R script. +"VehicleAgeModel_ls" +usethis::use_data(VehicleAgeModel_ls, overwrite = TRUE) + + +#================================================ +#SECTION 2: DEFINE THE MODULE DATA SPECIFICATIONS +#================================================ + +#Define the data specifications +#------------------------------ +AssignVehicleAgeSpecifications <- list( + #Level of geography module is applied at + RunBy = "Region", + #Specify new tables to be created by Inp if any + #Specify new tables to be created by Set if any + #Specify input data + Inp = items( + item( + NAME = items( + "AutoMeanAge", + "LtTrkMeanAge" + ), + FILE = "azone_hh_veh_mean_age.csv", + TABLE = "Azone", + GROUP = "Year", + TYPE = "time", + UNITS = "YR", + NAVALUE = -1, + SIZE = 0, + PROHIBIT = c("NA", "< 5", ">= 14"), + ISELEMENTOF = "", + UNLIKELY = "", + TOTAL = "", + DESCRIPTION = items( + "Mean age of automobiles owned or leased by households.", + "Mean age of light trucks owned or leased by households." + ) + ) + ), + #Specify data to be loaded from data store + Get = items( + item( + NAME = "Azone", + TABLE = "Azone", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "AutoMeanAge", + TABLE = "Azone", + GROUP = "Year", + TYPE = "time", + UNITS = "YR", + PROHIBIT = c("NA", "<= 0"), + ISELEMENTOF = "" + ), + item( + NAME = "LtTrkMeanAge", + TABLE = "Azone", + GROUP = "Year", + TYPE = "time", + UNITS = "YR", + PROHIBIT = c("NA", "<= 0"), + ISELEMENTOF = "" + ), + item( + NAME = "Azone", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "HhId", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "Income", + TABLE = "Household", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD.2001", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "Azone", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "HhId", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "NA", + ISELEMENTOF = "" + ), + item( + NAME = "VehId", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "NA", + ISELEMENTOF = "" + ), + item( + NAME = "VehicleAccess", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBIT = "", + ISELEMENTOF = c("Own", "LowCarSvc", "HighCarSvc") + ), + item( + NAME = "Type", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBIT = "NA", + ISELEMENTOF = c("Auto", "LtTrk") + ), + item( + NAME = "AveCarSvcVehicleAge", + TABLE = "Azone", + GROUP = "Year", + TYPE = "time", + UNITS = "YR", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ) + ), + #Specify data to saved in the data store + Set = items( + item( + NAME = "Age", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "time", + UNITS = "YR", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Vehicle age in years" + ) + ) + #Specify call status of module + #Call = TRUE +) + +#Save the data specifications list +#--------------------------------- +#' Specifications list for AssignVehicleAge module +#' +#' A list containing specifications for the AssignVehicleAge module. +#' +#' @format A list containing 5 components: +#' \describe{ +#' \item{NewSetTable}{table to be created} +#' \item{RunBy}{the level of geography that the module is run at} +#' \item{Inp}{model inputs to be saved to the datastore} +#' \item{Get}{module inputs to be read from the datastore} +#' \item{Set}{module outputs to be written to the datastore} +#' } +#' @source AssignVehicleAge.R script. +"AssignVehicleAgeSpecifications" +usethis::use_data(AssignVehicleAgeSpecifications, overwrite = TRUE) + + +#======================================================= +#SECTION 3: DEFINE FUNCTIONS THAT IMPLEMENT THE SUBMODEL +#======================================================= + +#Function to calculate mean vehicle age from cumulative age distribution +#----------------------------------------------------------------------- +#' Calculate mean vehicle age from cumulative age distribution. +#' +#' \code{findMeanAge} calculates mean age from a cumulative age distribution. +#' +#' This function calculates a mean age from a cumulative age distribution vector +#' where the values of the vector are the cumulative proportions and the names +#' of the vector are the vehicle ages from 0 to 30 years. +#' +#' @param AgeCDF_Ag A named numeric vector where the names are vehicle ages and +#' the values are the proportion of vehicles that age or younger. The names must +#' be an ordered sequence from 0 to 30. +#' @return A numeric value that is the mean vehicle age. +#' @name findMeanAge +#' @export +#' +findMeanAge <- function(AgeCDF_Ag) { + Ages_ <- as.numeric(names(AgeCDF_Ag)) + AgeProp_Ag <- c(AgeCDF_Ag[1], diff(AgeCDF_Ag)) + sum(AgeProp_Ag * Ages_) +} + +#Function to adjust cumulative age distribution to match target mean +#------------------------------------------------------------------- +#' Adjust cumulative age distribution to match target mean. +#' +#' \code{adjustAgeDistribution} Adjusts a cumulative age distribution to match a +#' target mean age. +#' +#' This function adjusts a cumulative age distribution to match a target mean +#' age. The function returns the adjusted cumulative age distribution and the +#' corresponding age distribution. If no target mean value is specified, the +#' function returns the input cumulative age distribution and the corresponding +#' age distribution for that input. +#' +#' @param AgeCDF_Ag A named numeric vector where the names are vehicle ages and +#' the values are the proportion of vehicles that age or younger. The names must +#' be an ordered sequence from 0 to 30. +#' @param TargetMean A number that is the target mean value. +#' @return A numeric value that is the mean vehicle age. +#' @name adjustAgeDistribution +#' @export +#' +adjustAgeDistribution <- function(AgeCDF_Ag, TargetMean = NULL) { + #Vector of vehicle ages + Ages_ <- as.numeric(names(AgeCDF_Ag)) + if (!all.equal(Ages_, 0:30)) { + Msg <- paste0( + "Errors in names of AgeCDF_Ag. ", + "Function expects names to be an ordered sequence from 0 to 30." + ) + stop(Msg) + } + #Calculate the mean age for the input distribution + DistMean <- findMeanAge(AgeCDF_Ag) + #Define a function to calculate adjusted distribution + calcAdjDist <- function(Shift) { + CumShift_ <- cumsum(rep(Shift, 31)) + AdjAges_ <- CumShift_ + Ages_ + AdjCDF_Ag <- + predict(smooth.spline(AdjAges_, AgeCDF_Ag), Ages_)$y + names(AdjCDF_Ag) <- Ages_ + AdjCDF_Ag / max(AdjCDF_Ag) + } + #Define a function to check the mean age (function sent to binary search) + checkMeanAge <- function(Shift) { + findMeanAge(calcAdjDist(Shift)) + } + #Calculate adjusted age distribution + if (is.null(TargetMean)) { + Result_ls <- + list(CumDist = AgeCDF_Ag, + Dist = c(AgeCDF_Ag[1], diff(AgeCDF_Ag))) + } else { + FoundShift <- + binarySearch(checkMeanAge, c(-0.75, 1), Target = TargetMean) + AdjCumDist_ <- calcAdjDist(FoundShift) + Result_ls <- + list(CumDist = AdjCumDist_, + Dist = c(AdjCumDist_[1], diff(AdjCumDist_))) + } + Result_ls +} + +#Function which calculates vehicle age distributions by income group +#------------------------------------------------------------------- +#' Calculate vehicle age distributions by income group. +#' +#' \code{calcAgeDistributionByInc} Calculates vehicle age distributions by +#' household income group. +#' +#' This function calculates vehicle age distributions by household income group. +#' It takes marginal distributions of vehicles by age and vehicles by household +#' income group along with a seed matrix of the joint probability distribution +#' of vehicles by age and income group, and then uses iterative proportional +#' fitting to adjust the joint probabilities to match the margins. The +#' probabilities by income group are calculated from the fitted joint +#' probability matrix. The seed matrix is the joint age and income distribution +#' for autos or light trucks in the VehicleAgeModel_ls (AgeIncJointProp_AgIg). +#' The age margin is the proportional distribution of vehicles by age calculated +#' by adjusting the cumulative age distribution for autos or light trucks in the +#' VehicleAgeModel_ls (AgeCDF_AgTy) to match a target mean age. The income +#' margin is the proportional distribution of vehicles by household income group +#' ($0-20K, $20K-40K, $40K-60K, $60K-80K, $80K-100K, $100K or more) calculated +#' from the modeled household values. +#' +#' @param Seed_AgIg A numeric matrix of the joint probabilities of vehicles +#' by age and income group. +#' @param Margin_Ag A numeric vector of vehicle age probabilities. +#' @param Margin_Ig A numeric vector of vehicle household income probabilities. +#' @param MaxIter A numeric value specifying the maximum number of iterations +#' the iterative proportional fitting process will undertake. +#' @param Closure A numeric value specifying the maximum allowed difference +#' between any margin value and corresponding sum of values of the joint +#' probability matrix. +#' @return A numeric value that is the mean vehicle age. +#' @name calcAgeDistributionByInc +#' @export +#' +calcAgeDistributionByInc <- + function(Seed_AgIg, Margin_Ag, Margin_Ig, MaxIter=100, Closure=0.0001) { + #Replace margin values of zero with 0.0001 + if (any(Margin_Ag == 0)) { + Margin_Ag[Margin_Ag == 0] <- 0.0001 + } + if (any(Margin_Ig == 0)) { + Margin_Ig[Margin_Ig == 0] <- 0.0001 + } + #Make sure sum of each margin is equal to 1 + Margin_Ag <- Margin_Ag * (1 / sum(Margin_Ag)) + Margin_Ig <- Margin_Ig * (1 / sum(Margin_Ig)) + # Set initial values + VehAgIgProp_AgIg <- Seed_AgIg + Iter <- 0 + MarginChecks <- c(1, 1) + #Iteratively proportion matrix until closure or iteration criteria are met + while((any(MarginChecks > Closure)) & (Iter < MaxIter)) { + Sums_Ag <- rowSums(VehAgIgProp_AgIg) + Coeff_Ag <- Margin_Ag / Sums_Ag + VehAgIgProp_AgIg <- sweep(VehAgIgProp_AgIg, 1, Coeff_Ag, "*") + MarginChecks[1] <- max(abs(1 - Coeff_Ag)) + Sums_Ig <- colSums(VehAgIgProp_AgIg) + Coeff_Ig <- Margin_Ig / Sums_Ig + VehAgIgProp_AgIg <- sweep(VehAgIgProp_AgIg, 2, Coeff_Ig, "*") + MarginChecks[2] <- max(abs(1 - Coeff_Ig)) + Iter <- Iter + 1 + } + #Return the age proportions by income group + sweep(VehAgIgProp_AgIg, 2, colSums(VehAgIgProp_AgIg), "/") + } + +#Main module function to create and populate vehicle table of types and ages +#--------------------------------------------------------------------------- +#' Create vehicle table and populate with vehicle type and age records. +#' +#' \code{AssignVehicleAge} create the vehicle table and populate with vehicle +#' age and type records. +#' +#' This function creates the 'Vehicle' table in the datastore and populates it +#' with records of vehicle types and ages along with household IDs. +#' +#' @param L A list containing the components listed in the Get specifications +#' for the module. +#' @return A list containing the components specified in the Set +#' specifications for the module. +#' @name AssignVehicleAge +#' @import visioneval +#' @export +#' +AssignVehicleAge <- function(L) { + #Set up + #------ + #Fix seed as synthesis involves sampling + set.seed(L$G$Seed) + #Create index to match household records with vehicle records + HhToVehIdx_Ve <- match(L$Year$Vehicle$HhId, L$Year$Household$HhId) + + #Create an income group datase + #----------------------------- + Ig <- c("0to20K", "20Kto40K", "40Kto60K", "60Kto80K", "80Kto100K", "100KPlus") + L$Year$Vehicle$IncGrp <- + as.character( + with(L$Year$Household, + cut(Income, + breaks = c(c(0, 20, 40, 60, 80, 100) * 1000, max(Income)), + labels = Ig, + include.lowest = TRUE))[HhToVehIdx_Ve] + ) + + #Iterate by Azone and assign vehicle age + #--------------------------------------- + NumVeh <- length(L$Year$Vehicle$VehId) + Age_Ve <- rep(NA, NumVeh) + names(Age_Ve) <- L$Year$Vehicle$VehId + Az <- L$Year$Azone$Azone + for (az in Az) { + #Create owned vehicle data frame + UseOwn <- with(L$Year$Vehicle, Azone == az & VehicleAccess == "Own") + AutoMeanAge <- with(L$Year$Azone, AutoMeanAge[Azone == az]) + LtTrkMeanAge <- with(L$Year$Azone, LtTrkMeanAge[Azone == az]) + #Create data frame of data to use + Fields_ <- c("VehId", "Type", "IncGrp") + Own_df <- + data.frame(lapply(L$Year$Vehicle[Fields_], function(x) x[UseOwn]), stringsAsFactors = FALSE) + Own_df$Age <- NA + #Calculate income group proportions by vehicle type + NumVeh_IgTy <- with(Own_df, table(IncGrp, Type)) + IncProp_IgTy <- sweep(NumVeh_IgTy, 2, colSums(NumVeh_IgTy), "/") + #Calculate cumulative age distributions by type + AutoAgeProp_Ag <- + adjustAgeDistribution( + VehicleAgeModel_ls$Auto$AgeCDF_Ag, + AutoMeanAge)$Dist + LtTrkAgeProp_Ag <- + adjustAgeDistribution( + VehicleAgeModel_ls$LtTrk$AgeCDF_Ag, + LtTrkMeanAge)$Dist + #Calculate age distributions by income group + AutoAgePropByInc_AgIg <- + calcAgeDistributionByInc( + VehicleAgeModel_ls$Auto$AgeIncJointProp_AgIg, + AutoAgeProp_Ag, + IncProp_IgTy[,"Auto"] + ) + LtTrkAgePropByInc_AgIg <- + calcAgeDistributionByInc( + VehicleAgeModel_ls$LtTrk$AgeIncJointProp_AgIg, + LtTrkAgeProp_Ag, + IncProp_IgTy[,"LtTrk"] + ) + #Assign ages for automobiles + for (ig in Ig) { + Ages_ <- + sample( + 0:30, + NumVeh_IgTy[ig, "Auto"], + replace = TRUE, + prob = AutoAgePropByInc_AgIg[,ig]) + Own_df$Age[Own_df$IncGrp == ig & Own_df$Type == "Auto"] <- Ages_ + } + #Assign ages for light trucks + for (ig in Ig) { + Ages_ <- + sample( + 0:30, + NumVeh_IgTy[ig, "LtTrk"], + replace = TRUE, + prob = LtTrkAgePropByInc_AgIg[,ig]) + Own_df$Age[Own_df$IncGrp == ig & Own_df$Type == "LtTrk"] <- Ages_ + } + #Add vehicle age for owned vehicles in Azone + Age_Ve[Own_df$VehId] <- Own_df$Age + #Add car service average vehicle age + CarSvcAge <- with(L$Year$Azone, AveCarSvcVehicleAge[Azone == az]) + CarSvcVehId_ <- + with(L$Year$Vehicle, VehId[Azone == az & VehicleAccess != "Own"]) + Age_Ve[CarSvcVehId_] <- CarSvcAge + } + + #Return the results + #------------------ + #Initialize output list + Out_ls <- initDataList() + Out_ls$Year$Vehicle$Age <- unname(Age_Ve) + #Return the outputs list + Out_ls +} + + +#=============================================================== +#SECTION 4: MODULE DOCUMENTATION AND AUXILLIARY DEVELOPMENT CODE +#=============================================================== +#Run module automatic documentation +#---------------------------------- +documentModule("AssignVehicleAge") + +#Test code to check specifications, loading inputs, and whether datastore +#contains data needed to run module. Return input list (L) to use for developing +#module functions +#------------------------------------------------------------------------------- +# #Load packages and test functions +# library(filesstrings) +# library(visioneval) +# library(ordinal) +# source("tests/scripts/test_functions.R") +# #Set up test environment +# TestSetup_ls <- list( +# TestDataRepo = "../Test_Data/VE-RSPM", +# DatastoreName = "Datastore.tar", +# LoadDatastore = TRUE, +# TestDocsDir = "verspm", +# ClearLogs = TRUE, +# # SaveDatastore = TRUE +# SaveDatastore = FALSE +# ) +# setUpTests(TestSetup_ls) +# #Run test module +# TestDat_ <- testModule( +# ModuleName = "AssignVehicleAge", +# LoadDatastore = TRUE, +# SaveDatastore = FALSE, +# DoRun = FALSE +# ) +# L <- TestDat_$L +# R <- AssignVehicleAge(L) +# +# TestDat_ <- testModule( +# ModuleName = "AssignVehicleAge", +# LoadDatastore = TRUE, +# SaveDatastore = TRUE, +# DoRun = TRUE +# ) diff --git a/sources/modules/VEHouseholdVehicles-old/R/AssignVehicleFeatures.R b/sources/modules/VEHouseholdVehicles-old/R/AssignVehicleFeatures.R new file mode 100644 index 000000000..0d26e0729 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/R/AssignVehicleFeatures.R @@ -0,0 +1,1892 @@ +#======================== +#AssignVehicleFeatures.R +#======================== + +# This module is a vehicle model from RPAT version. + +# This module assigns household vehicle ownership, vehicle types, and ages to +# each household vehicle, based on household, land use, +# and transportation system characteristics. Vehicles are classified as either +# a passenger car (automobile) or a light truck (pickup trucks, sport utility +# vehicles, vans, etc.). A 'Vehicle' table is created which has a record for +# each household vehicle. The type and age of each vehicle owned or leased by +# households is assigned to this table along with the household ID (HhId)to +# enable this table to be joined with the household table. + + +# library(visioneval) + + +#============================================= +#SECTION 1: ESTIMATE AND SAVE MODEL PARAMETERS +#============================================= + +## Current implementation +### The current version implements the models used in the RPAT (GreenSTEP) +### ecosystem. + + + +## Future Development +## Use estimation data set to create models + + +#Create a list to store models +#----------------------------- +VehOwnModels_ls <- + list( + Metro = list(), + NonMetro = list() + ) + +#Model metropolitan households +#-------------------------------- + +#Model number of vehicles of zero vehicle households +VehOwnModels_ls$Metro$ZeroVeh <- list( + Drv1 = "-0.683066027512409 * Intercept + -0.000110405079404259 * Income + 0.000109523364706169 * Htppopdn + -0.0362183493862117 * TranRevMiPC + 1.02639925083899 * Urban + 9.06402787257681e-10 * Income * Htppopdn + 9.50409353343535e-07 * Income * TranRevMiPC + 1.97250624441449e-05 * Income * Urban + 9.62725737852278e-07 * Htppopdn * TranRevMiPC + -5.50575031443288e-05 * Htppopdn * Urban + -0.000119303596393078 * Htppopdn * FwyLaneMiPC + 0.0576992095172837 * TranRevMiPC * FwyLaneMiPC", + Drv2 = "-1.4293517976947 * Intercept + -6.79093838399447e-05 * Income + 1.41665886075373e-09 * Income * Htppopdn + -3.55383842559826e-05 * Income * OnlyElderly + 1.8466993140076e-06 * Htppopdn * TranRevMiPC", + Drv3Plus = "-3.49217773065969 * Intercept + -4.90381809989654e-05 * Income + 9.71850941935639e-05 * Htppopdn + 7.30707905255008e-10 * Income * Htppopdn + 0.0755278977577806 * TranRevMiPC * FwyLaneMiPC" +) + + +#Model number of vehicles of non-zero vehicle households +VehOwnModels_ls$Metro$Lt1Veh <- list( + Drv1 = "", + Drv2 = "-0.262626375528877 * Intercept + -4.58681084909702e-05 * Income + 5.64785771813055e-05 * Htppopdn + 1.73603587364938 * OnlyElderly + 1.1917191888469e-09 * Income * Htppopdn + 3.34293693717104e-07 * Income * TranRevMiPC + 9.3557681020969e-06 * Income * OnlyElderly + -1.42790321639082e-06 * Htppopdn * TranRevMiPC + -4.75313220359081e-05 * Htppopdn * Urban + -2.71105219349876e-05 * Htppopdn * OnlyElderly + 0.0294466696415345 * TranRevMiPC * Urban + -0.0128985388647686 * OnlyElderly * TranRevMiPC + -1.3804854873109 * OnlyElderly * FwyLaneMiPC", + Drv3Plus = "0.933669750357049 * Intercept + -1.83215625824184e-05 * Income + 5.20539935712135 * OnlyElderly + 1.66132852613514e-07 * Income * TranRevMiPC + 1.3111834256491e-05 * Income * Urban + -0.000120261225684946 * Income * OnlyElderly + -4.89311638774344e-05 * Urban * Htppopdn + 8.93280811716929e-05 * Htppopdn * FwyLaneMiPC + -0.689141713914993 * Urban * FwyLaneMiPC" +) + +VehOwnModels_ls$Metro$Eq1Veh <- list( + Drv1 = "0.622159878280685 * Intercept + 0.0232811570547427 * TranRevMiPC + 1.13264996954536e-09 * Income * Htppopdn + -2.76056054149383e-07 * TranRevMiPC * Income + 7.20250709137754e-06 * Income * OnlyElderly + -1.66385909721084e-06 * TranRevMiPC * Htppopdn + -4.53660587597949e-05 * Htppopdn * Urban + 4.08259184719694e-05 * Htppopdn * FwyLaneMiPC + -0.00775538966573374 * TranRevMiPC * OnlyElderly", + Drv2 = "0.153082400390944 * Intercept + 5.78895700138807e-06 * Income + 4.02264718027797e-05 * Htppopdn + -0.381431776917538 * Urban + -0.554254682651229 * OnlyElderly + 2.40943544880577e-10 * Income * Htppopdn + 8.177337031634e-06 * Income * Urban + 7.11276258043345e-06 * Income * OnlyElderly + -1.79078088259691e-06 * Htppopdn * TranRevMiPC + -4.94241128932145e-05 * Htppopdn * Urban", + Drv3Plus = "-1.27880272409382 * Intercept + 7.91127896877896e-06 * Income + -5.76306938765975e-05 * Htppopdn + 5.38360019771969e-10 * Income * Htppopdn + -0.020367512046482 * TranRevMiPC * Urban" +) + +VehOwnModels_ls$Metro$Gt1Veh <- list( + Drv1 = "-1.74721412860086 * Intercept + 1.60836795971674e-05 * Income + -5.67320500238617e-05 * Htppopdn + -1.02035843794378 * OnlyElderly + -1.18456725053079e-06 * Htppopdn * TranRevMiPC + 4.53069297238042e-05 * Htppopdn * Urban + -0.945719667714273 * Urban * FwyLaneMiPC + 1.10732632310419 * OnlyElderly * FwyLaneMiPC", + Drv2 = "-1.96276543220691 * Intercept + 7.56898242720771e-06 * Income + 0.763451405045493 * FwyLaneMiPC + -0.664923337309273 * OnlyElderly + 5.78135381384015e-10 * Income * Htppopdn + -1.26532421138555e-06 * Htppopdn * TranRevMiPC + 2.86474240245699e-05 * Htppopdn * Urban + -0.000155933456154834 * FwyLaneMiPC * Htppopdn + -0.0227377982023876 * TranRevMiPC * Urban", + Drv3Plus = "-1.00067958301458 * Intercept + -0.000301228344551957 * Htppopdn + -0.0128522840241981 * TranRevMiPC + 2.2049921814377e-09 * Htppopdn * Income" +) + + +#Model nonmetropolitan households +#-------------------------------- +#Model number of vehicles of zero vehicle households +VehOwnModels_ls$NonMetro$ZeroVeh <- list( + Drv1 = "-0.764715628588422 * Intercept + -9.48827446956255e-05 * Income + 5.58814902852511e-05 * Htppopdn + 1.55132601403919e-09 * Income * Htppopdn + 3.4451381859651e-05 * Htppopdn * OnlyElderly", + Drv2 = "-1.97205206585201 * Intercept + -8.50026389808778e-05 * Income + 9.49295735533233e-05 * Htppopdn + -0.750964480544973 * OnlyElderly + 6.90609260578997e-05 * Htppopdn * OnlyElderly", + Drv3Plus = "-3.18298947122106 * Intercept + -4.99724157628643e-05 * Income + 0.000133417162883283 * Htppopdn" +) + + +#Model number of vehicles of non-zero vehicle households +VehOwnModels_ls$NonMetro$Lt1Veh <- list( + Drv1 = "", + Drv2 = "-0.413852820133151 * Intercept + -3.93168014848633e-05 * Income + 4.70561991697599e-05 * Htppopdn + 0.303576772835546 * OnlyElderly + 9.67749108418644e-10 * Income * Htppopdn + 1.53896829737995e-05 * Income * OnlyElderly", + Drv3Plus = "0.481480595107626 * Intercept + -1.26210114521176e-05 * Income + 9.04571259805652e-05 * Htppopdn + 1.8315332036188 * OnlyElderly" +) + +VehOwnModels_ls$NonMetro$Eq1Veh <- list( + Drv1 = "0.97339495471904 * Intercept + -9.71792328180977e-06 * Income + -2.84379049251932e-05 * Htppopdn + 0.254612141830117 * OnlyElderly + 1.49373110013838e-09 * Income * Htppopdn + 6.46030086496407e-06 * Income * OnlyElderly + -2.75839770071071e-05 * Htppopdn * OnlyElderly", + Drv2 = "0.244148864158161 * Intercept + 2.21438456787939e-06 * Income + -5.87127032906745e-05 * Htppopdn + -0.362435899095522 * OnlyElderly + 1.28716650265866e-09 * Income * Htppopdn + 7.83539837773637e-06 * Income * OnlyElderly + -5.57742722741945e-05 * Htppopdn * OnlyElderly", + Drv3Plus = "-1.08784722177374 * Intercept + 7.31474110901786e-06 * Income + -5.23190355127079e-05 * Htppopdn" +) + +VehOwnModels_ls$NonMetro$Gt1Veh <- list( + Drv1 = "-1.50974586088385 * Intercept + 1.97797131824946e-05 * Income + -0.000101101429017305 * Htppopdn + -0.502532799087163 * OnlyElderly + -8.9312428414856e-05 * Htppopdn * OnlyElderly", + Drv2 = "-1.2918177391397 * Intercept + 9.12997143307265e-06 * Income + -0.000127456736295507 * Htppopdn + -0.588810459958171 * OnlyElderly + -6.49054938175107e-05 * Htppopdn * OnlyElderly", + Drv3Plus = "-1.89372144360687 * Intercept + 1.03322804417105e-05 * Income + -0.000128048150374047 * Htppopdn" +) + +VehOwnModels_ls$Lt1Prop <- list(Region = c("Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro"), + DrvAgePop = c(2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, + 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, + 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10), + NumVeh = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, + 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, + 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, + 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, + 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, + 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, + 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, + 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 1, 2, 3, 4, 5, 6, 7, + 8, 9), + Prob = c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0.183231171, 0.816768829, 0, 0, 0, + 0, 0, 0, 0, 0.12420466, 0.268025187, 0.607770154, 0, 0, 0, 0, + 0, 0, 0.096819919, 0.201427563, 0.339206509, 0.36254601, 0, 0, + 0, 0, 0, 0.092307692, 0.131405437, 0.263930806, 0.390372785, + 0.12198328, 0, 0, 0, 0, 0, 0.112268915, 0.156849382, 0.309075249, + 0.421806454, 0, 0, 0, 0, 0, 0, 0.117035892, 0.161650327, + 0.314736954, 0.406576827, 0, 0, 0, 0, 0, 0, 0.120445326, + 0.165084054, 0.318786314, 0.395684306, 0, 0, 0, 0, 0, 0, + 0.123004839, 0.167661805, 0.321826229, 0.387507127, 0, 1, 0, 0, + 0, 0, 0, 0, 0, 0, 0.16946333, 0.83053667, 0, 0, 0, 0, 0, 0, 0, + 0.136026313, 0.256328159, 0.607645528, 0, 0, 0, 0, 0, 0, + 0.039726027, 0.233880892, 0.34112275, 0.385270332, 0, 0, 0, 0, 0, + 0.04, 0.056, 0.323977401, 0.416610169, 0.163412429, 0, 0, 0, 0, + 0, 0.050882254, 0.069963099, 0.400994203, 0.478160444, 0, 0, 0, + 0, 0, 0, 0.052920317, 0.071971631, 0.410114516, 0.464993537, 0, 0, + 0, 0, 0, 0, 0.054372218, 0.073402494, 0.41661176, 0.455613528, 0, + 0, 0, 0, 0, 0, 0.055459041, 0.074473569, 0.421475284, 0.448592106, 0)) + + +VehOwnModels_ls$Gt1Prop <- list(Region = c("Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", "Metro", + "Metro", "Metro", "Metro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro", "NonMetro", "NonMetro", "NonMetro", + "NonMetro", "NonMetro"), + DrvAgePop = c(1, 1, 1, 1, 1,1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, + 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, + 8, 8, 8, 8, 8, 8, 8, 8, 8, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10), + NumVeh = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 1, 2, 3, 4, 5, + 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, + 11, 12, 13, 14, 15, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, + 15, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 1, 2, 3, 4, + 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 1, 2, 3, 4, 5, 6, 7, 8, 9, + 10, 11, 12, 13, 14, 15, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, + 14, 15, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 1, 2, 3, + 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 1, 2, 3, 4, 5, 6, 7, 8, 9, + 10, 11, 12, 13, 14, 15, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, + 14, 15, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 1, 2, 3, + 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 1, 2, 3, 4, 5, 6, 7, 8, + 9, 10, 11, 12, 13, 14, 15, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, + 13, 14, 15, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 1, + 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 1, 2, 3, 4, 5, 6, + 7, 8, 9, 10, 11, 12, 13, 14, 15, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, + 12, 13, 14, 15), + Prob = c(0, 0.775279374, 0.162294427, 0.052671587, 0.005884979, 0.003869632, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.757435732, 0.171245803, 0.047837229, + 0.018166133, 0.005315104, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.739651341, + 0.180167454, 0.043018924, 0.030406505, 0.006755776, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0.721925907, 0.18905953, 0.038216592, 0.042606299, + 0.008191672, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.704259138, 0.197922177, + 0.033430153, 0.054765717, 0.009622816, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0.686650742, 0.206755539, 0.02865953, 0.066884958, 0.011049231, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.669100431, 0.215559764, 0.023904644, + 0.078964221, 0.01247094, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0.651607918, 0.224334993, 0.019165417, 0.091003704, 0.013887968, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0.634172918, 0.233081371, 0.014441772, + 0.103003603, 0.015300337, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.616795147, + 0.24179904, 0.009733631, 0.114964113, 0.016708069, 0, 0.730629429, + 0.19399416, 0.046990461, 0.018239586, 0.010146364, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0.705375095, 0.197029044, 0.066418387, 0.021235067, + 0.009942406, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.679876149, 0.200093323, + 0.086034492, 0.024259563, 0.009736473, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0.654129018, 0.203187428, 0.105841523, 0.027313496, 0.009528535, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.628130062, 0.206311795, 0.12584228, 0.0303973, + 0.009318563, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.601875569, 0.20946687, + 0.14603962, 0.033511413, 0.009106528, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0.575361751, 0.21265311, 0.166436456, 0.036656285, 0.008892398, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.548584749, 0.215870977, 0.187035758, + 0.039832374, 0.008676143, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.521540622, + 0.219120945, 0.207840555, 0.043040148, 0.00845773, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0.494225356, 0.222403496, 0.228853938, 0.046280082, + 0.008237128)) + +VehOwnModels_ls$VehAgeCumProp <- list( + VehAge = c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, + 25, 26, 27, 28, 29, 30, 31, 32), + AutoCumProp = c(0.00724546108586627, 0.0633739867828944, 0.119650972204074, 0.17611122166644, + 0.232667582964325, 0.289199954803858, 0.345617046159784, 0.401737816752557, + 0.457237242995719, 0.511652012961637, 0.564438982852735, 0.615095740239273, + 0.663196422706258, 0.708413717884405, 0.750527299266295, 0.789346447215604, + 0.824733327139707, 0.856591128291726, 0.884862169633443, 0.909512678464861, + 0.930571533414323, 0.948161069415711, 0.962492561634571, 0.973843661565155, + 0.982540832889983, 0.98894634671769, 0.993442489536914, 0.996413562605098, + 0.998226715786565, 0.999219121039642, 0.999694273408949, 0.999897830319654, + 1), + LtTruckCumProp = c(0, 0.048277482736719, 0.107670020148356, 0.167527807358529, 0.227700646451007, + 0.287846652232274, 0.347541228736457, 0.406363143639488, 0.463882006009692, + 0.519622882139033, 0.573035876335912, 0.62356258341566, 0.670766808493439, + 0.71433657362547, 0.754117353917857, 0.790045820369363, 0.82214023489062, + 0.850562311494895, 0.875613461230561, 0.897628382073419, 0.916911315076227, + 0.933705656901347, 0.948213197450025, 0.960581641231327, 0.970894255427227, + 0.979229359810599, 0.985708983591426, 0.99053128989766, 0.993954610499349, + 0.996282138540566, 0.997858849151264, 0.99901290898164, 1)) + +VehOwnModels_ls$VehAgeTypeProp <- list( + VehAge = c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 0, 1, 2, 3, 4, 5, 6, 7, 8, + 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, + 28, 29, 30, 31, 32, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 0, 1, + 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, + 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, + 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, + 30, 31, 32, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, + 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 0, 1, 2, 3, 4, + 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, + 25, 26, 27, 28, 29, 30, 31, 32, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, + 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, + 32, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, + 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 0, 1, 2, 3, 4, 5, 6, 7, + 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, + 27, 28, 29, 30, 31, 32, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, + 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 0, + 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, + 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32), + IncGrp = c("0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", + "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", + "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", + "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", + "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "20Kto40K", + "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", + "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", + "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", + "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", + "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", + "20Kto40K", "20Kto40K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", + "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", + "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", + "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", + "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", + "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "60Kto80K", + "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", + "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", + "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", + "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", + "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", + "60Kto80K", "60Kto80K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", + "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", + "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", + "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", + "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", + "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "100KPlus", + "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", + "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", + "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", + "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", + "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", + "100KPlus", "100KPlus", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", + "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", + "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", + "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", + "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", "0to20K", + "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", + "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", + "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", + "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", + "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", "20Kto40K", + "20Kto40K", "20Kto40K", "20Kto40K", "40Kto60K", "40Kto60K", "40Kto60K", + "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", + "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", + "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", + "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", + "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", "40Kto60K", + "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", + "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", + "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", + "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", + "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", "60Kto80K", + "60Kto80K", "60Kto80K", "60Kto80K", "80Kto100K", "80Kto100K", "80Kto100K", + "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", + "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", + "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", + "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", + "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", "80Kto100K", + "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", + "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", + "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", + "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", + "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", "100KPlus", + "100KPlus", "100KPlus", "100KPlus"), + VehType = c("Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", "Auto", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", + "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck", "LtTruck"), + Prop = c(0.000689072418377973, 0.00544718672262607, 0.005573820659, 0.00585448452531851, + 0.00622764779157281, 0.00663688404144811, 0.00707275808142761, 0.00753381782978767, + 0.00802094057368739, 0.00852243254487315, 0.00899898461766469, 0.00939565546417493, + 0.00965283760217326, 0.00972982281734327, 0.00961575904600694, 0.00931081773253509, + 0.00884747097809898, 0.00826948080813357, 0.00761973701780499, 0.00694496549095473, + 0.0062614006265815, 0.00554210815999331, 0.00473226538269605, 0.00379957776442596, + 0.00279556279083542, 0.0018549655573974, 0.00111250396673203, 0.000615524709362564, + 0.000327306801354976, 0.000151632625162581, 8.44419095554236e-05, + 3.90822402062035e-05, 2.15289324199488e-05, 0.00154477949197307, 0.0119987272716887, + 0.0120600755118829, 0.0121646829184045, 0.0122733615086917, + 0.0123779523758167, 0.0125107524604092, 0.0126924853138579, + 0.0129240178443009, 0.0131728701987043, 0.0133690115413486, + 0.0134343150707507, 0.0132989312713844, 0.0129288951138399, + 0.0123322075873495, 0.0115264157581094, 0.0105562553545474, + 0.00946996011443553, 0.00830690496406319, 0.00710811637147281, + 0.00591167080366636, 0.00476543997464743, 0.00373282850817056, + 0.00287377764242896, 0.00221187342627564, 0.00171484583605701, + 0.00131690805009472, 0.000966385624679437, 0.00063560033659038, + 0.000313561345913695, 0.000163899715492605, 6.71530330193876e-05, + 3.1484585411017e-05, 0.0014644798767914, 0.0114933927882837, + 0.0116778235722275, 0.0120721385160842, 0.0125639651049267, + 0.0130264242861832, 0.0133703278273087, 0.013498895260568, + 0.0133439442312416, 0.0128939771165672, 0.0122025703260565, + 0.0113761102307059, 0.0105146070553252, 0.00968242909110126, + 0.00890220388122561, 0.00814868505520557, 0.00738623207838935, + 0.00657879516245823, 0.00570302755733387, 0.00476850085541675, + 0.00381884743407404, 0.00293037693692254, 0.00218749705203173, + 0.00163594775781987, 0.00125407757378175, 0.000974727158501654, + 0.000739376190271886, 0.000529056875051061, 0.000343368611644409, + 0.000173260045179539, 9.65481203738654e-05, 4.3329730301833e-05, + 2.2964896572695e-05, 0.00095417537936037, 0.00739518459593728, + 0.00741659342440686, 0.00744016137343708, 0.00744009365088951, + 0.00739962695884749, 0.00731008734034471, 0.00715166139179415, + 0.0069061326803548, 0.00656834630151501, 0.00615413299844917, + 0.00570133921654266, 0.00524858661736029, 0.0048254379474942, + 0.00444806762402621, 0.00411079009667912, 0.00379849897082272, + 0.00348539682537693, 0.0031401395345377, 0.00274094339102433, + 0.00227996792618167, 0.00177475062033578, 0.0012732143806921, + 0.000837570514917397, 0.000512673368711242, 0.000303525969365387, + 0.00018173024434768, 0.000111143512905326, 6.68194523435672e-05, + 3.30276458640684e-05, 1.85330500377375e-05, 8.46599671831481e-06, + 4.59293402964135e-06, 0.00106559084677346, 0.00821084871497576, + 0.00818777052670301, 0.00811076753095241, 0.00798350743039848, + 0.00782354863335691, 0.00763909953395199, 0.00740956224350541, + 0.00709949684423723, 0.00667771425731305, 0.00613737118201954, + 0.00550714773842063, 0.00483255530570131, 0.00416191162287883, + 0.00353630330958244, 0.00297960594794979, 0.00250487872305621, + 0.0021152748409312, 0.00180497501618103, 0.00156400598931214, + 0.00138303727359732, 0.00125318111310512, 0.00116072568039656, + 0.0010806589390157, 0.000980050017070183, 0.000834526539526742, + 0.00064711044025921, 0.000447898599864268, 0.000268568591526738, + 0.00012050860482331, 5.79458874188376e-05, 2.22645280338573e-05, + 9.78316728219075e-06, 0.00152736007753238, 0.0115831631604587, + 0.0113608799969323, 0.0108179945806139, 0.0100677681679991, + 0.00926792052077688, 0.00851405378515784, 0.00783433901695236, + 0.00720488754575223, 0.00657942635233526, 0.00592489960032226, + 0.00524219359475168, 0.00455317175975956, 0.00388880834088468, + 0.00327905154750631, 0.00274284603155715, 0.00229355682243919, + 0.00193890613349032, 0.00167888556238174, 0.00150532505468082, + 0.00140001207333737, 0.00133066209866674, 0.00125369100566968, + 0.00113018389787124, 0.000948730108133019, 0.000732390519008171, + 0.000520808229420525, 0.000343924963271416, 0.000208741011034989, + 0.000100417130507469, 5.37837458633503e-05, 2.32614140023132e-05, + 1.18151840190084e-05, 3.8077810976786e-06, 0.00203680796025813, + 0.00275317795045612, 0.00326530683967088, 0.00397157513355646, + 0.00478398402103242, 0.00562578617174339, 0.00642151401310924, + 0.00710516325352591, 0.0076233342504205, 0.00792887143290408, + 0.007991853586444, 0.00782057732263926, 0.00744897956546535, + 0.0069384929144641, 0.00635256579898413, 0.00575528039409075, + 0.00521584903924697, 0.00478705837160902, 0.00446912054264909, + 0.00429139585416747, 0.00412091585089795, 0.00386808048288927, + 0.00345176198581435, 0.00286804842828961, 0.00219838127364229, + 0.00155999682928675, 0.00104493105814636, 0.000682246486858844, + 0.000445389414575203, 0.000276111329793337, 0.000219845167876759, + 0.000195898059926785, 1.67697787762053e-05, 0.00823823412294483, + 0.010300971664961, 0.0106918924283215, 0.0111558219792024, + 0.0115993796398055, 0.0119732134422882, 0.0122666538757871, + 0.0124892234715882, 0.012651495759782, 0.0127416422251206, + 0.0127279556232876, 0.0125780562745348, 0.0122472574709892, + 0.0117097691886179, 0.0109505135974579, 0.00998951428102941, + 0.00890070291738937, 0.00777378297439372, 0.00665135320789356, + 0.00564931737119188, 0.00472017955740638, 0.0039339230683199, + 0.00330374055047746, 0.00279213830951485, 0.00234623900606025, + 0.00192976642506856, 0.00153410845928905, 0.00117132184677085, + 0.000850318166057567, 0.000552417062083501, 0.00044328212045939, + 0.00039111186736149, 2.00923576308709e-05, 0.0098793171804847, + 0.012367942720638, 0.0128660038266763, 0.0134475512060206, + 0.0139580538500004, 0.0142745175130101, 0.0143146686464285, + 0.014040433755922, 0.0134595627047652, 0.0126190358957302, + 0.0116122156983839, 0.0105648025041402, 0.00957377039163472, + 0.00869732826120665, 0.00793350361283225, 0.00724850032695823, + 0.00661719861511309, 0.00601869089817581, 0.00540510112388933, + 0.00481253409630462, 0.00415849490479005, 0.00348840357011957, + 0.00284905541470924, 0.00227298328162639, 0.00177168511507378, + 0.00134362941882846, 0.000985207340511637, 0.000694914991234696, + 0.000468501147337864, 0.000286178704138945, 0.000219746731405481, + 0.000184460511741507, 1.70607010745472e-05, 0.00819276784203495, + 0.0100092174833612, 0.00992300727401238, 0.00970331686957488, + 0.00932415307409835, 0.00879752021805181, 0.00817767595846068, + 0.00753052599411138, 0.00691171973868216, 0.00635526816232545, + 0.00587614779655191, 0.00547138548757523, 0.00511134981115888, + 0.00475963196140319, 0.00437824652465188, 0.00394591271909734, + 0.00347026255541421, 0.00297644154048512, 0.00248220808641527, + 0.00204001550926865, 0.00164981842675658, 0.00135437090720464, + 0.00115915903465269, 0.00103093837428987, 0.000922092365862811, + 0.000797487988842931, 0.000648350066112093, 0.000489900167404267, + 0.000342619762315172, 0.00021193520192232, 0.000162668441960372, + 0.000135540920990262, 1.87950455592698e-05, 0.00889839576809104, + 0.0107488052903663, 0.0104780582428893, 0.0100997389261222, + 0.00967880908873081, 0.00926822738690466, 0.00889538263699053, + 0.00853971499137703, 0.00814418924063882, 0.00764177299963316, + 0.00699402527205009, 0.00621411386607842, 0.0053481190553384, + 0.00446701784460852, 0.00363654594591005, 0.00290762509356047, + 0.00231000634693226, 0.00185784759491956, 0.00154003031112137, + 0.00134626194282073, 0.00121686199927685, 0.00111025914397686, + 0.000985817218466332, 0.00082703868799364, 0.000645472882576886, + 0.000466270144004584, 0.000312104302077052, 0.000194295685170027, + 0.000113223263092296, 5.97935561392987e-05, 4.06772446348605e-05, + 2.90490243861773e-05, 2.34641811423485e-05, 0.0110270613114104, + 0.0132064006401036, 0.0126274587818172, 0.0117887554163134, + 0.0107955628445567, 0.00974930775957254, 0.00874011644299915, + 0.00780803995343969, 0.00694500185418791, 0.00612107278163661, + 0.00531947460531039, 0.00455059332896231, 0.00383596022414174, + 0.00320459290626052, 0.00267352984678448, 0.00224440348938561, + 0.00190524483247748, 0.00163485157304456, 0.00139921904320423, + 0.00118571410990477, 0.00096505007551202, 0.000759393123547956, + 0.000598551063862228, 0.000495391155333501, 0.000434264139223431, + 0.000383577627813608, 0.000319583192778069, 0.000241241114014662, + 0.000162668586814352, 9.44685371321714e-05, 6.77263612231927e-05, + 5.09334702999125e-05)) + +VehOwnModels_ls$VehicleMpgProp <- list( + Veh1Value = c(0.05, 0.1, 0.15, 0.2, + 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, 0.7, 0.75, + 0.8, 0.85, 0.9, 0.95, 1), + Veh2Value = c(0.05, + 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, + 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 1), + Veh3Value = c(0.05, + 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, + 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 1), + Veh4Value = c(0.05, + 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, + 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 1), + Veh5PlusValue = c(0.05, + 0.1, 0.15, 0.2, 0.25, 0.3, 0.35, 0.4, 0.45, 0.5, 0.55, 0.6, 0.65, + 0.7, 0.75, 0.8, 0.85, 0.9, 0.95, 1), + Veh1Prob = c(0L, + 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, + 0L, 0L, 1L), + Veh2Prob = c(0.019114158, + 0.022607435, 0.027814395, 0.034339573, 0.046401265, 0.054574216, + 0.06380174, 0.071381492, 0.081531769, 0.078763511, 0.078104403, + 0.08159768, 0.071315581, 0.06380174, 0.054640127, 0.046401265, + 0.034273662, 0.027814395, 0.022673346, 0.019048247), + Veh3Prob = c(0.053135889, 0.05937863, 0.069541231, + 0.088704994, 0.095092915, 0.100464576, 0.097996516, 0.094802555, + 0.079268293, 0.065476189, 0.058217189, 0.042682927, 0.031504065, + 0.022357724, 0.016114983, 0.011469222, 0.006097561, 0.004500581, + 0.00261324, 0.00058072), + Veh4Prob = c(0.073743922, + 0.102917342, 0.111426256, 0.129659643, 0.142625608, 0.112641815, + 0.090356564, 0.070502431, 0.055510535, 0.036871963, 0.029578606, + 0.016207455, 0.010534846, 0.007698541, 0.002025932, 0.006077796, + 0.000810373, 0, 0.000405186, 0.000405186), + Veh5PlusProb = c(0.131578947, 0.148421053, 0.187368421, + 0.124210526, 0.128421053, 0.098947368, 0.074736842, 0.037894737, + 0.022105263, 0.021052631, 0.010526316, 0.002105263, 0.008421053, + 0.001052632, 0.003157895, 0, 0, 0, 0, 0)) + + + +#Save the vehicle ownership model +#----------------------------- +#' Vehicle ownership model +#' +#' A list containing the vehicle ownership model equation and other information +#' needed to implement the vehicle ownership model. +#' +#' @format A list having the following components: +#' \describe{ +#' \item{Metro}{a list containing four models for metropolitan areas: a Zero +#' component model and three separate models for non-zero component} +#' \item{NonMetro}{a list containing four models for non-metropolitan areas: a +#' Zero component model and three separate models for non-zero component} +#' } +#' @source AssignVehicleFeatures.R script. +"VehOwnModels_ls" +usethis::use_data(VehOwnModels_ls, overwrite = TRUE) + +# Model LtTrk Ownership +#------------------------- + +# LtTrk ownership model +LtTruckModels_ls <- list(OwnModel = "-0.786596031795022 * Intercept + 5.0096283625617e-06 * Income + -0.151743860056697 * LogDen + -0.19343908057384 * Urban + 0.600876902111923 * Hhvehcnt + 0.287299051164498 * HhSize + 1.74355011513854e-06 * Income * HhSize + -3.79266132566609e-06 * Income * Hhvehcnt + -0.0862684834097631 * Hhvehcnt * HhSize") + +#Save the light truck ownership model +#----------------------------- +#' Light truck ownership model +#' +#' A list containing the light truck ownership model equation. +#' +#' @format A list having the following components: +#' \describe{ +#' \item{OwnModel}{The light truck ownership model} +#' } +#' @source AssignVehicleFeatures.R script. +"LtTruckModels_ls" +usethis::use_data(LtTruckModels_ls, overwrite = TRUE) + + +#================================================ +#SECTION 2: DEFINE THE MODULE DATA SPECIFICATIONS +#================================================ + +#Define the data specifications +#------------------------------ +AssignVehicleFeaturesSpecifications <- list( + #Level of geography module is applied at + RunBy = "Region", + #Specify new tables to be created by Inp if any + #--------------------------- + NewInpTable = items( + item( + TABLE = "Vehicles", + GROUP = "Global" + ) + ), + NewSetTable = items( + item( + TABLE = "Vehicle", + GROUP = "Year" + ) + ), + #--------------------------- + #Specify new tables to be created by Inp if any + Inp = items( + item( + NAME = items( + "AutoMpg", + "LtTruckMpg", + "TruckMpg", + "BusMpg", + "TrainMpg" + ), + FILE = "model_veh_mpg_by_year.csv", + TABLE = "Vehicles", + GROUP = "Global", + TYPE = "compound", + UNITS = "MI/GAL", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + DESCRIPTION = items( + "Miles per gallon for automobiles", + "Miles per gallon for light trucks", + "Miles per gallon for trucks", + "Miles per gallon for buses", + "Miles per gallon for trains") + ), + item( + NAME = "ModelYear", + FILE = "model_veh_mpg_by_year.csv", + TABLE = "Vehicles", + GROUP = "Global", + TYPE = "time", + UNITS = "YR", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + DESCRIPTION = "Years for which the efficiency of vehicle are measured." + ) + ), + #--------------------------- + #Specify new tables to be created by Set if any + #Specify input data + #Specify data to be loaded from data store + Get = items( + # Marea variables + item( + NAME = "Marea", + TABLE = "Marea", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = items( + "TranRevMiPC", + "FwyLaneMiPC"), + TABLE = "Marea", + GROUP = "Year", + TYPE = "compound", + UNITS = "MI/PRSN", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + # Bzone variables + item( + NAME = "Marea", + TABLE = "Bzone", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "Bzone", + TABLE = "Bzone", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + # Household variables + item( + NAME = + items("HhId", + "Azone", + "Marea"), + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "Income", + TABLE = "Household", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD.2001", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "HhType", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBIT = "", + ISELEMENTOF = c("SF", "MF", "GQ") + ), + item( + NAME = "HhSize", + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + PROHIBIT = c("NA", "<= 0"), + ISELEMENTOF = "" + ), + item( + NAME = + items( + "Age0to14", + "Age65Plus"), + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "HhPlaceTypes", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBITED = "NA" + ), + item( + NAME = "DrvLevels", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBITED = "NA", + ISELEMENTOF = c("Drv1", "Drv2", "Drv3Plus") + ), + # Global variables + item( + NAME = items( + "AutoMpg", + "LtTruckMpg", + "TruckMpg", + "BusMpg", + "TrainMpg" + ), + TABLE = "Vehicles", + GROUP = "Global", + TYPE = "compound", + UNITS = "MI/GAL", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "ModelYear", + TABLE = "Vehicles", + GROUP = "Global", + TYPE = "time", + UNITS = "YR", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "LtTruckProp", + TABLE = "Model", + GROUP = "Global", + TYPE = "double", + UNITS = "multiplier", + PROHIBIT = c('NA', '< 0'), + ISELEMENTOF = "" + ) + ), + #--------------------------- + #Specify data to saved in the data store + Set = items( + # Vehicle variables + item( + NAME = + items("HhId", + "VehId", + "Azone", + "Marea"), + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + NAVALUE = -1, + PROHIBIT = "NA", + ISELEMENTOF = "", + DESCRIPTION = + items("Unique household ID", + "Unique vehicle ID", + "Azone ID", + "Marea ID") + ), + item( + NAME = "Type", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + NAVALUE = -1, + PROHIBIT = "NA", + ISELEMENTOF = c("Auto", "LtTrk"), + SIZE = 5, + DESCRIPTION = "Vehicle body type: Auto = automobile, LtTrk = light trucks (i.e. pickup, SUV, Van)" + ), + item( + NAME = "Age", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "time", + UNITS = "YR", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Vehicle age in years" + ), + item( + NAME = "Mileage", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "compound", + UNITS = "MI/GAL", + PROHIBIT = c("NA", "<0"), + ISELEMENTOF = "", + DESCRIPTION = "Mileage of vehicles (automobiles and light truck)" + ), + item( + NAME = "DvmtProp", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "double", + UNITS = "proportion", + PROHIBIT = c("NA", "<0", "> 1"), + ISELEMENTOF = "", + DESCRIPTION = "Proportion of average household DVMT" + ), + # Household variables + item( + NAME = "Vehicles", + TABLE = "Household", + GROUP = "Year", + TYPE = "vehicles", + UNITS = "VEH", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Number of automobiles and light trucks owned or leased by the household" + ), + item( + NAME = items( + "NumLtTrk", + "NumAuto"), + TABLE = "Household", + GROUP = "Year", + TYPE = "vehicles", + UNITS = "VEH", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = items( + "Number of light trucks (pickup, sport-utility vehicle, and van) owned or leased by household", + "Number of automobiles (i.e. 4-tire passenger vehicles that are not light trucks) owned or leased by household" + ) + ) + ) +) + +#Save the data specifications list +#--------------------------------- +#' Specifications list for AssignVehicleFeatures module +#' +#' A list containing specifications for the AssignVehicleFeatures module. +#' +#' @format A list containing 3 components: +#' \describe{ +#' \item{RunBy}{the level of geography that the module is run at} +#' \item{Get}{module inputs to be read from the datastore} +#' \item{Set}{module outputs to be written to the datastore} +#' } +#' @source AssignVehicleFeatures.R script. +"AssignVehicleFeaturesSpecifications" +usethis::use_data(AssignVehicleFeaturesSpecifications, overwrite = TRUE) + + +#======================================================= +#SECTION 3: DEFINE FUNCTIONS THAT IMPLEMENT THE SUBMODEL +#======================================================= + +# Function to predict vehicle ownership by region type to match +# the target proportion. +#-------------------------------------------------------- +#' Predict vehicle ownership to match the target proportion for a specific +#' region type. +#' +#' \code{predictVehicleOwnership} Predict vehicle ownership to match the +#' target proportion for a specific region type. +#' +#' This function predicts the number of vehicles and the ratio of number of vehicles +#' to the driving age population (ownership ratio). +#' +#' @param Hh_df A household data frame consisting of household attributes. +#' @param ModelType A list of vehicle ownership models. +#' @param VehProp A list of data frame consisting of distribution of number +#' of vehicles by driving age population for each region type. +#' @param Type A string indicating the region type ("Metro": Default, or "NonMetro") +#' @return A list containing number of vehicles and ownership ratio for each household +#' @name predictVehicleOwnership +#' @export +#' +predictVehicleOwnership <- function( Hh_df, ModelType=VehOwnModels_ls, VehProp = NA, Type="Metro" ) { + # Define vehicle categories + VehicleCategory <- c( "Zero", "Lt1", "Eq1", "Gt1" ) + # Define driver levels + DriverLevels <- c( "Drv1", "Drv2", "Drv3Plus" ) + # Check if proper type specified + if( !( Type %in% c( "Metro", "NonMetro" ) ) ) { + stop( "Type must be either 'Metro' or 'NonMetro'" ) + } + # Extract model components for specified type + ZeroVehModel <- ModelType[[Type]]$ZeroVeh + Lt1VehModel <- ModelType[[Type]]$Lt1Veh + Eq1VehModel <- ModelType[[Type]]$Eq1Veh + Gt1VehModel <- ModelType[[Type]]$Gt1Veh + VehProp_ <- VehProp[[Type]] + # Define an intercept value + Intercept <- 1 + # Apply the zero vehicle ownership model + ZeroVehResults_ <- numeric( nrow( Hh_df ) ) + for( dl in DriverLevels ) { + ZeroVehResults_[ Hh_df$DrvLevel == dl ] <- + eval( parse( text=ZeroVehModel[[dl]] ), envir=Hh_df[ Hh_df$DrvLevel == dl, ] ) + } + ZeroVehOdds_ <- exp( ZeroVehResults_ ) + ZeroVehProbs_ <- ZeroVehOdds_ / (1 + ZeroVehOdds_) + # Apply the less than one vehicle ownership model + # Note if DrvLevel == Drv1, then Lt1 can't be true + Lt1VehResults_ <- numeric( nrow( Hh_df ) ) + Lt1VehResults_[ Hh_df$DrvLevel == "Drv1" ] <- NA + for( dl in DriverLevels ) { + if(Lt1VehModel[[dl]]!=""){ + Lt1VehResults_[ Hh_df$DrvLevel == dl ] <- + eval( parse( text=Lt1VehModel[[dl]] ), envir=Hh_df[ Hh_df$DrvLevel == dl, ] ) + } + } + Lt1VehOdds_ <- exp( Lt1VehResults_ ) + Lt1VehProbs_ <- Lt1VehOdds_ / (1 + Lt1VehOdds_) + Lt1VehProbs_[ Hh_df$DrvLevel == "Drv1" ] <- 0 + # Apply the equal to one vehicle ownership model + Eq1VehResults_ <- numeric( nrow( Hh_df ) ) + for( dl in DriverLevels ) { + Eq1VehResults_[ Hh_df$DrvLevel == dl ] <- + eval( parse( text=Eq1VehModel[[dl]] ), envir=Hh_df[ Hh_df$DrvLevel == dl, ] ) + } + Eq1VehOdds_ <- exp( Eq1VehResults_ ) + Eq1VehProbs_ <- Eq1VehOdds_ / (1 + Eq1VehOdds_) + # Apply the greater than one vehicle ownership model + Gt1VehResults_ <- numeric( nrow( Hh_df ) ) + for( dl in DriverLevels ) { + Gt1VehResults_[ Hh_df$DrvLevel == dl ] <- + eval( parse( text=Gt1VehModel[[dl]] ), envir=Hh_df[ Hh_df$DrvLevel == dl, ] ) + } + Gt1VehOdds_ <- exp( Gt1VehResults_ ) + Gt1VehProbs_ <- Gt1VehOdds_ / (1 + Gt1VehOdds_) + # Combine probability vectors into one matrix + VehProbs2d <- cbind( ZeroVehProbs_, Lt1VehProbs_, Eq1VehProbs_, Gt1VehProbs_ ) + # Calculate a vehicle choice + Hh_df$VehChoice <- VehicleCategory[ apply( VehProbs2d, 1, function(x) { + sample( 1:4, 1, replace=FALSE, prob=x ) + } ) ] + # Calculate number of vehicles + NumVeh_ <- numeric( nrow( Hh_df ) ) + + NumVeh_[Hh_df$VehChoice == "Zero"] <- 0 + NumVeh_[Hh_df$VehChoice == "Eq1"] <- Hh_df$DrvAgePop[Hh_df$VehChoice == "Eq1"] + + ## Calculate number of vehicles ofr Lt1 + VehChoice <- "Lt1" + VehProbsNdNv <- VehProp_[[VehChoice]] + + ### Calculate if the driver age population is found in the table + CheckCondition1 <- Hh_df$VehChoice == "Lt1" + CheckCondition2 <- (Hh_df$VehChoice == "Lt1") & (as.character(Hh_df$DrvAgePop) %in% as.character(VehProbsNdNv$Lt1DrvAgePop)) + + # Modify the sampling function + customSample <- function(x, ...){ + if(length(x) < 2){ + return(x) + } else { + return(sample(x,...)) + } + } + + + if(any(CheckCondition1)){ + NumVeh_[CheckCondition1] <- round(Hh_df$DrvAgePop[CheckCondition1]/2) + } + if(any(CheckCondition2)){ + NumVeh_[CheckCondition2] <- sapply(Hh_df$DrvAgePop[CheckCondition2], function(x) customSample(VehProbsNdNv$Lt1NumVeh[VehProbsNdNv$Lt1DrvAgePop == x], 1, prob = VehProbsNdNv$Lt1Prob[VehProbsNdNv$Lt1DrvAgePop==x])) + } + + ## Calculate number of vehicles ofr Gt1 + VehChoice <- "Gt1" + VehProbsNdNv <- VehProp_[[VehChoice]] + + ### Calculate if the driver age population is found in the table + CheckCondition1 <- Hh_df$VehChoice == "Gt1" + CheckCondition2 <- (Hh_df$VehChoice == "Gt1") & (as.character(Hh_df$DrvAgePop) %in% as.character(VehProbsNdNv$Gt1DrvAgePop)) + + + if(any(CheckCondition1)){ + NumVeh_[CheckCondition1] <- round(Hh_df$DrvAgePop[CheckCondition1]/2) + } + if(any(CheckCondition2)){ + NumVeh_[CheckCondition2] <- sapply(Hh_df$DrvAgePop[CheckCondition2], function(x) customSample(VehProbsNdNv$Gt1NumVeh[VehProbsNdNv$Gt1DrvAgePop == x], 1, prob = VehProbsNdNv$Gt1Prob[VehProbsNdNv$Gt1DrvAgePop==x])) + } + + # Calculate vehicle ownership ratio + VehRatio_ <- NumVeh_ / Hh_df$DrvAgePop + # Return results in a list + list( VehRatio = as.numeric(VehRatio_), NumVeh = as.integer(NumVeh_) ) +} + +# Function to predict vehicle type (auto or light truck) for household vehicles +#----------------------------------------------------------------------------- +#' Predict vehicle type (automobile or light truck) for household vehicles. +#' +#' \code{predictVehicleOwnership} Predict vehicle type (automobile or light truck) +#' for household vehicles. +#' +#' This function predict vehicle type (automobile or light truck) +#' for household vehicles based on characterisitics of the household, the place where +#' the household resides, the number of vehicles it owns, and areawide targets for +#' light truck ownership. +#' +#' +#' @param Hh_df A household data frame consisting of household characteristics. +#' @param ModelType A list of light truck ownership model. +#' @param TruckProp A numeric indicating the target proportion for light truck +#' ownership. +#' @return A list containing vehicle types for each household. +#' @name predictLtTruckOwn +#' @export +#' +predictLtTruckOwn <- function( Hh_df, ModelType=LtTruckModels_ls, TruckProp=NA) { + + # Setup values + OwnModel <- ModelType$OwnModel + Hh_df$LogDen <- log( Hh_df$Htppopdn ) + TargetTruckProp <- TruckProp + LtTruckFactorLo <- -100 + LtTruckFactorMd <- 0 + LtTruckFactorHi <- 100 + Itr <- 0 + Intercept <- 1 + + # Function to test convergence + notConverged <- function( TruckProp, EstTruckProp ) { + Diff <- abs( TruckProp - EstTruckProp ) + return(Diff > 0.0001) + } + + # Function to calculate probabilities + calcVehProbs <- function( Factor ) { + LtTruckResults_ <- Factor + eval( parse( text=OwnModel ), envir=Hh_df ) + LtTruckOdds_ <- exp( LtTruckResults_ ) + return(LtTruckOdds_ / (1 + LtTruckOdds_)) + } + + # Calculate starting proportion + LtTruckProbsMd_ <- calcVehProbs( LtTruckFactorMd ) + EstTruckProp <- sum( Hh_df$Hhvehcnt * LtTruckProbsMd_ ) / sum( Hh_df$Hhvehcnt ) + # Continue is there is a target truck proportion to be achieved + if( !is.na( TruckProp ) ){ + while( notConverged( TruckProp, EstTruckProp ) ) { + LtTruckProbsLo_ <- calcVehProbs( LtTruckFactorLo ) + LtTruckProbsMd_ <- calcVehProbs( LtTruckFactorMd ) + LtTruckProbsHi_ <- calcVehProbs( LtTruckFactorHi ) + EstTruckPropLo <- sum( Hh_df$Hhvehcnt * LtTruckProbsLo_ ) / + sum( Hh_df$Hhvehcnt ) + EstTruckPropMd <- sum( Hh_df$Hhvehcnt * LtTruckProbsMd_ ) / + sum( Hh_df$Hhvehcnt ) + EstTruckPropHi <- sum( Hh_df$Hhvehcnt * LtTruckProbsHi_ ) / + sum( Hh_df$Hhvehcnt ) + if( TruckProp < EstTruckPropMd ) { + LtTruckFactorHi <- LtTruckFactorMd + LtTruckFactorMd <- mean( c( LtTruckFactorHi, LtTruckFactorLo ) ) + } + if( TruckProp > EstTruckPropMd ) { + LtTruckFactorLo <- LtTruckFactorMd + LtTruckFactorMd <- mean( c( LtTruckFactorLo, LtTruckFactorHi ) ) + } + EstTruckProp <- EstTruckPropMd + rm( EstTruckPropLo, EstTruckPropMd, EstTruckPropHi ) + if( Itr > 100 ) break + Itr <- Itr + 1 + } + } + + # Assign vehicles by type to each household + VehType_ <- apply( cbind( Hh_df$Hhvehcnt, LtTruckProbsMd_ ), 1, function(x) { + NumVeh <- x[1] + Prob <- x[2] + sample( c( "LtTruck", "Auto" ), NumVeh, replace=TRUE, + prob=c( Prob, 1-Prob ) ) + } ) + # Return the result + return(VehType_) +} + +#Function which calculates vehicle type distributions by income group +#------------------------------------------------------------------- +#' Calculate vehicle type distributions by income group. +#' +#' \code{calcVehPropByIncome} Calculates vehicle type distributions by +#' household income group. +#' +#' This function calculates vehicle type distributions by household +#' income group. It takes the the number of vehicles, vehicle types, and +#' income groups of each household and calculates the marginal distribution +#' of the vehicle types. +#' +#' @param Hh_df A household data frame consisting of household characteristics. +#' @return A data frame containing the distribution of vehicle types by income +#' groups. +#' @name calcVehPropByIncome +#' @import reshape2 +#' @export +#' +calcVehPropByIncome <- function( Hh_df ) { + VehTabByIg <- table( rep( Hh_df$IncGrp, Hh_df$Hhvehcnt ), unlist( Hh_df$VehType ) ) + VehIgPropByIg <- sweep( VehTabByIg, 2, colSums( VehTabByIg ), "/" ) + VehIgPropByIg <- as.data.frame(VehIgPropByIg) + VehIgPropByIg <- reshape2::dcast(VehIgPropByIg, Var1~Var2, value.var = "Freq", fill = 0) + colnames(VehIgPropByIg)[1] <- "IncGrp" + return(VehIgPropByIg) +} + +#Function to adjust cumulative age distribution to match target ratio +#------------------------------------------------------------------- +#' Adjust cumulative age distribution to match target ratio +#' +#' \code{adjAgeDistribution} Adjusts a cumulative age distribution to match a +#' target ratio. +#' +#' This function adjusts a cumulative age distribution to match a target ratio. +#' The function returns the adjusted cumulative age distribution and the +#' corresponding age distribution. +#' +#' @param CumDist A named numeric vector where the names are vehicle ages and +#' the values are the proportion of vehicles that age or younger. The names must +#' be an ordered sequence from 0 to 32. +#' @param AdjRatio A number that is the target ratio value. +#' @return A numeric vector of adjusted distribution. +#' @name adjAgeDistribution +#' @import stats +#' @export +#' +adjAgeDistribution <- function( CumDist, AdjRatio ) { + # Calculate the length of the original distribution + DistLength <- length( CumDist ) + # If 95th percentile age increases, add more ages on the right side of the distribution + # to enable the distribution to be expanded in that direction + if( AdjRatio > 1 ) CumDist <- c( CumDist, rep(1,8) ) + # Calculate vehicle ages for the distribution + Ages_ <- 0:( length( CumDist ) - 1 ) + MaxAge <- Ages_[ length( Ages_ ) ] + # Find decimal year which is equal to 95th percentile + LowerIndex <- max( which( CumDist < 0.95 ) ) + UpperIndex <- LowerIndex + 1 + LowerValue <- CumDist[ LowerIndex ] + UpperValue <- CumDist[ UpperIndex ] + YearFraction <- ( 0.95 - LowerValue ) / ( UpperValue - LowerValue ) + Year95 <- Ages_[ LowerIndex ] + YearFraction + # Calculate the adjustment in years + Target95 <- Year95 * AdjRatio + LowerShiftRatio <- Target95 / Year95 + UpperShiftRatio <- ( MaxAge - Target95 ) / ( MaxAge - Year95 ) + LowerAdjAges_ <- Ages_[ 0:LowerIndex ] * LowerShiftRatio + UpperAgeSeq_ <- ( Ages_[ UpperIndex ]:MaxAge ) + UpperAdjAges_ <- MaxAge - rev( UpperAgeSeq_ - UpperAgeSeq_[1] ) * UpperShiftRatio + AdjAges_ <- c( LowerAdjAges_, UpperAdjAges_ ) + # Calculate new cumulative proportions + AdjCumDist <- CumDist + for( i in 2:( length( AdjCumDist ) - 1 ) ) { + LowerIndex <- max( which( AdjAges_ < Ages_[i] ) ) + UpperIndex <- LowerIndex + 1 + AdjProp <- ( Ages_[i] - AdjAges_[ LowerIndex ] ) / + ( AdjAges_[ UpperIndex ] - AdjAges_[ LowerIndex ] ) + LowerValue <- CumDist[ LowerIndex ] + UpperValue <- CumDist[ UpperIndex ] + AdjCumDist[i] <- LowerValue + AdjProp * ( UpperValue - LowerValue ) + } + # Smooth out the cumulative distribution + LowIdx <- 1 + HiIdx <- length( AdjCumDist ) + SmoothTransition_ <- smooth.spline( LowIdx:HiIdx, AdjCumDist[LowIdx:HiIdx], df=4 )$y + AdjCumDist[ LowIdx:HiIdx ] <- SmoothTransition_ + # Convert cumulative distribution to regular distribution + AdjDist_ <- AdjCumDist + for( i in length( AdjDist_ ):2 ) { + AdjDist_[i] <- AdjDist_[i] - AdjDist_[i-1] + } + # Truncate to original distribution length + AdjDist_ <- AdjDist_[ 1:DistLength ] + # Adjust so that sum of distribution exactly equals 1 + AdjDist_ <- AdjDist_ * ( 1 / sum( AdjDist_ ) ) + # Return result + return(AdjDist_) +} + +#Function which calculates vehicle age distributions by income group +#------------------------------------------------------------------- +#' Calculate vehicle age distributions by income group. +#' +#' \code{calcVehAgePropByInc} Calculates vehicle age distributions by +#' household income group. +#' +#' This function calculates vehicle age distributions by household income group. +#' It takes marginal distributions of vehicles by age and households by income +#' group along with a data frame of the joint probability distribution of +#' vehicles by age and income group, and then uses iterative proportional +#' fitting to adjust the joint probabilities to match the margins. The +#' probabilities by income group are calculated from the fitted joint +#' probability matrix. The age margin is the proportional distribution of +#' vehicles by age calculated by adjusting the cumulative age distribution +#' for autos or light trucks to match a target mean age. The income +#' margin is the proportional distribution of vehicles by household income group +#' ($0-20K, $20K-40K, $40K-60K, $60K-80K, $80K-100K, $100K or more) calculated +#' from the modeled household values. +#' +#' @param VehAgIgProp A numeric vector of joint probabilities of vehicle by +#' age and income group. +#' @param AgeGrp A numeric vector indicating the vehicle ages. +#' @param AgeMargin A named numeric vector indicating the marginal distribution +#' of vehicle by age. +#' @param IncGrp A character vector indicating the income groups. +#' @param IncMargin A named numeric vecotr indicating the marginal distribution +#' of vehicle by income groups. +#' @param MaxIter A numeric indicating maximum number of iterations. (Default: 100) +#' @param Closure A numeric indicating the tolerance level for conversion. (Default: 1e-3) +#' @return A numeric vector of joint probabilities of vehicle by age and income group. +#' @name calcVehAgePropByInc +#' @export +#' +calcVehAgePropByInc <- function(VehAgIgProp, AgeGrp, AgeMargin, IncGrp, IncMargin, MaxIter=100, Closure=0.001){ + # Replace margin values of zero with 0.001 + if( any( AgeMargin ==0 ) ){ + AgeMargin[ AgeMargin ==0 ] <- 0.0001 + } + if( any( IncMargin ==0 ) ){ + IncMargin[ IncMargin ==0 ] <- 0.0001 + } + # Make sure sum of each margin is equal to 1 + AgeMargin <- AgeMargin * ( 1 / sum( AgeMargin ) ) + IncMargin <- IncMargin * ( 1 / sum( IncMargin ) ) + # Set initial values + Iter <- 0 + MarginChecks <- c( 1, 1 ) + # Iteratively proportion matrix until closure or iteration criteria are met + while( ( any( MarginChecks > Closure ) ) & ( Iter < MaxIter ) ) { + AgeSums <- rowsum( VehAgIgProp, group = AgeGrp )[,1] + AgeCoeff <- AgeMargin / AgeSums + VehAgIgProp <- AgeCoeff[as.character(AgeGrp)]*VehAgIgProp + MarginChecks[1] <- sum(abs( 1 - AgeCoeff )) + IncSums <- rowsum( VehAgIgProp, group = IncGrp )[,1] + IncCoeff <- IncMargin / IncSums + VehAgIgProp <- IncCoeff[as.character(IncGrp)]*VehAgIgProp + MarginChecks[2] <- sum(abs( 1 - IncCoeff )) + Iter <- Iter + 1 + } + # Compute proportions for each income group + IncSums <- rowsum(VehAgIgProp, group = IncGrp)[,1] + VehAgIgProp <- VehAgIgProp/IncSums[as.character(IncGrp)] + return(VehAgIgProp) +} + +# Function to calculate vehicle type and age for each household +#-------------------------------------------------------- +#' Calculate vehicle type and age for each household. +#' +#' \code{calcVehicleAges} Calculates vehicle type and age for each household. +#' +#' This function calculates the vehicle type and age for households. The function +#' uses characteristics of houshold and target marginal proportions to calculate +#' vehicle type and age. +#' +#' @param Hh_df A household data frame consisting of household characteristics. +#' @param VProp A list consisting of a cumulative distribution of vehicle age by +#' vehicle type and a joint distribution of vehicle age, type and income group of +#' the household. +#' @param AdjRatio A number that is the target ratio value. +#' @return A list containing the vehicle types and ages for each household. +#' @name calcVehicleAges +#' @import reshape2 +#' @export +#' +calcVehicleAges <- function(Hh_df, VProp=NULL, AdjRatio = c(Auto = 1, LtTruck = 1)){ + + # Compute the vehicle age distribution by income and type + #-------------------------------------------------------- + # Calculate the distribution of vehicle types by income + VehPropByInc <- calcVehPropByIncome( Hh_df ) + # Compute the age margin + AgeType <- colnames( VProp$VehCumPropByAge[,-1] ) + VehPropByAge <- VProp$VehCumPropByAge + # Adjust the age distribution + AdjVehProp <- lapply(AgeType, function(x) adjAgeDistribution(VehPropByAge[, x], + AdjRatio = AdjRatio[x])) + names(AdjVehProp) <- AgeType + VehPropByAge[,AgeType] <- data.frame(AdjVehProp) + # Compute the age distribution by income and type + VehPropByAgeIncGrpType <- VProp$VehPropByAgeIncGrpType + + VehPropByAgeIncGrpType <- reshape2::dcast(VehPropByAgeIncGrpType, ...~VehType, value.var = "Prop", fill = 0) + + VehPropByAgeInc_ <- do.call(cbind, lapply(AgeType, function(x) calcVehAgePropByInc(VehAgIgProp = VehPropByAgeIncGrpType[,x], AgeGrp = VehPropByAgeIncGrpType[,"VehAge"], AgeMargin = VehPropByAge[,x], IncGrp = VehPropByAgeIncGrpType[,"IncGrp"], IncMargin = VehPropByInc[,x]))) + VehPropByAgeIncGrpType[,c("Auto","LtTruck")] <- VehPropByAgeInc_ + + + # Apply ages to vehicles + #----------------------- + # Identify the number of autos and light trucks by income group + NumLtTrucks_ <- sapply( Hh_df$VehType, function(x) sum( x == "LtTruck" ) ) + NumAutos_ <- Hh_df$Hhvehcnt - NumLtTrucks_ + NumLtTruckSamplesByInc <- tapply( NumLtTrucks_, Hh_df$IncGrp, sum ) + NumAutoSamplesByInc <- tapply( NumAutos_, Hh_df$IncGrp, sum ) + # Create age samples for light trucks by income group + LtTruckSamplesByInc <- lapply(levels(VehPropByAgeIncGrpType$IncGrp), + function(x) sample(VehPropByAgeIncGrpType[VehPropByAgeIncGrpType$IncGrp==x, "VehAge"], NumLtTruckSamplesByInc[x], replace = TRUE, prob = VehPropByAgeIncGrpType[VehPropByAgeIncGrpType$IncGrp==x, "LtTruck"])) + + names(LtTruckSamplesByInc) <- levels(VehPropByAgeIncGrpType$IncGrp) + # Create age samples for autos by income group + AutoSamplesByInc <- lapply(levels(VehPropByAgeIncGrpType$IncGrp), + function(x) sample(VehPropByAgeIncGrpType[VehPropByAgeIncGrpType$IncGrp==x, "VehAge"], NumAutoSamplesByInc[x], replace = TRUE, prob = VehPropByAgeIncGrpType[VehPropByAgeIncGrpType$IncGrp==x, "Auto"])) + + names(AutoSamplesByInc) <- levels(VehPropByAgeIncGrpType$IncGrp) + # Associate light truck and auto ages with each household + LtTruckAges_ <- as.list( rep( NA, nrow( Hh_df ) ) ) + for( ig in levels(VehPropByAgeIncGrpType$IncGrp) ) { + IsIncGrp_ <- Hh_df$IncGrp == ig + HasLtTrucks_ <- NumLtTrucks_ != 0 + GetsAges_ <- IsIncGrp_ & HasLtTrucks_ + LtTruckAges_[ GetsAges_ ] <- split( LtTruckSamplesByInc[[ig]], + rep( 1:sum( GetsAges_ ), NumLtTrucks_[ GetsAges_ ] ) ) + } + # Associate auto ages with each household + AutoAges_ <- as.list( rep( NA, nrow( Hh_df ) ) ) + for( ig in levels(VehPropByAgeIncGrpType$IncGrp) ) { + IsIncGrp_ <- Hh_df$IncGrp == ig + HasAuto_ <- NumAutos_ != 0 + GetsAges_ <- IsIncGrp_ & HasAuto_ + AutoAges_[ GetsAges_ ] <- split( AutoSamplesByInc[[ig]], + rep( 1:sum( GetsAges_ ), NumAutos_[ GetsAges_ ] ) ) + } + + # Return the result + #------------------ + # Combine auto and light truck lists + VehAge_ <- mapply( c, LtTruckAges_, AutoAges_ ) + VehAge_ <- lapply( VehAge_, function(x) x[ !is.na(x) ] ) + # Make list of vehicle types correspond to ages list + VehType_ <- apply( cbind( NumLtTrucks_, NumAutos_ ), 1, function(x) { + rep( c( "LtTruck", "Auto" ), x ) } ) + # Return result as a list + return(list( VehType = VehType_, VehAge = VehAge_ )) +} + +# Function to assign mileage to vehicles in a household +#-------------------------------------------------------- +#' Assignes mileage to vehicles in a household +#' +#' \code{assignFuelEconomy} Assignes mileage to vehicles in a household. +#' +#' This function assigns mileage to vehicles in a household based on type +#' age of the vehicles. +#' +#' @param Hh_df A household data frame consisting of household characteristics. +#' @param VehMpgYr A data frame of mileage of vehicles by type and year. +#' @param CurrentYear A integer indicating the current year. +#' @return A numeric vector that indicates the mileage of vehicles. +#' @name assignFuelEconomy +#' @export +#' +assignFuelEconomy <- function( Hh_df, VehMpgYr=NULL, CurrentYear ) { + # Calculate the sequence of years to use to index fleet average MPG + if(is.null(VehMpgYr)){ + stop("The function needs mpg data on vehicles.") + } + Years <- as.character(VehMpgYr[,"Year"]) + rownames(VehMpgYr) <- Years + StartYear <- as.numeric( CurrentYear ) - 32 + if( StartYear < 1975 ) { + YrSeq_ <- Years[ 1:which( Years == CurrentYear ) ] + NumMissingYr <- 1975 - StartYear + YrSeq_ <- c( rep( "1975", NumMissingYr ), YrSeq_ ) + } else { + YrSeq_ <- Years[ which( Years == StartYear ):which( Years == CurrentYear ) ] + } + # Calculate auto and light truck MPG by vehicle age + VehMpgByAge <- VehMpgYr[rev(YrSeq_),] + rownames( VehMpgByAge ) <- as.character( 0:32 ) + # Combine into vector and assign fuel economy to household vehicles + VehType_ <- unlist(Hh_df$VehType) + VehAge_ <- as.character(unlist(Hh_df$VehAge)) + VehMpg_ <- numeric(length(VehType_)) + VehMpg_[VehType_ == "Auto"] <- VehMpgByAge[VehAge_[VehType_ == "Auto"], "Auto"] + VehMpg_[VehType_ == "LtTruck"] <- VehMpgByAge[VehAge_[VehType_ == "LtTruck"], "LtTruck"] + # Split back into a list + ListIndex_ <- rep( 1:nrow(Hh_df), Hh_df$Hhvehcnt ) + VehMpg_ <- split( VehMpg_, ListIndex_ ) + # Return the result + return(VehMpg_) +} + +# Function to assign VMT proportion to household vehicles +#-------------------------------------------------------- +#' Assign VMT proportion to household vehicles. +#' +#' \code{apportionDvmt} Assign VMT proportion to household vehicles. +#' +#' This function assigns VMT proportions to household vehicles based on the +#' number of vehicles in the household and the probability distribution of proportion of +#' miles traveled by those vehicles. +#' +#' @param Hh_df A household data frame consisting of household characteristics. +#' @param DvmtProp A data frame of distribution of VMT proportion by number of +#' vehicles in a household. +#' @return A list containing number of vehicles and ownership ratio for each household +#' @name apportionDvmt +#' @export +#' +apportionDvmt <- function( Hh_df, DvmtProp=NULL ) { + if(is.null(DvmtProp)){ + stop("Probability distribution of mileage proportion assignment + for n vehicle household is required.") + } + # Create a list that stores the output of vehicle DVMT proportions + VehDvmtPropOutput_ <- lapply( 1:nrow( Hh_df ), function(x) numeric(0) ) + # Nc is a vector of the classes of number of household vehicles + Nc <- sort( unique( Hh_df$Hhvehcnt ) ) + # Iterate through each number class, get the subset of the data + # Calculate the vehicle proportions, assign the results to the VehDvmtPropOutput_ + for( nc in Nc ) { + # Make a subset of the input data + DataSub_ <- Hh_df[ Hh_df$Hhvehcnt == nc, ] + # Create a list to store the results for this subset + VehDvmtProp_ <- lapply( seq_along(DataSub_$HhId), function(x) numeric(nc) ) + # Simplified process where there are only 1 or 2 vehicles in the household + if( nc <= 2 ) { + # If there is only one vehicle, then the DVMT proportion is 1 + if( nc == 1 ) { + VehDvmtProp_ <- lapply( VehDvmtProp_, function(x) x <- 1 ) + } else { + # If there are 2 vehicles, then sample to get 1st proportion + # the 2nd proportion is 1 minus the 1st proportion + # Extract the 2Veh matrix of DvmtProp_ + DvmtProp2d <- DvmtProp[,c("Veh2Value","Veh2Prob")] + # Calculate the number of samples to be made + NumSamples <- nrow(DataSub_) + # Create a matrix to put the results into + VehDvmtProp2d <- matrix( 0, nrow=NumSamples, ncol=nc ) + # Sample from the probabilities to get the 1st set of values + VehDvmtProp2d[,1] <- sample( DvmtProp2d[,"Veh2Value"], NumSamples, + replace=TRUE, prob=DvmtProp2d[,"Veh2Prob"] ) + # Calculate 2nd set of values + VehDvmtProp2d[,2] <- 1 - VehDvmtProp2d[,1] + # Put the values into the list + for( i in 1:NumSamples ) VehDvmtProp_[[i]] <- VehDvmtProp2d[i,] + } + # General process for 3 or more vehicles in households + } else { + # Identify the class name to use to extract the appropriate proportion + # distribution + if( nc >= 5 ) { + VehClassName <- "Veh5Plus" + } else { + VehClassName <- paste("Veh", nc, sep="" ) + } + # Extract the appropriate proportion distribution from DvmtProp_ + Var_ <- paste0(VehClassName, c("Value","Prob")) + DvmtProp2d <- DvmtProp[, Var_] + # Calculate the number of samples to be made + NumSamples <- nrow(DataSub_) + # Create a matrix to put the results into + VehDvmtProp2d <- matrix( 0, nrow=NumSamples, ncol=nc ) + # Sample from probabilities to create values for 1st vehicle + VehDvmtProp2d[,1] <- sample( DvmtProp2d[,Var_[1]], NumSamples, replace=TRUE, + prob=DvmtProp2d[,Var_[2]] ) + # Iterate through each next vehicle to calculate DVMT proportion + for( i in 2:nc ) { + # Iterate through each row of the matrix + VehDvmtProp2d[,i] <- apply( VehDvmtProp2d, 1, function(x) { + # The remaining proportion can't be more than 1 minus the + # sum of the existing proportions + # Round to make sure that logic checks are correct + RemProb <- round( 1 - sum(x), 2 ) + # If this is the last row, then the result has to be RemProb + if( i == nc ) { + Result <- RemProb + # Otherwise calculate remaining probability + } else { + # If the RemProb is 0 then the result must be 0 + if( RemProb == 0 ) { + Result <- 0 + } else { + # If the RemProb is 0.05 then the result must be 0.05 + if( RemProb == 0.05 ) { + Result <- 0.05 + # Otherwise sample from a limited sample frame + } else { + # Identify limited sample values and probabilities + IsPossProb_ <- DvmtProp2d[,Var_[1]] <= RemProb + Values_ <- DvmtProp2d[ IsPossProb_, Var_[1] ] + Prob_ <- DvmtProp2d[ IsPossProb_, Var_[2] ] + Result <- sample( Values_, 1, replace=TRUE, Prob_ ) + } + } + } + # Return the result for the row which is put into the matrix column + Result } ) + } + # Put the results of the matrix into the the list for the vehicle number class + for( i in 1:NumSamples ) VehDvmtProp_[[i]] <- VehDvmtProp2d[i,] + } + # Put the values into the correct locations in the overall output list + VehDvmtPropOutput_[ Hh_df$Hhvehcnt == nc ] <- VehDvmtProp_ + } + # Return the overall output list + return(VehDvmtPropOutput_) +} + +#This function generates various . + +#Main module function that calculates vehicle features +#------------------------------------------------------ +#' Create vehicle table and populate with vehicle type, age, and mileage records. +#' +#' \code{AssignVehicleFeatures} create vehicle table and populate with +#' vehicle type, age, and mileage records. +#' +#' This function creates the 'Vehicle' table in the datastore and populates it +#' with records of vehicle types, ages, mileage, and mileage proportions +#' along with household IDs. +#' +#' @param L A list containing the components listed in the Get specifications +#' for the module. +#' @return A list containing the components specified in the Set +#' specifications for the module. +#' @import visioneval +#' @name AssignVehicleFeatures +#' @import stats +#' @export +AssignVehicleFeatures <- function(L) { + #Set up + #------ + #Fix seed as synthesis involves sampling + set.seed(L$G$Seed) + #Define vector of Mareas + Ma <- L$Year$Marea$Marea + Bz <- L$Year$Bzone$Bzone + #Calculate number of households + NumHh <- length(L$Year$Household[[1]]) + + #Set up data frame of household data needed for model + #---------------------------------------------------- + Hh_df <- data.frame(L$Year$Household) + Hh_df$DrvAgePop <- Hh_df$HhSize - Hh_df$Age0to14 + Hh_df$OnlyElderly <- as.numeric(Hh_df$HhSize == Hh_df$Age65Plus) + # Hh_df$LowInc <- as.numeric(Hh_df$Income <= 20000) + # Hh_df$LogIncome <- log(Hh_df$Income) + # Classify households according to income group + MaxInc <- max( Hh_df$Income ) + IncBreaks_ <- c( 0, 20000, 40000, 60000, 80000, 100000, MaxInc ) + Ig <- c("0to20K", "20Kto40K", "40Kto60K", "60Kto80K", "80Kto100K", "100KPlus") + names(IncBreaks_) <- Ig + Hh_df$IncGrp <- cut( Hh_df$Income, breaks=IncBreaks_, labels=Ig, include.lowest=TRUE ) + + + ######AG to CS/BS Average Density + ###AG to CS/BS should this be a calculated average for the region? + Hh_df$Htppopdn <- 500 + ###AG to CS/BS should this be 0 for rural? Or are we just using an average for both density and this var and then adjusting using 5D values? + Hh_df$Urban <- 1 + # Calculate the natural log of density + Hh_df$LogDen <- log( Hh_df$Htppopdn ) + # Density_ <- L$Year$Bzone$D1B[match(L$Year$Household$HhPlaceTypes, L$Year$Bzone$Bzone)] + # Hh_df$LogDensity <- log(Density_) + FwyLaneMiPC_Bz <- L$Year$Marea$FwyLaneMiPC[match(L$Year$Bzone$Marea, L$Year$Marea$Marea)] + Hh_df$FwyLaneMiPC <- FwyLaneMiPC_Bz[match(L$Year$Household$HhPlaceTypes, L$Year$Bzone$Bzone)] + TranRevMiPC_Bz <- L$Year$Marea$TranRevMiPC[match(L$Year$Bzone$Marea, L$Year$Marea$Marea)] + Hh_df$TranRevMiPC <- TranRevMiPC_Bz[match(L$Year$Household$HhPlaceTypes, L$Year$Bzone$Bzone)] + + Lt1VehProp <- data.frame(VehOwnModels_ls$Lt1Prop) + Gt1VehProp <- data.frame(VehOwnModels_ls$Gt1Prop) + + # Gather vehicle proportions for Lt1 and Gt1 + VehProp <- list( + Metro = list(), + NonMetro = list() + ) + + VehProp$Metro$Lt1 <- Lt1VehProp[Lt1VehProp$Region == "Metro", -1] + VehProp$Metro$Gt1 <- Gt1VehProp[Gt1VehProp$Region == "Metro", -1] + VehProp$NonMetro$Lt1 <- Lt1VehProp[Lt1VehProp$Region == "NonMetro", -1] + VehProp$NonMetro$Gt1 <- Gt1VehProp[Gt1VehProp$Region == "NonMetro", -1] + + # Gather vehicle proportions for vehicle types, income groups, etc.. + VehPropByGroups <- list() + VehPropByGroups$VehCumPropByAge <- data.frame(list(VehAge = VehOwnModels_ls$VehAgeCumProp$VehAge, + Auto = VehOwnModels_ls$VehAgeCumProp$AutoCumProp, + LtTruck = VehOwnModels_ls$VehAgeCumProp$LtTruckCumProp)) + VehPropByGroups$VehPropByAgeIncGrpType <- data.frame(list(VehAge = VehOwnModels_ls$VehAgeTypeProp$VehAge, + IncGrp = VehOwnModels_ls$VehAgeTypeProp$IncGrp, + VehType = VehOwnModels_ls$VehAgeTypeProp$VehType, + Prop = VehOwnModels_ls$VehAgeTypeProp$Prop)) + # Relevel the income groups + VehPropByGroups$VehPropByAgeIncGrpType$IncGrp <- reorder(VehPropByGroups$VehPropByAgeIncGrpType$IncGrp,IncBreaks_[as.character(VehPropByGroups$VehPropByAgeIncGrpType$IncGrp)],FUN = max) + + + rm(IncBreaks_, MaxInc, Ig) + # Identify metropolitan area + IsMetro_ <- Hh_df$Urban == 1 + + # Initialize Hhvehcnt and VehPerDrvAgePop variables + Hh_df$Hhvehcnt <- 0 + Hh_df$VehPerDrvAgePop <- 0 + + #Run the model + #------------- + + # Predict ownership for metropolitan households if any exist + if(any(IsMetro_)){ + ModelVar_ <- c( "Income", "Htppopdn", "TranRevMiPC", "Urban", + "FwyLaneMiPC", "OnlyElderly", "DrvLevels", "DrvAgePop") + MetroVehOwn_ <- predictVehicleOwnership( Hh_df[IsMetro_, ModelVar_], + ModelType = VehOwnModels_ls, VehProp = VehProp, + Type="Metro") + rm(ModelVar_) + } + # Predict ownership for nonmetropolitan households if any exist + if(any(!IsMetro_)){ + ModelVar_ <- c( "Income", "Htppopdn", "OnlyElderly", "DrvLevels", "DrvAgePop" ) + NonMetroVehOwn_ <- predictVehicleOwnership(Hh_df[IsMetro_, ModelVar_], + ModelType = VehOwnModels_ls, VehProp = VehProp, + Type="NonMetro") + rm(ModelVar_) + } + + # Assign values to SynPop.. and return the result + if( any(IsMetro_) ) { + Hh_df$Hhvehcnt[ IsMetro_ ] <- MetroVehOwn_$NumVeh + Hh_df$VehPerDrvAgePop[ IsMetro_ ] <- MetroVehOwn_$VehRatio + } + if( any(!IsMetro_) ) { + Hh_df$Hhvehcnt[ !IsMetro_ ] <- NonMetroVehOwn_$NumVeh + Hh_df$VehPerDrvAgePop[ !IsMetro_ ] <- NonMetroVehOwn_$VehRatio + } + # Clean up + if( exists( "MetroVehOwn_" ) ) rm( MetroVehOwn_ ) + if( exists( "NonMetroVehOwn_" ) ) rm( NonMetroVehOwn_ ) + + # Calculate vehicle types, ages, and initial fuel economy + #======================================================== + + # Predict light truck ownership and vehicle ages + #----------------------------------------------- + # Apply vehicle type model + ModelVar_ <- c( "Income", "Htppopdn", "Urban", "Hhvehcnt", "HhSize" ) + #light truck proportion is a single value in parameters_ + #fix seed as allocation involves sampling + set.seed(L$G$Seed) + Hh_df$VehType <- predictLtTruckOwn( Hh_df[ , ModelVar_ ], ModelType=LtTruckModels_ls, + TruckProp=L$Global$Model$LtTruckProp ) + rm( ModelVar_ ) + # Apply vehicle age model + ModelVar_ <- c( "IncGrp", "Hhvehcnt", "VehType" ) + #fix seed as allocation involves sampling + set.seed(L$G$Seed) + VehTypeAgeResults_ <- calcVehicleAges(Hh_df = Hh_df[, ModelVar_], VProp = VehPropByGroups) + rm( ModelVar_ ) + # Add type and age model results + Hh_df$VehType[ Hh_df$Hhvehcnt == 0 ] <- NA + Hh_df$VehAge <- VehTypeAgeResults_$VehAge + Hh_df$VehAge[ Hh_df$Hhvehcnt == 0 ] <- NA + rm( VehTypeAgeResults_ ) + + # Assign initial fuel economy + #---------------------------- + # Assign fuel economy to vehicles + HhHasVeh <- Hh_df$Hhvehcnt > 0 + Hh_df$VehMpg <- NA + ModelVar_ <- c( "VehType", "VehAge", "Hhvehcnt" ) + VehMpgYr <- cbind(Year = as.integer(L$Global$Vehicles$ModelYear), Auto = L$Global$Vehicles$AutoMpg, LtTruck = L$Global$Vehicles$LtTruckMpg) + Hh_df$VehMpg[HhHasVeh] <- assignFuelEconomy( Hh_df[HhHasVeh, ModelVar_], + VehMpgYr = VehMpgYr, CurrentYear = L$G$Year) + rm( ModelVar_ ) + + # Assign vehicle mileage proportions to household vehicles + Hh_df$DvmtProp <- NA + ModelVar_ <- c("Hhvehcnt", "HhId") + DvmtProp_ <- data.frame(Veh1Value = VehOwnModels_ls$VehicleMpgProp$Veh1Value, + Veh1Prob = VehOwnModels_ls$VehicleMpgProp$Veh1Prob, + Veh2Value = VehOwnModels_ls$VehicleMpgProp$Veh2Value, + Veh2Prob = VehOwnModels_ls$VehicleMpgProp$Veh2Prob, + Veh3Value = VehOwnModels_ls$VehicleMpgProp$Veh3Value, + Veh3Prob = VehOwnModels_ls$VehicleMpgProp$Veh3Prob, + Veh4Value = VehOwnModels_ls$VehicleMpgProp$Veh4Value, + Veh4Prob = VehOwnModels_ls$VehicleMpgProp$Veh4Prob, + Veh5PlusValue = VehOwnModels_ls$VehicleMpgProp$Veh5PlusValue, + Veh5PlusProb = VehOwnModels_ls$VehicleMpgProp$Veh5PlusProb) + #fix seed as allocation involves sampling + set.seed(L$G$Seed) + Hh_df$DvmtProp[ HhHasVeh ] <- apportionDvmt( Hh_df[ HhHasVeh, ModelVar_], + DvmtProp=DvmtProp_ ) + rm( ModelVar_ ) + + # Count the number of vehicle types per houshold + #------------------------------------------------ + + Hh_df$NumAuto <- unlist(lapply(Hh_df$VehType,function(x) sum(x=="Auto"))) + Hh_df$NumAuto[is.na(Hh_df$NumAuto)] <- 0L + Hh_df$NumLtTruck <- Hh_df$Hhvehcnt - Hh_df$NumAuto + + + + + #Return the results + #------------------ + #Identify households having vehicles + Use <- Hh_df$Hhvehcnt != 0 + #Initialize output list + Out_ls <- initDataList() + Out_ls$Year$Vehicle <- list() + attributes(Out_ls$Year$Vehicle)$LENGTH <- sum(Hh_df$Hhvehcnt) + Out_ls$Year$Vehicle$HhId <- + with(L$Year$Household, rep(HhId[Use], Hh_df$Hhvehcnt[Use])) + attributes(Out_ls$Year$Vehicle$HhId)$SIZE <- + max(nchar(Out_ls$Year$Vehicle$HhId)) + Out_ls$Year$Vehicle$VehId <- + with(Hh_df, + paste(rep(HhId[Use], Hhvehcnt[Use]), + unlist(sapply(Hhvehcnt[Use], function(x) 1:x)), + sep = "-")) + attributes(Out_ls$Year$Vehicle$VehId)$SIZE <- + max(nchar(Out_ls$Year$Vehicle$VehId)) + Out_ls$Year$Vehicle$Azone <- + with(L$Year$Household, rep(Azone[Use], Hh_df$Hhvehcnt[Use])) + attributes(Out_ls$Year$Vehicle$Azone)$SIZE <- + max(nchar(Out_ls$Year$Vehicle$Azone)) + Out_ls$Year$Vehicle$Marea <- + with(L$Year$Household, rep(Marea[Use], Hh_df$Hhvehcnt[Use])) + attributes(Out_ls$Year$Vehicle$Marea)$SIZE <- + max(nchar(Out_ls$Year$Vehicle$Marea)) + Out_ls$Year$Vehicle$Type <- unlist(Hh_df$VehType[Use]) + Out_ls$Year$Vehicle$Type[Out_ls$Year$Vehicle$Type=="LtTruck"] <- "LtTrk" + attributes(Out_ls$Year$Vehicle$Type)$SIZE <- max(nchar(Out_ls$Year$Vehicle$Type)) + Out_ls$Year$Vehicle$Age <- unlist(Hh_df$VehAge[Use]) + Out_ls$Year$Vehicle$Mileage <- unlist(Hh_df$VehMpg[Use]) + Out_ls$Year$Vehicle$DvmtProp <- unlist(Hh_df$DvmtProp[Use]) + + Out_ls$Year$Household <- + list(NumLtTrk = Hh_df$NumLtTruck, + NumAuto = Hh_df$NumAuto, + Vehicles = Hh_df$Hhvehcnt) + + + #Return the outputs list + Out_ls +} + +#================================ +#Code to aid development and test +#================================ +#Test code to check specifications, loading inputs, and whether datastore +#contains data needed to run module. Return input list (L) to use for developing +#module functions +# #------------------------------------------------------------------------------- +# TestDat_ <- testModule( +# ModuleName = "AssignVehicleFeatures", +# LoadDatastore = TRUE, +# SaveDatastore = TRUE, +# DoRun = FALSE, +# RunFor = "NotBaseYear" +# ) +# L <- TestDat_$L + +#Test code to check everything including running the module and checking whether +#the outputs are consistent with the 'Set' specifications +#------------------------------------------------------------------------------- +# TestDat_ <- testModule( +# ModuleName = "AssignVehicleOwnership", +# LoadDatastore = TRUE, +# SaveDatastore = TRUE, +# DoRun = TRUE, +# RunFor = "NotBaseYear" +# ) diff --git a/sources/modules/VEHouseholdVehicles-old/R/AssignVehicleFeaturesFuture.R b/sources/modules/VEHouseholdVehicles-old/R/AssignVehicleFeaturesFuture.R new file mode 100644 index 000000000..c2f8557aa --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/R/AssignVehicleFeaturesFuture.R @@ -0,0 +1,423 @@ +#======================== +#AssignVehicleFeaturesFuture.R +#======================== + +# This module is a vehicle model from RPAT version. + +# This module assigns household vehicle ownership, vehicle types, and ages to +# each household vehicle, based on household, land use, +# and transportation system characteristics. Vehicles are classified as either +# a passenger car (automobile) or a light truck (pickup trucks, sport utility +# vehicles, vans, etc.). A 'Vehicle' table is created which has a record for +# each household vehicle. The type and age of each vehicle owned or leased by +# households is assigned to this table along with the household ID (HhId)to +# enable this table to be joined with the household table. + + +# library(visioneval) + + +#============================================= +#SECTION 1: ESTIMATE AND SAVE MODEL PARAMETERS +#============================================= + +## Current implementation +### The current version implements the models used in the RPAT (GreenSTEP) +### ecosystem. + + + +## Future Development +## Use estimation data set to create models + +# Load vehicle ownership model +load("./data/VehOwnModels_ls.rda") + +# Load LtTrk Ownership +#------------------------- +# LtTrk ownership model +load("./data/LtTruckModels_ls.rda") + +#================================================ +#SECTION 2: DEFINE THE MODULE DATA SPECIFICATIONS +#================================================ + +#Define the data specifications +#------------------------------ +AssignVehicleFeaturesFutureSpecifications <- list( + #Level of geography module is applied at + RunBy = "Region", + #Specify new tables to be created by Inp if any + #--------------------------- + #Specify new tables to be created by Set if any + #Specify input data (similar to the assignvehiclefeatures module from this package) + #Specify data to be loaded from data store + Get = items( + item( + NAME = "Marea", + TABLE = "Marea", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = items( + "TranRevMiPCFuture", + "FwyLaneMiPCFuture"), + TABLE = "Marea", + GROUP = "Year", + TYPE = "compound", + UNITS = "MI/PRSN", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "Marea", + TABLE = "Bzone", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "Bzone", + TABLE = "Bzone", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = + items("HhId", + "Azone", + "Marea"), + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "Income", + TABLE = "Household", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD.2001", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "HhType", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBIT = "", + ISELEMENTOF = c("SF", "MF", "GQ") + ), + item( + NAME = "HhSize", + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + PROHIBIT = c("NA", "<= 0"), + ISELEMENTOF = "" + ), + item( + NAME = + items( + "Age0to14", + "Age65Plus"), + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "HhPlaceTypes", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBITED = "NA" + ), + item( + NAME = "DrvLevels", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBITED = "NA", + ISELEMENTOF = c("Drv1", "Drv2", "Drv3Plus") + ), + item( + NAME = "LtTruckProp", + TABLE = "Model", + GROUP = "Global", + TYPE = "double", + UNITS = "multiplier", + PROHIBIT = c('NA', '< 0'), + ISELEMENTOF = "" + ), + item( + NAME = items( + "AutoMpg", + "LtTruckMpg", + "TruckMpg", + "BusMpg", + "TrainMpg" + ), + TABLE = "Vehicles", + GROUP = "Global", + TYPE = "compound", + UNITS = "MI/GAL", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "ModelYear", + TABLE = "Vehicles", + GROUP = "Global", + TYPE = "time", + UNITS = "YR", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ) + ), + #--------------------------- + #Specify data to saved in the data store + Set = items( + item( + NAME = + items("HhIdFuture", + "VehIdFuture", + "AzoneFuture", + "MareaFuture"), + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + NAVALUE = -1, + PROHIBIT = "NA", + ISELEMENTOF = "", + DESCRIPTION = + items("Unique household ID using future data", + "Unique vehicle ID using future data", + "Azone ID using future data", + "Marea ID using future data") + ), + item( + NAME = "VehiclesFuture", + TABLE = "Household", + GROUP = "Year", + TYPE = "vehicles", + UNITS = "VEH", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Number of automobiles and light trucks owned or leased by the household + using future data" + ), + item( + NAME = "TypeFuture", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + NAVALUE = -1, + PROHIBIT = "NA", + ISELEMENTOF = c("Auto", "LtTrk"), + SIZE = 5, + DESCRIPTION = "Vehicle body type: Auto = automobile, LtTrk = light trucks (i.e. pickup, SUV, Van) using future data" + ), + item( + NAME = "AgeFuture", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "time", + UNITS = "YR", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Vehicle age in years using future data" + ), + item( + NAME = items( + "NumLtTrkFuture", + "NumAutoFuture"), + TABLE = "Household", + GROUP = "Year", + TYPE = "vehicles", + UNITS = "VEH", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = items( + "Number of light trucks (pickup, sport-utility vehicle, and van) owned or leased by household using future data", + "Number of automobiles (i.e. 4-tire passenger vehicles that are not light trucks) owned or leased by household using future data" + ) + ), + item( + NAME = "MileageFuture", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "compound", + UNITS = "MI/GAL", + PROHIBIT = c("NA", "<0"), + ISELEMENTOF = "", + DESCRIPTION = "Mileage of vehicles (automobiles and light truck) using future data" + ), + item( + NAME = "DvmtPropFuture", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "double", + UNITS = "proportion", + PROHIBIT = c("NA", "<0", "> 1"), + ISELEMENTOF = "", + DESCRIPTION = "Proportion of average household DVMT using future data" + ) + ) + ) + +#Save the data specifications list +#--------------------------------- +#' Specifications list for AssignVehicleFeaturesFuture module +#' +#' A list containing specifications for the AssignVehicleFeaturesFuture module. +#' +#' @format A list containing 3 components: +#' \describe{ +#' \item{RunBy}{the level of geography that the module is run at} +#' \item{Get}{module inputs to be read from the datastore} +#' \item{Set}{module outputs to be written to the datastore} +#' } +#' @source AssignVehicleFeaturesFuture.R script. +"AssignVehicleFeaturesFutureSpecifications" +usethis::use_data(AssignVehicleFeaturesFutureSpecifications, overwrite = TRUE) + + +#======================================================= +#SECTION 3: DEFINE FUNCTIONS THAT IMPLEMENT THE SUBMODEL +#======================================================= + +#Main module function that calculates vehicle features +#------------------------------------------------------ +#' Create vehicle table and populate with vehicle type, age, and mileage records. +#' +#' \code{AssignVehicleFeaturesFuture} populate vehicle table with +#' vehicle type, age, and mileage records using future data. +#' +#' This function populates vehicle table with records of +#' vehicle types, ages, mileage, and mileage proportions +#' along with household IDs using future data. +#' +#' @param L A list containing the components listed in the Get specifications +#' for the module. +#' @return A list containing the components specified in the Set +#' specifications for the module. +#' @name AssignVehicleFeaturesFuture +#' @import visioneval stats +#' @export +AssignVehicleFeaturesFuture <- function(L) { + #Set up + #------ + # Function to rename variables to be consistent with Get specfications + # of AssignVehicleFeatures. + + # Function to add suffix 'Future' at the end of all the variable names + AddSuffixFuture <- function(x, suffix = "Future"){ + # Check if x is a list + if(is.list(x)){ + if(length(x) > 0){ + # Check if elements of x is a list + isElementList <- unlist(lapply(x,is.list)) + # Modify the names of elements that are not the list + noList <- x[!isElementList] + if(!identical(names(noList),character(0))){ + names(noList) <- paste0(names(noList),suffix) + } + # Repeat the function for elements that are list + yesList <- lapply(x[isElementList], AddSuffixFuture, suffix = suffix) + x <- unlist(list(noList,yesList), recursive = FALSE) + return(x) + } + return(x) + } + return(NULL) + } + + + # Function to remove suffix 'Future' from all the variable names + RemoveSuffixFuture <- function(x, suffix = "Future"){ + # Check if x is a list + if(is.list(x)){ + if(length(x) > 0){ + # Check if elements of x is a list + isElementList <- unlist(lapply(x,is.list)) + # Modify the names of elements that are not the list + noList <- x[!isElementList] + if(length(noList)>0){ + names(noList) <- gsub(suffix,"",names(noList)) + } + # Repeat the function for elements that are list + yesList <- lapply(x[isElementList], RemoveSuffixFuture, suffix = suffix) + x <- unlist(list(noList,yesList), recursive = FALSE) + return(x) + } + return(x) + } + return(NULL) + } + + # Modify the input data set + L <- RemoveSuffixFuture(L) + + + #Return the results + #------------------ + # Call the AssignVehicleFeatures function with the new dataset + Out_ls <- AssignVehicleFeatures(L) + + # Add 'Future' suffix to all the variables + Out_ls <- AddSuffixFuture(Out_ls) + #Return the outputs list + return(Out_ls) +} + +#================================ +#Code to aid development and test +#================================ +#Test code to check specifications, loading inputs, and whether datastore +#contains data needed to run module. Return input list (L) to use for developing +#module functions +#------------------------------------------------------------------------------- +# TestDat_ <- testModule( +# ModuleName = "AssignVehicleFeaturesFuture", +# LoadDatastore = TRUE, +# SaveDatastore = TRUE, +# DoRun = FALSE +# ) +# L <- TestDat_$L + +#Test code to check everything including running the module and checking whether +#the outputs are consistent with the 'Set' specifications +#------------------------------------------------------------------------------- +# TestDat_ <- testModule( +# ModuleName = "AssignVehicleOwnership", +# LoadDatastore = TRUE, +# SaveDatastore = TRUE, +# DoRun = TRUE +# ) diff --git a/sources/modules/VEHouseholdVehicles-old/R/AssignVehicleOwnership.R b/sources/modules/VEHouseholdVehicles-old/R/AssignVehicleOwnership.R new file mode 100644 index 000000000..1276c548d --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/R/AssignVehicleOwnership.R @@ -0,0 +1,507 @@ +#======================== +#AssignVehicleOwnership.R +#======================== +# +# +# +## AssignVehicleOwnership Module +#### November 23, 2018 +# +#This module determines the number of vehicles owned or leased by each household as a function of household characteristics, land use characteristics, and transportation system characteristics. +# +### Model Parameter Estimation +# +#The vehicle ownership model is segmented for metropolitan and non-metropolitan households because additional information about transit supply and the presence of urban mixed-use neighborhoods is available for metropolitan households that is not available for non-metropolitan households. There are two models for each segment. A binary logit model is used to predict which households own no vehicles. An ordered logit model is used to predict how many vehicles a household owns if they own any vehicles. The number of vehicles a household may be assigned is 6. +# +#The metropolitan model for determining whether a household owns no vehicles is documented below. As expected, the probability that a household is carless is greater for low income households (less than $20,000), households living in higher density and/or mixed-use neighborhoods, and households living in metropolitan areas having higher levels of transit service. The probability decreases as the number of drivers in the household increases, household income increases, and if the household lives in a single-family dwelling. The number of drivers has the greatest influence on car ownership. The number of workers increases the probability of no vehicle ownership, but since the model includes drivers, this coefficient probably reflects the effect of non-driving workers on vehicle ownership. +# +# +# +#The non-metropolitan model for zero car ownership is shown below. The model terms are the same as for the metropolitan model with the exception of the urban mixed-use and transit supply variables. The signs of the variables are the same as for the metropolitan model and the values are of similar magnitude. +# +# +# +#The ordered logit model for the number of vehicles owned by metropolitan households that own at least one vehicle is shown below. Households are likely to own more vehicles if they live in a single-family dwelling, have higher incomes, have more workers, and have more drivers. Households are likely to own fewer vehicles if all household members are elderly, they live in a higher density and/or urban mixed-use neighborhood, they live in a metropolitan area with a higher level of transit service, and if more persons are in the household. The latter result is at surprising at first glance, but since the model also includes the number of drivers and number of workers, the household size coefficient is probably showing the effect of non-drivers non-workers in the household. +# +# +# +#The ordered logit model for non-metropolitan household vehicle ownership is described below. The variables are the same as for the metropolitan model with the exception of the urban mixed-use neighborhood and transit variables. The signs of the coefficients are the same and the magnitudes are similar. +# +# +# +### How the Module Works +# +#For each household, the metropolitan or non-metropolitan binary logit model is run to predict the probability that the household owns no vehicles. A random number is drawn from a uniform distribution in the interval from 0 to 1 and if the result is less than the probability of zero-vehicle ownership, the household is assigned no vehicles. Households that have no drivers are also assigned 0 vehicles. The metropolitan or non-metropolitan ordered logit model is run to predict the number of vehicles owned by the household if they own any. +# +# + + +#================================= +#Packages used in code development +#================================= +#Uncomment following lines during code development. Recomment when done. +# library(visioneval) +# library(ordinal) + + +#============================================= +#SECTION 1: ESTIMATE AND SAVE MODEL PARAMETERS +#============================================= +#The vehicle ownership model is segmented for metropolitan and non-metropolitan +#households because additional information about transit supply and the presence +#of urban mixed-use neighborhoods is available for metropolitan households that +#is not available for non-metropolitan households. There are two models for each +#segment. A binary logit model is used to predict which households own no +#vehicles. An ordered logit model is used to predict how many vehicles a +#household owns if they own any vehicles. + +#Create model estimation dataset +#------------------------------- +#Load selected data from VE2001NHTS package +Hh_df <- VE2001NHTS::Hh_df +FieldsToKeep_ <- + c("NumVeh", "Income", "Hbppopdn", "Hhsize", "Hometype", "UrbanDev", "FwyLnMiPC", + "Wrkcount", "Drvrcnt", "Age0to14", "Age65Plus", "MsaPopDen", "BusEqRevMiPC") +Hh_df <- Hh_df[, FieldsToKeep_] +#Create additional data fields +Hh_df$IsSF <- as.numeric(Hh_df$Hometype %in% c("Single Family", "Mobile Home")) +Hh_df$HhSize <- Hh_df$Hhsize +Hh_df$DrvAgePop <- Hh_df$HhSize - Hh_df$Age0to14 +Hh_df$OnlyElderly <- as.numeric(Hh_df$HhSize == Hh_df$Age65Plus) +Hh_df$LogIncome <- log1p(Hh_df$Income) +Hh_df$LogDensity <- log(Hh_df$Hbppopdn) +Hh_df$ZeroVeh <- as.numeric(Hh_df$NumVeh == 0) +Hh_df$LowInc <- as.numeric(Hh_df$Income <= 20000) +Hh_df$Workers <- Hh_df$Wrkcount +Hh_df$Drivers <- Hh_df$Drvrcnt +Hh_df$IsUrbanMixNbrhd <- Hh_df$UrbanDev +Hh_df$TranRevMiPC <- Hh_df$BusEqRevMiPC +rm(FieldsToKeep_) + +#Create a list to store models +#----------------------------- +AutoOwnModels_ls <- + list( + Metro = list(), + NonMetro = list(), + Stats = list() + ) + +#Model metropolitan households +#----------------------------- +#Make metropolitan household estimation dataset +Terms_ <- + c("IsSF", "IsUrbanMixNbrhd", "Workers", "Drivers", "TranRevMiPC", "LogIncome", + "HhSize", "LogDensity", "OnlyElderly", "LowInc", "NumVeh", "ZeroVeh", + "FwyLnMiPC") +EstData_df <- Hh_df[!is.na(Hh_df$TranRevMiPC), Terms_] +EstData_df <- EstData_df[complete.cases(EstData_df),] +rm(Terms_) +#Model zero vehicle households +AutoOwnModels_ls$Metro$Zero <- + glm( + ZeroVeh ~ Workers + LowInc + LogIncome + IsSF + Drivers + IsUrbanMixNbrhd + + LogDensity + TranRevMiPC, + data = EstData_df, + family = binomial + ) +AutoOwnModels_ls$Stats$MetroZeroSummary <- + capture.output(summary(AutoOwnModels_ls$Metro$Zero)) +AutoOwnModels_ls$Stats$MetroZeroAnova <- + capture.output(anova(AutoOwnModels_ls$Metro$Zero, test = "Chisq")) +#Trim down model +AutoOwnModels_ls$Metro$Zero[c("residuals", "fitted.values", + "linear.predictors", "weights", + "prior.weights", "y", "model", + "data")] <- NULL +#Model number of vehicles of non-zero vehicle households +EstData_df <- EstData_df[EstData_df$ZeroVeh == 0,] +EstData_df$VehOrd <- EstData_df$NumVeh +EstData_df$VehOrd[EstData_df$VehOrd > 6] <- 6 +EstData_df$VehOrd <- ordered(EstData_df$VehOrd) +AutoOwnModels_ls$Metro$Count <- + clm( + VehOrd ~ Workers + LogIncome + Drivers + HhSize + OnlyElderly + IsSF + + IsUrbanMixNbrhd + LogDensity + TranRevMiPC, + data = EstData_df, + threshold = "equidistant" + ) +AutoOwnModels_ls$Stats$MetroCountSummary <- + capture.output(summary(AutoOwnModels_ls$Metro$Count)) +#Trim down model +AutoOwnModels_ls$Metro$Count[c("fitted.values", "model", "y")] <- NULL + +#Model non-metropolitan households +#--------------------------------- +#Make non-metropolitan household estimation dataset +Terms_ <- + c("IsSF", "Workers", "Drivers", "LogIncome", "HhSize", "LogDensity", + "OnlyElderly", "LowInc", "NumVeh", "ZeroVeh") +EstData_df <- Hh_df[is.na(Hh_df$TranRevMiPC), Terms_] +EstData_df <- EstData_df[complete.cases(EstData_df),] +#Remove 2 cases with 10 workers in household. Including them in the model +#estimation causes probabilities close to zero which reduces the reliability of +#the estimated model +EstData_df <- EstData_df[EstData_df$Workers != 10,] +rm(Terms_) +#Model zero vehicle households +AutoOwnModels_ls$NonMetro$Zero <- + glm( + ZeroVeh ~ Workers + LowInc + LogIncome + IsSF + Drivers + LogDensity, + data = EstData_df, + family = binomial + ) +AutoOwnModels_ls$Stats$NonMetroZeroSummary <- + capture.output(summary(AutoOwnModels_ls$NonMetro$Zero)) +AutoOwnModels_ls$Stats$NonMetroZeroAnova <- + capture.output(anova(AutoOwnModels_ls$NonMetro$Zero, test = "Chisq")) +#Trim down model +AutoOwnModels_ls$NonMetro$Zero[c("residuals", "fitted.values", + "linear.predictors", "weights", + "prior.weights", "y", "model", + "data")] <- NULL +#Model number of vehicles of non-zero vehicle households +EstData_df <- EstData_df[EstData_df$ZeroVeh == 0,] +EstData_df$VehOrd <- EstData_df$NumVeh +EstData_df$VehOrd[EstData_df$VehOrd > 6] <- 6 +EstData_df$VehOrd <- ordered(EstData_df$VehOrd) +AutoOwnModels_ls$NonMetro$Count <- + clm( + VehOrd ~ Workers + LogIncome + Drivers + HhSize + OnlyElderly + IsSF + + LogDensity, + data = EstData_df, + threshold = "equidistant" + ) +AutoOwnModels_ls$Stats$NonMetroCountSummary <- + capture.output(summary(AutoOwnModels_ls$NonMetro$Count)) +#Trim down model +AutoOwnModels_ls$NonMetro$Count[c("fitted.values", "model", "y")] <- NULL +#Clean up +rm(Hh_df, EstData_df) + +#Save the auto ownership model +#----------------------------- +#' Auto ownership model +#' +#' A list containing the auto ownership model equation and other information +#' needed to implement the auto ownership model. +#' +#' @format A list having the following components: +#' \describe{ +#' \item{Metro}{a list containing two models for metropolitan areas: a Zero +#' component that is a binomial logit model for determining which households +#' own no vehicles and a Count component that is an ordered logit model for +#' determining how many vehicles a household who has vehicles owns} +#' \item{NonMetro}{a list containing two models for non-metropolitan areas: a +#' Zero component that is a binomial logit model for determining which households +#' own no vehicles and a Count component that is an ordered logit model for +#' determining how many vehicles a household who has vehicles owns} +#' } +#' @source AssignVehicleOwnership.R script. +"AutoOwnModels_ls" +usethis::use_data(AutoOwnModels_ls, overwrite = TRUE) + + +#================================================ +#SECTION 2: DEFINE THE MODULE DATA SPECIFICATIONS +#================================================ + +#Define the data specifications +#------------------------------ +AssignVehicleOwnershipSpecifications <- list( + #Level of geography module is applied at + RunBy = "Region", + #Specify new tables to be created by Inp if any + #Specify new tables to be created by Set if any + #Specify input data + #Specify data to be loaded from data store + Get = items( + item( + NAME = "Marea", + TABLE = "Marea", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "TranRevMiPC", + TABLE = "Marea", + GROUP = "Year", + TYPE = "compound", + UNITS = "MI/PRSN/YR", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "Marea", + TABLE = "Bzone", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "Bzone", + TABLE = "Bzone", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "D1B", + TABLE = "Bzone", + GROUP = "Year", + TYPE = "compound", + UNITS = "PRSN/SQMI", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "Bzone", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "Workers", + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "Drivers", + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "Income", + TABLE = "Household", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD.2001", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "HouseType", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBIT = "", + ISELEMENTOF = c("SF", "MF", "GQ") + ), + item( + NAME = "HhSize", + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + PROHIBIT = c("NA", "<= 0"), + ISELEMENTOF = "" + ), + item( + NAME = "Age65Plus", + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "IsUrbanMixNbrhd", + TABLE = "Household", + GROUP = "Year", + TYPE = "integer", + UNITS = "binary", + PROHIBIT = "NA", + ISELEMENTOF = c(0, 1) + ), + item( + NAME = "LocType", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBIT = "NA", + ISELEMENTOF = c("Urban", "Town", "Rural") + ) + ), + #Specify data to saved in the data store + Set = items( + item( + NAME = "Vehicles", + TABLE = "Household", + GROUP = "Year", + TYPE = "vehicles", + UNITS = "VEH", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Number of automobiles and light trucks owned or leased by the household including high level car service vehicles available to driving-age persons" + ) + ) +) + +#Save the data specifications list +#--------------------------------- +#' Specifications list for AssignVehicleOwnership module +#' +#' A list containing specifications for the AssignVehicleOwnership module. +#' +#' @format A list containing 3 components: +#' \describe{ +#' \item{RunBy}{the level of geography that the module is run at} +#' \item{Get}{module inputs to be read from the datastore} +#' \item{Set}{module outputs to be written to the datastore} +#' } +#' @source AssignVehicleOwnership.R script. +"AssignVehicleOwnershipSpecifications" +usethis::use_data(AssignVehicleOwnershipSpecifications, overwrite = TRUE) + + +#======================================================= +#SECTION 3: DEFINE FUNCTIONS THAT IMPLEMENT THE SUBMODEL +#======================================================= +#This function assigns the number of vehicles a household owns. + +#Main module function that calculates vehicle ownership +#------------------------------------------------------ +#' Calculate the number of vehicles owned by the household. +#' +#' \code{AssignVehicleOwnership} calculate the number of vehicles owned by each +#' household. +#' +#' This function calculates the number of vehicles owned by each household +#' given the characteristic of the household and the area where it resides. +#' +#' @param L A list containing the components listed in the Get specifications +#' for the module. +#' @return A list containing the components specified in the Set +#' specifications for the module. +#' @name AssignVehicleOwnership +#' @import visioneval ordinal +#' @export +AssignVehicleOwnership <- function(L) { + #Set up + #------ + #Fix seed as synthesis involves sampling + set.seed(L$G$Seed) + #Define vector of Mareas + Ma <- L$Year$Marea$Marea + Bz <- L$Year$Bzone$Bzone + #Calculate number of households + NumHh <- length(L$Year$Household[[1]]) + + #Set up data frame of household data needed for model + #---------------------------------------------------- + Hh_df <- data.frame(L$Year$Household) + Hh_df$IsSF <- as.numeric(Hh_df$HouseType == "SF") + Hh_df$OnlyElderly <- as.numeric(Hh_df$HhSize == Hh_df$Age65Plus) + Hh_df$LowInc <- as.numeric(Hh_df$Income <= 20000) + Hh_df$LogIncome <- log1p(Hh_df$Income) + Density_ <- L$Year$Bzone$D1B[match(L$Year$Household$Bzone, L$Year$Bzone$Bzone)] + Hh_df$LogDensity <- log(Density_) + TranRevMiPC_Bz <- L$Year$Marea$TranRevMiPC[match(L$Year$Bzone$Marea, L$Year$Marea$Marea)] + Hh_df$TranRevMiPC <- TranRevMiPC_Bz[match(L$Year$Household$Bzone, L$Year$Bzone$Bzone)] + + #Run the model + #------------- + #Probability no vehicles + NoVehicleProb_ <- numeric(NumHh) + NoVehicleProb_[Hh_df$LocType == "Urban"] <- + predict(AutoOwnModels_ls$Metro$Zero, + newdata = Hh_df[Hh_df$LocType == "Urban",], + type = "response") + if (any(Hh_df$LocType!="Urban")) { + NoVehicleProb_[Hh_df$LocType %in% c("Town", "Rural")] <- + predict(AutoOwnModels_ls$NonMetro$Zero, + newdata = Hh_df[Hh_df$LocType %in% c("Town", "Rural"),], + type = "response") + } + #Vehicle counts + Vehicles_ <- integer(NumHh) + Vehicles_[Hh_df$LocType == "Urban"] <- + as.integer(predict(AutoOwnModels_ls$Metro$Count, + newdata = Hh_df[Hh_df$LocType == "Urban",], + type = "class")$fit) + if (any(Hh_df$LocType!="Urban")) { + Vehicles_[Hh_df$LocType %in% c("Town", "Rural")] <- + as.integer(predict(AutoOwnModels_ls$NonMetro$Count, + newdata = Hh_df[Hh_df$LocType %in% c("Town", "Rural"),], + type = "class")$fit) + #Set count to zero for households modeled as having no vehicles + Vehicles_[NoVehicleProb_ >= runif(NumHh)] <- 0 + #Set count to zero for households having no drivers + Vehicles_[L$Year$Household$Drivers == 0] <- 0 + } + #Return the results + #------------------ + #Initialize output list + Out_ls <- initDataList() + Out_ls$Year$Household <- + list(Vehicles = Vehicles_) + #Return the outputs list + Out_ls +} + +#=============================================================== +#SECTION 4: MODULE DOCUMENTATION AND AUXILLIARY DEVELOPMENT CODE +#=============================================================== +#Run module automatic documentation +#---------------------------------- +documentModule("AssignVehicleOwnership") + +#Test code to check specifications, loading inputs, and whether datastore +#contains data needed to run module. Return input list (L) to use for developing +#module functions +#------------------------------------------------------------------------------- +# #Load packages and test functions +# library(filesstrings) +# library(visioneval) +# library(ordinal) +# source("tests/scripts/test_functions.R") +# #Set up test environment +# TestSetup_ls <- list( +# TestDataRepo = "../Test_Data/VE-State", +# DatastoreName = "Datastore.tar", +# LoadDatastore = TRUE, +# TestDocsDir = "vestate", +# ClearLogs = TRUE, +# # SaveDatastore = TRUE +# SaveDatastore = FALSE +# ) +# setUpTests(TestSetup_ls) +# #Run test module +# TestDat_ <- testModule( +# ModuleName = "AssignVehicleOwnership", +# LoadDatastore = TRUE, +# SaveDatastore = FALSE, +# DoRun = FALSE +# ) +# L <- TestDat_$L +# R <- AssignVehicleOwnership(L) +# +# TestDat_ <- testModule( +# ModuleName = "AssignVehicleOwnership", +# LoadDatastore = TRUE, +# SaveDatastore =TRUE, +# DoRun = TRUE +# ) diff --git a/sources/modules/VEHouseholdVehicles-old/R/AssignVehicleType.R b/sources/modules/VEHouseholdVehicles-old/R/AssignVehicleType.R new file mode 100644 index 000000000..3f1701ba0 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/R/AssignVehicleType.R @@ -0,0 +1,561 @@ +#=================== +#AssignVehicleType.R +#=================== +# +# +# +## AssignVehicleType Module +#### November 23, 2018 +# +#This module identifies how many household vehicles are light trucks and how many are automobiles. Light trucks include pickup trucks, sport utility vehicles, vans, and any other vehicle not classified as a passenger car. Automobiles are vehicles classified as passenger cars. The crossover vehicle category [blurs the line between light trucks and passenger vehicles](https://www.eia.gov/todayinenergy/detail.php?id=31352). Their classification as light trucks or automobiles depends on the agency doing the classification and purpose of the classification. These vehicles were not a significant portion of the market when the model estimation data were collected and so are not explictly considered. How they are classified is up to the model user who is responsible for specifying the light truck proportion of the vehicle fleet. +# +### Model Parameter Estimation +# +#A binary logit models are estimated to predict the probability that a household vehicle is a light truck. A summary of the estimated model follows. The probability that a vehicle is a light truck increases if: +# +#* The ratio of the number of persons in the household to the number of vehicles in the household increases; +# +#* The number of children in the household increases; +# +#* The ratio of vehicles to drivers increases, especially if the number of vehicles is greater than the number of drivers; and, +# +#* The household lives in a single-family dwelling. +# +#The probability decreases if: +# +#* The household only owns one vehicle; +# +#* The household has low income (less than $20,000 in year 2000 dollars); +# +#* The household lives in a higher density neighborhood; and, +# +#* The household lives in an urban mixed-use neighborhood. +# +# +# +#The model and all of its independent variables are significant, but it only explains a modest proportion of the observed variation in light truck ownership. When the model is applied to the estimation dataset, it correctly predicts the number of light trucks for about 46% of the households. Over predictions and under predictions are approximately equal as shown in the following table. +# +# +# +### How the Module Works +# +#The user inputs the light truck proportion of vehicles observed or assumed each each Azone. The module calls the `applyBinomialModel` function (part of the *visioneval* framework package), passing it the estimated binomial logit model and a data frame of values for the independent variables, and the user-supplied light truck proportion. The `applyBinomialModel` function uses a binary search algorithm to adjust the intercept of the model so that the resulting light truck proportion of all household vehicles in the Azone equals the user input. +# +# + + +#============================================= +#SECTION 1: ESTIMATE AND SAVE MODEL PARAMETERS +#============================================= +#This model predicts vehicle type (auto or light truck) for household +#vehicles based on characteristics of the household, the place where the +#household resides, the number of vehicles it owns, and areawide targets for +#light truck ownership. + +#Define a function to estimate vehicle type choice model +#------------------------------------------------------- +#' Estimate vehicle type choice model +#' +#' \code{estimateVehicleTypeModel} estimates a binomial logit model for choosing +#' between light trucks and automobiles. +#' +#' This function estimates a binomial logit model for predicting vehicle type +#' choice (automobile or light truck) as a function of the characteristics of +#' the household, the number of vehicles it owns, the place where the household +#' resides, and targets for light-truck ownership. +#' +#' @param EstData_df A data frame containing estimation data. +#' @param Counts_mx A numeric matrix of counts of household light trucks and +#' automobiles for each household. +#' @param StartTerms_ A character vector of the terms of the model to be +#' tested in the model. The function estimates the model using these terms +#' and then drops all terms whose p value is greater than 0.05. +#' @return A list which has the following components: +#' Type: a string identifying the type of model ("binomial"), +#' Formula: a string representation of the model equation, +#' PrepFun: a function that prepares inputs to be applied in the binomial model, +#' OutFun: a function that transforms the result of applying the binomial model. +#' Summary: the summary of the binomial model estimation results. +#' @import visioneval +#Define function to estimate the income model +estimateVehicleTypeModel <- function(EstData_df, Counts_mx, StartTerms_) { + #Define function to prepare inputs for estimating model + prepIndepVar <- + function(In_df) { + Out_df <- In_df + Out_df$Intercept <- 1 + Out_df + } + #Define function to make the model formula + makeFormula <- + function(StartTerms_) { + FormulaString <- + paste("Counts_mx ~ ", paste(StartTerms_, collapse = "+")) + as.formula(FormulaString) + } + #Estimate model + VehicleTypeModel <- + glm(makeFormula(StartTerms_), family = binomial, data = EstData_df) + #Return model + list( + Type = "binomial", + Formula = makeModelFormulaString(VehicleTypeModel), + Choices = c("LtTrk", "Auto"), + PrepFun = prepIndepVar, + Summary = capture.output(summary(VehicleTypeModel)), + RepeatVar = "Vehicles" + ) +} + +#Estimate the binomial logit model +#--------------------------------- +#Load and select NHTS household data +HhVars_ <- + c("Houseid", "Hbppopdn", "Hhsize", "Age0to14", "Age15to19", "Hhsize", + "Income", "Drvrcnt", "Wrkcount", "Hometype", "UrbanDev", "NumAuto", + "NumLightTruck", "NumVeh") +Hh_df <- VE2001NHTS::Hh_df[, HhVars_] +Hh_df <- Hh_df[complete.cases(Hh_df),] +Hh_df <- Hh_df[Hh_df$NumVeh != 0,] +Hh_df <- Hh_df[Hh_df$Drvrcnt >= 1,] +rm(HhVars_) +#Create independent variables that will be used in estimation +Hh_df$Density <- Hh_df$Hbppopdn +Hh_df$LogDensity <- log(Hh_df$Density) +Hh_df$HhSize <- Hh_df$Hhsize +Hh_df$DrvAgePop <- Hh_df$HhSize - Hh_df$Age0to14 +Hh_df$IsSF <- as.numeric(Hh_df$Hometype %in% c("Single Family", "Mobile Home")) +Hh_df$LogIncome <- log(Hh_df$Income) +Hh_df$Workers <- Hh_df$Wrkcount +Hh_df$IsUrbanMixNbrhd <- Hh_df$UrbanDev +Hh_df$Vehicles <- Hh_df$NumVeh +Hh_df$VehPerDrvAgePop <- Hh_df$Vehicles / Hh_df$DrvAgePop +Hh_df$VehPerDvr <- Hh_df$Vehicles / Hh_df$Drvrcnt +Hh_df$NumChild <- Hh_df$Age0to14 + Hh_df$Age15to19 +Hh_df$NumAdult <- Hh_df$HhSize - Hh_df$NumChild +Hh_df$IsLowIncome <- as.numeric(Hh_df$Income <= 20000) +Hh_df$OnlyOneVeh <- as.numeric(Hh_df$Vehicles == 1) +Hh_df$NumVehGtNumDvr <- as.numeric(Hh_df$Vehicles > Hh_df$Drvrcnt) +Hh_df$NumVehEqNumDvr <- as.numeric(Hh_df$Vehicles == Hh_df$Drvrcnt) +Hh_df$NumVehLtNumDvr <- as.numeric(Hh_df$Vehicles < Hh_df$Drvrcnt) +Hh_df$PrsnPerVeh <- Hh_df$Hhsize / Hh_df$Vehicles +#Create dependent variable matrix of choice proportions +DepVar_mx <- cbind(Hh_df$NumLightTruck, Hh_df$NumAuto) +colnames(DepVar_mx) <- c("LtTrk", "Auto") +#Select independent variables +VehicleTypeModelTerms_ <- + c( + "PrsnPerVeh", + "NumChild", + "NumVehGtNumDvr", + "NumVehEqNumDvr", + "IsSF", + "OnlyOneVeh", + "IsLowIncome", + "LogDensity", + "IsUrbanMixNbrhd" + ) +#Estimate model +VehicleTypeModel_ls <- estimateVehicleTypeModel(Hh_df, DepVar_mx, VehicleTypeModelTerms_) + +#Check the model +#--------------- +#Apply the model to household data applied as many times as there are vehicles +#in the household to predict the numbers of light trucks and automobiles. +#Household light truck predictions to observed numbers of light trucks. Tabulate +#the proportion of households with the correct number of light truck +#predictions, the proportion of households for which the number of light trucks +#is under predicted, and the proportion of households for which the number of +#light trucks is over predicted +VehicleTypeModel_ls$PredictionTest <- local({ + #Predict values, sum number of predicted and observed light trucks by households + Pred <- applyBinomialModel(VehicleTypeModel_ls, Hh_df) + ObsLtTrk_Hh <- Hh_df$NumLightTruck + PredLtTrk_Hh <- + tapply(Pred == "LtTrk", rep(Hh_df$Houseid, Hh_df$Vehicles), sum)[Hh_df$Houseid] + #Table of predicted vs. observed number of trucks + Tab <- table(PredLtTrk_Hh, ObsLtTrk_Hh) + #Calculate the proportions of correctly predicted, underpredicted, and + #overpredicted number of light trucks in households + PredResults_ <- c( + sum(upper.tri(Tab) * Tab), + sum(diag(Tab)), + sum(lower.tri(Tab) * Tab) + ) + data.frame( + Prediction = c("Under Predict", "Correctly Predict", "Over Predict"), + Proportion = round(PredResults_ / sum(Tab), 3) + ) +}) +#Clean up +rm(VehicleTypeModelTerms_, DepVar_mx) + +#Estimate the search range for matching target housing proportions +#----------------------------------------------------------------- +#The housing choice model can be adjusted (self-calibrated) to match a target +#single family housing proportion. This uses capabilities in the visioneval +#applyBinomialModel() function and the binarySearch() function to adjust the +#intercept of the model to match the input proportion. To do so the model needs +#to specify a search range. +#Check search range of values to use +VehicleTypeModel_ls$SearchRange <- c(-10, 10) +# applyBinomialModel( +# VehicleTypeModel_ls, +# Hh_df, +# TargetProp = NULL, +# CheckTargetSearchRange = TRUE) +#Check that low target can be matched with search range +Target <- 0.01 +LowResult_ <- applyBinomialModel( + VehicleTypeModel_ls, + Hh_df, + TargetProp = Target +) +Result <- round(table(LowResult_) / length(LowResult_), 2) +#paste("Target =", Target, "&", "Result =", Result[2]) +rm(Target, LowResult_, Result) +#Check that high target can be matched with search range +Target <- 0.99 +HighResult_ <- applyBinomialModel( + VehicleTypeModel_ls, + Hh_df, + TargetProp = Target +) +Result <- round(table(HighResult_) / length(HighResult_), 2) +#paste("Target =", Target, "&", "Result =", Result[2]) +rm(Target, HighResult_, Result) +rm(Hh_df) + +#Save the vehicle type choice model +#---------------------------------- +#' Vehicle type choice model +#' +#' A list containing the vehicle type choice model equation and other information +#' needed to implement the vehicle type choice model. +#' +#' @format A list having the following components: +#' \describe{ +#' \item{Type}{a string identifying the type of model ("binomial")} +#' \item{Formula}{makeModelFormulaString(VehicleTypeModel)} +#' \item{PrepFun}{a function that prepares inputs to be applied in the model} +#' \item{Summary}{the summary of the binomial logit model estimation results} +#' \item{SearchRange}{a two-element vector specifying the range of search values} +#' } +#' @source AssignVehicleType.R script. +"VehicleTypeModel_ls" +usethis::use_data(VehicleTypeModel_ls, overwrite = TRUE) + +#================================================ +#SECTION 2: DEFINE THE MODULE DATA SPECIFICATIONS +#================================================ + +#Define the data specifications +#------------------------------ +AssignVehicleTypeSpecifications <- list( + #Level of geography module is applied at + RunBy = "Region", + #Specify new tables to be created by Inp if any + #Specify new tables to be created by Set if any + #Specify input data + Inp = items( + item( + NAME = "LtTrkProp", + FILE = "azone_hh_lttrk_prop.csv", + TABLE = "Azone", + GROUP = "Year", + TYPE = "double", + UNITS = "proportion", + NAVALUE = -1, + SIZE = 0, + PROHIBIT = c("NA", "<= 0", ">= 1"), + ISELEMENTOF = "", + UNLIKELY = "", + TOTAL = "", + DESCRIPTION = + "Proportion of household vehicles that are light trucks (pickup, SUV, van)" + ) + ), + #Specify data to be loaded from data store + Get = items( + item( + NAME = "Azone", + TABLE = "Azone", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "LtTrkProp", + TABLE = "Azone", + GROUP = "Year", + TYPE = "double", + UNITS = "proportion", + PROHIBIT = c("NA", "<= 0", ">= 1"), + ISELEMENTOF = "" + ), + item( + NAME = "D1B", + TABLE = "Bzone", + GROUP = "Year", + TYPE = "compound", + UNITS = "PRSN/SQMI", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = items( + "Bzone", + "Azone"), + TABLE = "Bzone", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "HhId", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = items( + "Bzone", + "Azone"), + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "HhSize", + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + PROHIBIT = c("NA", "<= 0"), + ISELEMENTOF = "" + ), + item( + NAME = items( + "Age0to14", + "Age15to19"), + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "Income", + TABLE = "Household", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD.2001", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "HouseType", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBIT = "", + ISELEMENTOF = c("SF", "MF", "GQ") + ), + item( + NAME = "IsUrbanMixNbrhd", + TABLE = "Household", + GROUP = "Year", + TYPE = "integer", + UNITS = "binary", + PROHIBIT = "NA", + ISELEMENTOF = c(0, 1) + ), + item( + NAME = "Vehicles", + TABLE = "Household", + GROUP = "Year", + TYPE = "vehicles", + UNITS = "VEH", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "Drivers", + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ) + ), + #Specify data to saved in the data store + Set = items( + item( + NAME = items( + "NumLtTrk", + "NumAuto"), + TABLE = "Household", + GROUP = "Year", + TYPE = "vehicles", + UNITS = "VEH", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = items( + "Number of light trucks (pickup, sport-utility vehicle, and van) owned or leased by household", + "Number of automobiles (i.e. 4-tire passenger vehicles that are not light trucks) owned or leased by household" + ) + ) + ) +) + +#Save the data specifications list +#--------------------------------- +#' Specifications list for AssignVehicleType module +#' +#' A list containing specifications for the AssignVehicleType module. +#' +#' @format A list containing 5 components: +#' \describe{ +#' \item{RunBy}{the level of geography that the module is run at} +#' \item{Inp}{model inputs to be saved to the datastore} +#' \item{Get}{module inputs to be read from the datastore} +#' \item{Set}{module outputs to be written to the datastore} +#' } +#' @source AssignVehicleType.R script. +"AssignVehicleTypeSpecifications" +usethis::use_data(AssignVehicleTypeSpecifications, overwrite = TRUE) + + +#======================================================= +#SECTION 3: DEFINE FUNCTIONS THAT IMPLEMENT THE SUBMODEL +#======================================================= +#This function assigns the numbers of automobiles and light trucks to each +#household. + +#Main module function that identifies number of household autos and light trucks +#------------------------------------------------------------------------------- +#' Assign number of autos and light trucks for each household. +#' +#' \code{AssignVehicleType} assigns the numbers of autos and light trucks in +#' each household. +#' +#' This function assigns the numbers of autos and light trucks in each +#' household. +#' +#' @param L A list containing the components listed in the Get specifications +#' for the module. +#' @return A list containing the components specified in the Set +#' specifications for the module. +#' @name AssignVehicleType +#' @import visioneval +#' @export +AssignVehicleType <- function(L) { + #Set up + #------ + #Fix seed as synthesis involves sampling + set.seed(L$G$Seed) + + #Iterate through Azones to estimate model matching Azone light-truck average + #--------------------------------------------------------------------------- + NumLtTrk_Hh <- with(L$Year$Household, setNames(numeric(length(HhId)), HhId)) + NumAuto_Hh <- with(L$Year$Household, setNames(numeric(length(HhId)), HhId)) + Az <- L$Year$Azone$Az + for (az in Az) { + #Set up data frame of household data needed for model + Use <- L$Year$Household$Azone == az & L$Year$Household$Vehicles > 0 + Data_df <- data.frame(lapply(L$Year$Household, function(x) x[Use])) + #Add variables needed for vehicle type model + Data_df$PrsnPerVeh <- Data_df$HhSize / Data_df$Vehicles + Data_df$NumChild <- Data_df$Age0to14 + Data_df$Age15to19 + Data_df$NumVehGtNumDvr <- as.numeric(Data_df$Vehicles > Data_df$Drivers) + Data_df$NumVehEqNumDvr <- as.numeric(Data_df$Vehicles == Data_df$Drivers) + Data_df$IsSF <- as.numeric(Data_df$HouseType == "SF") + Data_df$OnlyOneVeh <- as.numeric(Data_df$Vehicles == 1) + Data_df$IsLowIncome <- as.numeric(Data_df$Income <= 20000) + Data_df$Density <- L$Year$Bzone$D1B[match(Data_df$Bzone, L$Year$Bzone$Bzone)] + Data_df$Density[Data_df$Density == 0] <- 1e-6 + Data_df$LogDensity <- log(Data_df$Density) + #Run the model + VehType_Hx <- + applyBinomialModel( + VehicleTypeModel_ls, + Data_df, + TargetProp = L$Year$Azone$LtTrkProp[L$Year$Azone$Azone == az] + ) + #Tabulate autos and light trucks by household + HhId_Hx <- rep(Data_df$HhId, Data_df$Vehicles) + NumLtTrk_Hx <- tapply(VehType_Hx == "LtTrk", HhId_Hx, sum) + NumAuto_Hx <- tapply(VehType_Hx == "Auto", HhId_Hx, sum) + NumLtTrk_Hh[names(NumLtTrk_Hx)] <- NumLtTrk_Hx + NumAuto_Hh[names(NumAuto_Hx)] <- NumAuto_Hx + } + + #Return the results + #------------------ + #Initialize output list + Out_ls <- initDataList() + Out_ls$Year$Household <- + list(NumLtTrk = unname(NumLtTrk_Hh), + NumAuto = unname(NumAuto_Hh)) + #Return the outputs list + Out_ls +} + +#=============================================================== +#SECTION 4: MODULE DOCUMENTATION AND AUXILLIARY DEVELOPMENT CODE +#=============================================================== +#Run module automatic documentation +#---------------------------------- +documentModule("AssignVehicleType") + +#Test code to check specifications, loading inputs, and whether datastore +#contains data needed to run module. Return input list (L) to use for developing +#module functions +#------------------------------------------------------------------------------- +# #Load packages and test functions +# library(filesstrings) +# library(visioneval) +# library(ordinal) +# source("tests/scripts/test_functions.R") +# #Set up test environment +# TestSetup_ls <- list( +# TestDataRepo = "../Test_Data/VE-State", +# DatastoreName = "Datastore.tar", +# LoadDatastore = TRUE, +# TestDocsDir = "vestate", +# ClearLogs = TRUE, +# # SaveDatastore = TRUE +# SaveDatastore = FALSE +# ) +# setUpTests(TestSetup_ls) +# #Run test module +# TestDat_ <- testModule( +# ModuleName = "AssignVehicleType", +# LoadDatastore = TRUE, +# SaveDatastore = FALSE, +# DoRun = FALSE +# ) +# L <- TestDat_$L +# R <- AssignVehicleType(L) +# +# TestDat_ <- testModule( +# ModuleName = "AssignVehicleType", +# LoadDatastore = TRUE, +# SaveDatastore = TRUE, +# DoRun = TRUE +# ) diff --git a/sources/modules/VEHouseholdVehicles-old/R/CalculateVehicleOwnCost.R b/sources/modules/VEHouseholdVehicles-old/R/CalculateVehicleOwnCost.R new file mode 100644 index 000000000..3f2d11ed9 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/R/CalculateVehicleOwnCost.R @@ -0,0 +1,1052 @@ +#========================= +#CalculateVehicleOwnCost.R +#========================= +# +# +# +## CalculateVehicleOwnCost Module +#### November 23, 2018 +# +#This module calculates average vehicle ownership cost for each vehicle based on the vehicle type and age using data from the American Automobile Association (AAA). To this are added the cost of parking at the vehicle residence if free parking is not available for all household vehicles. The ownership cost is converted into an average ownership cost per mile by predicting the household DVMT given the number of owned vehicles and splitting the miles equally among the vehicles. Vehicle ownership costs are used by the AdjustVehicleOwnership module to determine whether it would be more cost-effective for a household to substitute the use of car services for one or more of vehicles that they otherwise would own. +# +#The module also assigns pay-as-you-drive (PAYD) insurance to households based on household characteristics and input assumption about the proportion of households who have PAYD insurance. PAYD insurance does not affect the cost of vehicle ownership when determining whether a household will substitute car services for one or more of their vehicles. It does affect the operating cost of the vehicle and determination of whether the amount of vehicle travel fits within the household's vehicle operations budget. +# +### Model Parameter Estimation +# +#Vehicle ownership cost data from the American Automobile Association (AAA) are used along with information on vehicle depreciation rates to develop a model of vehicle ownership cost as a function of vehicle type, vehicle age, and miles driven. +# +#The AAA cost data is described in the *aaa_vehicle_ownership_costs.txt* file in the *inst/extdata* directory of this package. Data are included on insurance, license/registration/taxes, finance, and depreciation (at 3 annual mileage rates) for 7 light duty body types (small sedan, medium sedan, large sedan, small SUV, medium SUV, minivan, and pickup). Data are also included for hybrids and electric vehicles but these are not used in the model because these vehicle types are relatively new (especially electric vehicles) and are not split out by body type. The following table show these data which are for the year [2017](http://exchange.aaa.com/wp-content/uploads/2017/08/17-0013_Your-Driving-Costs-Brochure-2017-FNL-CX-1.pdf). +# +# +# +#The AAA data body type values are aggregated into vehicle type (auto, light truck) values by taking the midpoint of the range of values for the body types corresponding to each vehicle type. The values for the 3 sedan body types are aggregated to calculate the auto type value. Likewise, the values for the 4 other body types are aggregated to calculate the light truck type value. +# +#Building an ownership cost model requires additional information because the AAA data only address cost during the first 5 years of a vehicle's life and only 3 levels for annual miles driven whereas the cost model needs to address vehicles up to 30 years old and a continuous range of annual vehicle miles driven. The model is created by combining the AAA data with average vehicle depreciation rate data from the [National Automobile Dealers Association *Used Vehicle Price Report: Age-level Analysis and Forecast, Q3 2013*](https://www.nada.com/b2b/Portals/0/assets/pdf/Q3%20Whitepaper%20Age-level%20Analysis%20and%20Forecast.pdf). This report estimates that light-duty vehicles depreciate at an average rate of 15% per year. +# +#The first step in building a model is to calculate the average vehicle value by year and body type for vehicles having a midrange value for annual mileage (15,000). This starts with calculating the new car value for each of the body types. To do this, the total depreciation for the first five years is calculated by multiplying the reported annual depreciation values by 5 since the AAA data represent annual costs over the first 5 years of the vehicle life. From that, the corresponding new vehicle value is calculated using the assumed annual depreciation rate of 15%. The new vehicle values by vehicle type (auto, light truck) are computed by taking the midpoint of the ranges of the the corresponding body types. The following table shows the estimated 2017 new car prices by body type and vehicle type. +# +# +# +#Once the new car value by vehicle type has been calculated, the values by vehicle age are computed by applying the annual depreciation rate. Then the annual depreciation values are computed as the differences in annual vehicle values. The following figure illustrates the annual depreciation for auto and light truck that are driven 15,000 miles per year. +# +# +# +#The depreciation models adjusts depreciation to account for the effect of miles driven. As can be seen from the examination of the AAA data, depreciation increases at an increasing rate as annual mileage increases. To account for the effect of miles driven on depreciation, a linear model is estimated to predict the ratio of depreciation at the annual mileage driven to depreciation at 15,000 miles driven. This model is used to adjust the depreciation schedule shown in the figure above. The steps in creating this depreciation adjustment model are as follows: +# +#* The AAA data on depreciation by body type and mileage is aggregated to the vehicle types (auto, light truck) by taking the midpoint of the range of values for the corresponding body types. +# +#* The ratios of annual depreciation to depreciation at 15,000 miles are calculated. +# +#* The relationship between mileage and depreciation ratio is linearized by power-transforming the mileage. Mileage is divided by 1000 to reduce the size of the power-transformed result. The linearizing power transform is estimated using binary search to find the value at which the slopes are equal. +# +#* A linear regression model is estimated to find the slope and intercept of the line describing the relationship between mileage and relative depreciation. +# +#The following figure illustrates the resulting estimated relationship between depreciation and miles driven for 5-year old autos and light trucks. +# +# +# +#A finance cost model calculates finance cost as a function of the vehicle age. To estimate this model, first the AAA values for finance cost by body type are aggregated to vehicle types. This is done by taking the midpoint values of the body types that correspond to each vehicle type. Since the AAA data represent the first 5 years of a vehicle's life and since auto loans typically have a duration of 5 years, it is assumed that the AAA data represent the average finance cost for a new vehicle. Therefore the annual finance cost for different vehicle can be calculated by multiplying the new car finance cost by the estimated proportion of new car value for the vehicle age. It is important to note that finance cost is the cost of financing the vehicle loan, not the cost of purchasing the car. Depreciation accounts for purchase cost and residual value. +# +#To calculate the cost of insurance, the AAA values for insurance cost by body type are aggregated to vehicle types in the manner described above. Since insurance cost is largely a function of driver characteristics (e.g. age) and weakly related to vehicle value, no adjustments are made to the AAA values as a function of vehicle value. +# +#The module also identifies which households are assigned to pay-as-you-drive (PAYD) insurance to satisfy user input on the proportion of households having that type of insurance. PAYD insurance is limited to 1996 or later model years because it requires OBD-II ports that were made mandatory on all vehicles in that year. This model has no estimated parameters, rather it weights various household characteristics based on judgements regarding the relative value of PAYD insurance to different users based on reviewing the literature. Undoubtedly there are correlations between the factors and therefore potential for double-counting, but substantially more data and study is required to sort out the effects. The characteristics and relative weights are as follows: +# +#* Teen Drivers (2 points) - households with one or more teenage drivers are benefitted by the monitoring and feedback provided by the technology; +# +#* Lower Mileage (3 points) - PAYD insurance is relatively more economical for households that have relatively low annual mileage (less than 15,000 miles per vehicle); +# +#* Older Adult Drivers (2 points) - Households with older adult drivers (30 or older) are more likely to use than households with younger adult drivers; +# +#* Lower Income (2 points) - Lower income households are more likely to use because of the lower costs and ability to moderate behavior to save additional money. Low income threshold is an annual household income of $45,000 in 2005 dollars. +# +#* Auto Proportion (2 points) - Households owning automobiles are more likely to use than households owning light trucks; and, +# +#* In Metropolitan Area (3 points) - Households in metropolitan areas are more likely to use. +# +### How the Module Works +# +#The module loads data on the type and age of each vehicle. It calls the CalculateHouseholdVmt module to calculate average daily vehicle miles traveled for each household. This is converted to annual miles and split equally among household vehicles. The depreciation model is applied to calculate vehicle depreciation cost as a function of the vehicle type, the vehicle age, and annual miles driven. The finance cost model is applied to calculate the finance cost as a function of the vehicle type and age. The insurance cost is calculated as a function of the vehicle type. Vehicle licensing/registration/tax costs are not calculated from the AAA values because these values can vary substantially by state and because they may changed to implement policy objectives. The user provides inputs for flat fees/taxes (i.e. annual cost per vehicle) and ad valorem taxes (i.e. percentage of vehicle value paid in taxes). The flat fees/taxes are applied to each vehicle. The ad valorem taxes are calculated by multiplying the vehicle value, which varies by type and age, by the tax rate. The module also loads household residential parking cost data calculated by the AssignParkingRestrictions module. The household parking costs are split equally among vehicles. Total ownership cost for each vehicle is then calculated by summing the depreciation, finance, insurance, fees/taxes, and parking costs. Total ownership cost is divided by vehicle miles to calculate the cost of ownership per mile of travel. +# +#The module also identifies which households will be assigned PAYD insurance given user inputs on the proportion of households having PAYD insurance. The module identifies which households qualify for PAYD insurance based on whether any of their vehicles are 1996 model year vehicles or later. The vehicle and household characteristics (identified above) are evaluated and points assigned. The total points are calculated for each households. Random sampling is used to choose a number of households to equal the input proportion where the probability that each household is chosen is a function of the ratio of the household weight to the maximum household weight. +# +# + + +#============================================= +#SECTION 1: ESTIMATE AND SAVE MODEL PARAMETERS +#============================================= + +#---------------------------- +#Vehicle ownership cost model +#---------------------------- +#Vehicle ownership cost data from the American Automobile Association (AAA) are +#used along with information on vehicle depreciation rates to develop a model of +#vehicle ownership cost as a function of vehicle type, vehicle age, and miles +#driven. + +#Create a list for retaining ownership cost model information +#------------------------------------------------------------ +VehOwnCost_ls <- list() + +#AAA vehicle ownership cost data +#------------------------------- +#Specify input file attributes +Inp_ls <- items( + item( + NAME = "Category", + TYPE = "character", + PROHIBIT = "NA", + ISELEMENTOF = "", + UNLIKELY = "", + TOTAL = "" + ), + item( + NAME = items( + "SmallSedan", + "MediumSedan", + "LargeSedan", + "SmallSUV", + "MediumSUV", + "Minivan", + "Pickup"), + TYPE = "double", + PROHIBIT = c("NA", "<= 0"), + ISELEMENTOF = "", + UNLIKELY = "", + TOTAL = "" + ) +) +#Load and process AAA vehicle ownership cost data +OwnCost_df <- + processEstimationInputs( + Inp_ls, + "aaa_vehicle_ownership_costs.csv", + "CalculateVehicleOwnCost.R") +rownames(OwnCost_df) <- OwnCost_df$Category +OwnCost_df <- OwnCost_df[,-1] +rm(Inp_ls) +#Save the AAA ownership cost information for documentation purposes +VehOwnCost_ls$AAAOwnCost_df <- OwnCost_df + +#Vehicle depreciation rate +#------------------------- +#According to the National Automobile Dealers Association (NADA), the value of +#automobiles and light trucks depreciate at about 15% per year. +#National Automobile Dealers Association (2013), +#NADA Used Vehicle Price Report: Age-level Analysis and Forecast, Q3 2013, +#https://www.nada.com/b2b/Portals/0/assets/pdf/Q3%20Whitepaper%20Age-level%20Analysis%20and%20Forecast.pdf. +DeprRate <- 0.15 + +#Calculate annual depreciation cost by vehicle age and vehicle type +#------------------------------------------------------------------ +#Identify the body types assigned to each vehicle type +AutoBodyTypes_ <- c("SmallSedan", "MediumSedan", "LargeSedan") +LtTrkBodyTypes_ <- c("SmallSUV", "MediumSUV", "Minivan", "Pickup") +#Depreciation by body type +Depr_MiBt <- as.matrix(OwnCost_df[ + c("Depreciation10KPerYear", "Depreciation15KPerYear", "Depreciation20KPerYear"), + c(AutoBodyTypes_ , LtTrkBodyTypes_) +]) +rownames(Depr_MiBt) <- c("10K", "15K", "20K") +#Calculate baseline (15K annual miles) depreciation for 5 years +BaseDepr_Bt <- unlist(Depr_MiBt["15K",]) * 5 +#Calculate the proportion of new value after 5 years assuming 15% dep. rate +Dep5YrProp <- (1 - DeprRate) ^ 5 +#Calculate the new price given 15% depreciation by year +BasePrice_Bt <- BaseDepr_Bt / (1 - Dep5YrProp) +#Calculate the base price by vehicle type as the midpoint of the body types +BasePrice_Vt <- c( + Auto = mean(range(BasePrice_Bt[AutoBodyTypes_])), + LtTrk = mean(range(BasePrice_Bt[LtTrkBodyTypes_])) +) +#Document base price in a table +VehOwnCost_ls$BasePrice_df <- data.frame( + Body = names(c(BasePrice_Bt, BasePrice_Vt)), + Price = paste0("$", + formatC(c(BasePrice_Bt, BasePrice_Vt), format = "f", digits = 0, big.mark = ",")) +) +#Calculate proportion of new car value by age given 15% depreciation rate +Ag <- 1:31 +PropNewValue_Ag <- sapply(Ag, function(x) (1 - DeprRate)^(x - 1)) +#Calculate car value by vehicle age and vehicle type +Value_AgVt <- outer(PropNewValue_Ag, BasePrice_Vt, "*") +#Calculate depreciation by vehicle age and vehicle type +Depr_AgVt <- round(-apply(Value_AgVt, 2, diff)) +#Document depreciation by year +png("data/depreciation_expense.png", width = 480, height = 480) +matplot(Depr_AgVt, type = "l", lty = c(1,2), col = "black", + xlab = "Vehicle Age (years)", ylab = "Depreciation (2017 dollars)", + main = "Average Auto and Light Truck Depreciation\nBy Vehicle Age") +legend("topright", legend = c("Auto", "Light Truck"), lty = c(1,2)) +dev.off() +#Save car value and annual depreciation expense by age and vehicle type +VehOwnCost_ls$Value_AgVt <- Value_AgVt +VehOwnCost_ls$Depr_AgVt <- Depr_AgVt + +#Estimate model to adjust depreciation to account for vehicle mileage +#-------------------------------------------------------------------- +#Calculate proportional rate of depreciation relative to base +Depr_MiVt <- cbind( + Auto = apply(Depr_MiBt[,AutoBodyTypes_], 1, function(x) mean(range(x))), + LtTrk = apply(Depr_MiBt[,LtTrkBodyTypes_], 1, function(x) mean(range(x))) +) +DeprProp_MiVt <- sweep(Depr_MiVt, 2, Depr_MiVt[2,], "/") +#Define function to model depreciation adjustment as function of mileage +estDeprAdjModel <- function(Depr_, Mi_) { + #Function to calculate linearizing power + findPower <- function() { + checkPower <- function(Pow) { + PowMi_ <- Mi_ ^ Pow + unname(diff(diff(Depr_) / diff(PowMi_))) + } + binarySearch(checkPower, c(1,5), Target = 0) + } + #Calculate power and transform mileage + Pow <- findPower() + #Data frame of estimation data + Data_df <- data.frame( + Depr = Depr_, + PowMi = Mi_ ^ Pow + ) + #Estimate model + Depr_LM <- lm(Depr ~ PowMi, data = Data_df) + #Create summary text which combines model summary with power transform + Summary_ <- c( + paste("Power Transform:", Pow), + capture.output(summary(Depr_LM)) + ) + #Return the results + list( + Pow = Pow, + Coeff = coefficients(Depr_LM), + Summary = Summary_ + ) +} +#Estimate and save depreciation adjustment models for autos and light trucks +VehOwnCost_ls$DeprAdjModel_ls <- list( + Auto = estDeprAdjModel(DeprProp_MiVt[,"Auto"], c(10, 15, 20)), + LtTrk = estDeprAdjModel(DeprProp_MiVt[,"LtTrk"], c(10, 15, 20)) +) + +#Define function to calculate vehicle depreciation +#------------------------------------------------- +#' Calculate vehicle depreciation +#' +#' \code{calcVehDepr} calculates vehicle depreciation given vehicle type, age, +#' and annual mileage +#' +#' This function calculates the annual depreciation cost (in 2017 dollars) of +#' vehicles as a function of the vehicle type (Auto, LtTrk), age, and annual +#' mileage. A base depreciation value is calculated using the depreciation cost +#' matrix (VehOwnCost_ls$Depr_AgVt) calculated from AAA data in the module +#' script. The base depreciation is a function of vehicle type and age. The +#' base depreciation is adjusted based on the vehicle's annual mileage using the +#' depreciation adjustment models (VehOwnCost_ls$DeprAdjModel_ls). The models, +#' one for each vehicle type (Auto, LtTrk) are quadratic polynomials with +#' minimum values at 10,000 miles so the minimum vehicle VMT is constrained to +#' 10,000 miles for use in the model. +#' +#' @param Type_ A character vector of vehicle types (Auto, LtTrk) +#' @param Age_ A numeric vector of vehicle ages +#' @param Vmt_ A numeric vector of the annual vehicle miles traveled for the +#' vehicles +#' @return A numeric vector of annual depreciation cost in 2017 dollars +#' @export +#' +calcVehDepr <- function(Type_, Age_, Vmt_) { + #Calculate index to the vehicle depreciation model table + TypeToIndex <- c(Auto = 1, LtTrk = 2) + DeprIdx_mx <- cbind( + pmin(as.integer(Age_) + 1, 30), + TypeToIndex[Type_] + ) + #Apply the index to calculate base vehicle depreciation + BaseDepr_Ve <- with(VehOwnCost_ls, Depr_AgVt[DeprIdx_mx]) + #Put depreciation adjustment model coefficients into matrix + Coeff_mx <- rbind( + Auto = VehOwnCost_ls$DeprAdjModel_ls[["Auto"]]$Coeff, + LtTrk = VehOwnCost_ls$DeprAdjModel_ls[["LtTrk"]]$Coeff + )[Type_,] + #Scale the Vmt to form of depreciation adjustment model + Mi_ <- Vmt_ / 1000 + #Power transform the mileage + Pow_Vt <- c( + Auto = VehOwnCost_ls$DeprAdjModel_ls$Auto$Pow, + LtTrk = VehOwnCost_ls$DeprAdjModel_ls$LtTrk$Pow + ) + PowMi_ <- Mi_ ^ (Pow_Vt[Type_]) + #Create model input matrix + Inp_mx <- cbind(rep(1, length(PowMi_)), PowMi_) + #Apply the depreciation adjustment model to calculate adjustment factors + DeprAdj_Ve <- rowSums(Coeff_mx * Inp_mx) + #Multiply the base depreciation by mileage adjustment factors for result + BaseDepr_Ve * DeprAdj_Ve +} + +#Document model for adjusting depreciation to account for mileage +#---------------------------------------------------------------- +Vmt_ <- seq(5000, 30000, 1000) +AutoDep_ <- calcVehDepr( + rep("Auto", length(Vmt_)), + Age_ <- rep(5, length(Vmt_)), + Vmt_ +) +LtTrkDep_ <- calcVehDepr( + rep("LtTrk", length(Vmt_)), + Age_ <- rep(5, length(Vmt_)), + Vmt_ +) +png("data/depreciation_by_annual_miles.png", width = 480, height = 480) +plot(Vmt_, AutoDep_, type = "l", ylim = range(c(AutoDep_, LtTrkDep_)), + xlab = "Annual Miles", ylab = "Annual Depreciation (2017 dollars)", + main = "Annual Depreciation by Annual Miles Driven\n5-Year Old Auto and Light Truck") +lines(Vmt_, LtTrkDep_, lty = 2) +legend("topleft", legend = c("Auto", "Light Truck"), lty = c(1,2)) +dev.off() + +#Calculate financing cost by vehicle age and type +#------------------------------------------------ +#Calculate average new finance cost for autos and light trucks +FinCost_ <- unlist(OwnCost_df["Finance",]) +FinCost_Vt <- c( + Auto = mean(range(FinCost_[AutoBodyTypes_])), + LtTrk = mean(range(FinCost_[LtTrkBodyTypes_])) +) +#Calculate finance cost by vehicle age +VehOwnCost_ls$FinCost_AgVt <- outer(PropNewValue_Ag, FinCost_Vt, "*") + + +#Calculate insurance cost by vehicle type +#---------------------------------------- +#Note, vehicle insurance cost is not strongly related to vehicle value. It is +#mostly related to driver characteristics. +VehOwnCost_ls$InsCost_Vt <- c( + Auto = mean(range(unlist(OwnCost_df["Insurance", AutoBodyTypes_]))), + LtTrk = mean(range(unlist(OwnCost_df["Insurance", LtTrkBodyTypes_]))) +) + +#Clean up +rm(Depr_AgVt, Depr_MiBt, Depr_MiVt, DeprProp_MiVt, OwnCost_df, Value_AgVt, + Ag, Age_, AutoBodyTypes_, AutoDep_, BaseDepr_Bt, BasePrice_Bt, BasePrice_Vt, + Dep5YrProp, DeprRate, FinCost_, FinCost_Vt, LtTrkBodyTypes_, LtTrkDep_, + PropNewValue_Ag, Vmt_, estDeprAdjModel) + +#Save the vehicle ownership cost model +#------------------------------------- +#' Vehicle ownership cost model +#' +#' A list containing data and estimated model for calculating vehicle +#' depreciation and financing cost. +#' +#' @format A list containing the following four components: +#' \describe{ +#' \item{Depr_AgVt}{a matrix of annual depreciation cost by vehicle age and type in 2017 dollars} +#' \item{DeprAdjModel_ls}{a containing model coefficients for calculating adjustments to annual depreciation based on annual miles driven and vehicle type (Auto, LtTrk)} +#' \item{FinCost_AgVt}{a matrix of annual financing cost by vehicle age and type in 2017 dollars} +#' \item{InsCost_Vt}{a vector of annual insurance cost by vehicle type in 2017 dollars} +#' } +#' @source AdjustVehicleOwnership.R script. +"VehOwnCost_ls" +usethis::use_data(VehOwnCost_ls, overwrite = TRUE) + +#--------------------------------- +#Pay-as-you-drive insurance choice +#--------------------------------- + +#Define PAYD weights +#------------------- +#Define the relative weights for choosing which households are most likely to +#use PAYD insurance. Following are the weighting factors: +#HasTeenDrv - households with one or more teenage drivers are more likely to have +#because of the advantage for monitoring and providing feedback on teenage +#driver behavior. +#LowerMileage - PAYD insurance is relatively more economical for households that +#have relatively low annual mileage (less than 15,000 miles per vehicle). +#OlderDrvProp - Households with older drivers (30 or older) are more likely to +#use than households with younger drivers. +#LowerIncome - Lower income households are more likely to use because of the lower +#costs and ability to moderate behavior to save additional money. Low income +#threshold is an annual household income of $45,000 in 2005 dollars. +#AutoProp - Households owning automobiles are more likely than households +#owning light trucks (i.e. sport-utility, pickup, van) to use PAYD +#InMetroArea - Households in metropolitan areas are more likely to use PAYD +PaydWts_ <- c( + HasTeenDrv = 2, + LowerMileage = 3, + OlderDrvProp = 2, + LowerIncome = 2, + AutoProp = 2, + InMetroArea = 3) + +#Save the PAYD weights +#--------------------- +#' Household attributes weights for PAYD insurance +#' +#' Identifies household attributes associated with higher probability of PAYD +#' insurance and the relative weights of those attributes. +#' +#' @format A named vector of weights used for determining household weight for selecting PAYD insurance +#' \describe{ +#' \item{HasTeenDrv}{weight for households having one or more teenage drivers}, +#' \item{LowerMileage}{weight for households driving lower mileage (< 15,000 per vehicle)} +#' \item{OlderDrvProp}{weight for proportion of drivers in the household who are 30 or older} +#' \item{LowerIncome}{weight for lower income households (< 45,000 year 2005 dollars)} +#' \item{AutoProp}{weight for automobile proportion of vehicles owned by household} +#' \item{InMetroArea}{weight for household being located in a metropolitan (urbanized) area} +#' } +#' @source CalculateVehicleOwnCost.R script. +"PaydWts_" +usethis::use_data(PaydWts_, overwrite = TRUE) + + +#================================================ +#SECTION 2: DEFINE THE MODULE DATA SPECIFICATIONS +#================================================ + +#Define the data specifications +#------------------------------ +CalculateVehicleOwnCostSpecifications <- list( + #Level of geography module is applied at + RunBy = "Region", + #Specify new tables to be created by Inp if any + #Specify new tables to be created by Set if any + #Specify input data + Inp = items( + item( + NAME = "VehOwnFlatRateFee", + FILE = "azone_hh_veh_own_taxes.csv", + TABLE = "Azone", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD", + NAVALUE = -1, + SIZE = 0, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + UNLIKELY = "", + TOTAL = "", + DESCRIPTION = + "Annual flat rate tax per vehicle in dollars" + ), + item( + NAME = "VehOwnAdValoremTax", + FILE = "azone_hh_veh_own_taxes.csv", + TABLE = "Azone", + GROUP = "Year", + TYPE = "double", + UNITS = "proportion", + NAVALUE = -1, + SIZE = 0, + PROHIBIT = c("NA", "< 0", "> 1"), + ISELEMENTOF = "", + UNLIKELY = "", + TOTAL = "", + DESCRIPTION = + "Annual proportion of vehicle value paid in taxes" + ), + item( + NAME = "PaydHhProp", + FILE = "azone_payd_insurance_prop.csv", + TABLE = "Azone", + GROUP = "Year", + TYPE = "double", + UNITS = "proportion", + NAVALUE = -1, + SIZE = 0, + PROHIBIT = c("NA", "< 0", "> 1"), + ISELEMENTOF = "", + UNLIKELY = "", + TOTAL = "", + DESCRIPTION = + "Proportion of households in the Azone who have pay-as-you-drive insurance for their vehicles" + ) + ), + #Specify data to be loaded from data store + Get = items( + item( + NAME = "Azone", + TABLE = "Azone", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "VehOwnFlatRateFee", + TABLE = "Azone", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD.2017", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "VehOwnAdValoremTax", + TABLE = "Azone", + GROUP = "Year", + TYPE = "double", + UNITS = "proportion", + PROHIBIT = c("NA", "< 0", "> 1"), + ISELEMENTOF = "" + ), + item( + NAME = "PaydHhProp", + TABLE = "Azone", + GROUP = "Year", + TYPE = "double", + UNITS = "proportion", + PROHIBIT = c("NA", "< 0", "> 1"), + ISELEMENTOF = "" + ), + item( + NAME = "Azone", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "HhId", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "Vehicles", + TABLE = "Household", + GROUP = "Year", + TYPE = "vehicles", + UNITS = "VEH", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "HhId", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "NA", + ISELEMENTOF = "" + ), + item( + NAME = "Azone", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = "VehId", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "NA", + ISELEMENTOF = "" + ), + item( + NAME = "VehicleAccess", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBIT = "", + ISELEMENTOF = c("Own", "LowCarSvc", "HighCarSvc") + ), + item( + NAME = "Type", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBIT = "NA", + ISELEMENTOF = c("Auto", "LtTrk") + ), + item( + NAME = "Age", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "time", + UNITS = "YR", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "FreeParkingSpaces", + TABLE = "Household", + GROUP = "Year", + TYPE = "integer", + UNITS = "parking spaces", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "ParkingUnitCost", + TABLE = "Household", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD.2017", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = items( + "Drivers", + "Drv15to19", + "Drv20to29", + "Drv30to54", + "Drv55to64", + "Drv65Plus" + ), + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "Income", + TABLE = "Household", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD.2005", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "LocType", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBIT = "NA", + ISELEMENTOF = c("Urban", "Town", "Rural") + ), + item( + NAME = items( + "NumLtTrk", + "NumAuto"), + TABLE = "Household", + GROUP = "Year", + TYPE = "vehicles", + UNITS = "VEH", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ) + ), + #Specify data to saved in the data store + Set = items( + item( + NAME = "OwnCost", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD.2017", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Annual cost of vehicle ownership including depreciation, financing, insurance, taxes, and residential parking in dollars" + ), + item( + NAME = "OwnCostPerMile", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD.2017", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Annual cost of vehicle ownership per mile of vehicle travel (dollars per mile)" + ), + item( + NAME = "InsCost", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD.2017", + NAVALUE = -1, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + SIZE = 0, + DESCRIPTION = "Annual vehicle insurance cost in dollars" + ), + item( + NAME = "HasPaydIns", + TABLE = "Household", + GROUP = "Year", + TYPE = "integer", + UNITS = "binary", + NAVALUE = -1, + PROHIBIT = "", + ISELEMENTOF = c(0, 1), + SIZE = 0, + DESCRIPTION = "Identifies whether household has pay-as-you-drive insurance for vehicles: 1 = Yes, 0 = no" + ) + ), + #Specify call status of module + Call = items( + CalcDvmt = "CalculateHouseholdDvmt" + ) +) + +#Save the data specifications list +#--------------------------------- +#' Specifications list for CalculateVehicleOwnCost module +#' +#' A list containing specifications for the CalculateVehicleOwnCost module. +#' +#' @format A list containing 5 components: +#' \describe{ +#' \item{RunBy}{the level of geography that the module is run at} +#' \item{Inp}{model inputs to be saved to the datastore} +#' \item{Get}{module inputs to be read from the datastore} +#' \item{Set}{module outputs to be written to the datastore} +#' \item{Call}{alias and name of module to be called} +#' } +#' @source CalculateVehicleOwnCost.R script. +"CalculateVehicleOwnCostSpecifications" +usethis::use_data(CalculateVehicleOwnCostSpecifications, overwrite = TRUE) + + +#======================================================= +#SECTION 3: DEFINE FUNCTIONS THAT IMPLEMENT THE SUBMODEL +#======================================================= +#This module calculates average vehicle ownership cost for each vehicle based on +#the vehicle type and age using data from the American Automobile Association +#(AAA). To this are added the cost of parking at the vehicle residence if free +#parking is not available for all household vehicles. The ownership cost is +#converted into an average ownership cost per mile by predicting the household +#DVMT given the number of owned vehicles and splitting the miles equally among +#the vehicles. + + +#Function to calculate vehicle finance cost +#------------------------------------------ +#' Calculate vehicle finance cost +#' +#' \code{calcVehFin} calculates vehicle finance cost given vehicle type and age +#' +#' This function calculates the annual financing cost (in 2017 dollars) of +#' vehicles as a function of the vehicle type (Auto, LtTrk) and age using the , +#' and annual finance cost matrix (VehOwnCost_ls$FinCost_AgVt) calculated from +#' AAA data in the module script. +#' +#' @param Type_ A character vector of vehicle types (Auto, LtTrk) +#' @param Age_ A numeric vector of vehicle ages +#' vehicles +#' @return A numeric vector of annual finance cost in 2017 dollars +#' @name calcVehFin +#' @export +calcVehFin <- function(Type_, Age_) { + #Calculate index to the vehicle finance model table + TypeToIndex <- c(Auto = 1, LtTrk = 2) + FinIdx_mx <- cbind( + pmin(as.integer(Age_) + 1, 30), + TypeToIndex[Type_] + ) + #Apply the index to calculate vehicle finance cost + with(VehOwnCost_ls, FinCost_AgVt[FinIdx_mx]) +} + +#Function to calculate vehicle Ad valorem tax +#-------------------------------------------- +#' Calculate vehicle Ad valorem tax +#' +#' \code{calcAdValoremTax} calculates vehicle Ad valorem tax given vehicle type +#' and age +#' +#' This function calculates the annual Ad valorem tax (in 2017 dollars) of +#' vehicles as a function of the vehicle type (Auto, LtTrk) and age using the , +#' and annual vehicle value matrix (VehOwnCost_ls$Value_AgVt) calculated from +#' AAA data in the module script, and input Ad valorem tax rate. +#' +#' @param Type_ A character vector of vehicle types (Auto, LtTrk) +#' @param Age_ A numeric vector of vehicle ages +#' vehicles +#' @param TaxRate A numeric value that is the annual Ad valorem tax rate in +#' dollars of tax per dollar of vehicle value +#' @return A numeric vector of annual Ad valorem tax cost in 2017 dollars +#' @name calcAdValoremTax +#' @export +calcAdValoremTax <- function(Type_, Age_, TaxRate) { + #Calculate index to the vehicle value model table + TypeToIndex <- c(Auto = 1, LtTrk = 2) + ValueIdx_mx <- cbind( + pmin(as.integer(Age_) + 1, 30), + TypeToIndex[Type_] + ) + #Apply the index to calculate vehicle finance cost + with(VehOwnCost_ls, Value_AgVt[ValueIdx_mx]) * TaxRate +} + +#Define function to assign PAYD propensity weights to households +#----------------------------------------------------------------------- +#' Assign pay-as-you-drive insurance propensity weights to households +#' +#' \code{calcPaydWeights} Calculates household weight that reflect the relative +#' propensity of a household to purchase pay-as-you-drive insurance based on the +#' household characteristics +#' +#' Household PAYD propensity weights are assigned based on the presence of +#' teenager drivers, whether the average annual vehicle mileage is low, +#' the proportion of older drivers in the household, whether household income +#' is relatively low, the proportion of household vehicles that are autos, and +#' whether the household lives in a metropolitan area. All household vehicles +#' must be a 1996 or later model year. +#' +#' @param Household A list containing the Household component of the list (L) +#' including Household table data listed in the Get specifications limited to +#' data for households in a specified Azone +#' @param PaydHhProp A number identifying the proportion of households having +#' pay-as-you-drive insurance +#' for the module. +#' @return A numeric vector of weights assigned to each household +idPaydHh <- function(Household, PaydHhProp) { + #Set up + #------ + NumHh <- length(Household$HhId) + NumPayd <- round(NumHh * PaydHhProp) + Qualifies_Hh <- Household$PaydQualifies + + #Identify PAYD households + #------------------------ + if (sum(Qualifies_Hh) <= NumPayd) { + #Return all qualifying households if less than or equal to NumPayd + HasPaydIns_Hh <- setNames(as.integer(Qualifies_Hh), Household$HhId) + } else { + #Otherwise calculate PAYD weights and choose based on weights + Weight_Hh <- rep(1, length(Household$HhId)) + #Add weight for teenage drivers + Weight_Hh <- local({ + HasTeenDrv_Hh <- with(Household, Drv15to19 > 0) + Weight_Hh + HasTeenDrv_Hh * PaydWts_["HasTeenDrv"] + }) + #Add weight for average annual vehicle miles is less than 15,000 + Weight_Hh <- local({ + VmtPerVeh_Hh <- with(Household, 365 * Dvmt / Vehicles) + VmtPerVeh_Hh[is.na(VmtPerVeh_Hh)] <- 0 + LowerMileage_Hh <- VmtPerVeh_Hh < 15000 + Weight_Hh + LowerMileage_Hh * PaydWts_["LowerMileage"] + }) + #Add weight for the proportion of drivers 30 or older + Weight_Hh <- local({ + OlderDrvProp_Hh <- + with(Household, (Drivers - Drv15to19 - Drv20to29) / Drivers) + OlderDrvProp_Hh[is.na(OlderDrvProp_Hh)] <- 0 + Weight_Hh + OlderDrvProp_Hh * PaydWts_["OlderDrvProp"] + }) + #Add weight for lower income households + Weight_Hh <- local({ + LowerIncome_Hh <- Household$Income < 45000 + Weight_Hh + LowerIncome_Hh * PaydWts_["LowerIncome"] + }) + #Add weight for the proportion of vehicles that are autos + Weight_Hh <- local({ + AutoProp_Hh <- with(Household, NumAuto / Vehicles) + AutoProp_Hh[is.na(AutoProp_Hh)] <- 0 + Weight_Hh + AutoProp_Hh * PaydWts_["AutoProp"] + }) + #Add weight for households that are located within a metropolitan area + Weight_Hh <- local({ + InMetroArea <- Household$LocType == "Urban" + Weight_Hh + PaydWts_["InMetroArea"] + }) + #Use weights to identify PAYD households + HasPaydIns_Hh <- setNames(integer(NumHh), Household$HhId) + HhIdx_ <- (1:NumHh)[Qualifies_Hh] + Wts_ <- Weight_Hh[Qualifies_Hh] + PaydIdx_ <- sample(HhIdx_, NumPayd, prob = Wts_ / max(Wts_)) + HasPaydIns_Hh[PaydIdx_] <- 1L + } + #Return the result where only qualifying households have weights + HasPaydIns_Hh +} + +#Main module function to calculate household vehicle ownership cost +#------------------------------------------------------------------ +#' Calculate household vehicle ownership cost +#' +#' \code{CalculateVehicleOwnCost} calculates the average annual cost of +#' ownership and per mile cost of each household vehicle +#' +#' This function calculates the average annual ownership cost for each household +#' vehicle. It also calculates what that cost works out to on a per mile basis +#' by calculating average daily household DVMT given the number of household +#' vehicles owned, splitting the DVMT evenly among household vehicles, and +#' calculating the average per mile cost. +#' +#' @param L A list containing the components listed in the Get specifications +#' for the module. +#' @param M A list the module functions of modules called by this module. +#' @return A list containing the components specified in the Set +#' specifications for the module. +#' @name CalculateVehicleOwnCost +#' @import visioneval +#' @export +CalculateVehicleOwnCost <- function(L,M) { + #Set Up + #------ + #Set seed + set.seed(L$G$Seed) + #Create crosswalk from households to vehicles + HhToVehIdx_Ve <- match(L$Year$Vehicle$HhId, L$Year$Household$HhId) + #Crosswalk from Azones to vehicles + AzToVehIdx_Ve <- match(L$Year$Vehicle$Azone, L$Year$Azone$Azone) + #Identify vehicle-owning households + HasVeh <- L$Year$Household$Vehicles > 0 + #Identify owned and car sevice vehicles + IsOwn <- L$Year$Vehicle$VehicleAccess == "Own" + IsCarSvc <- L$Year$Vehicle$VehicleAccess != "Own" + #Number of households + NumHh <- length(L$Year$Household$HhId) + #Azones + Az <- L$Year$Azone$Azone + + #Calculate annual VMT by vehicle + #------------------------------- + #Estimate the household DVMT + L$Year$Household$Dvmt <- M$CalcDvmt(L$CalcDvmt)$Year$Household$Dvmt + AnnualVmt_Hh <- 365 * L$Year$Household$Dvmt + L$CalcDvmt <- NULL + #Calculate annual household VMT per vehicle + AveAnnVmtPV_Hh <- AnnualVmt_Hh / L$Year$Household$Vehicles + AveAnnVmtPV_Hh[L$Year$Household$Vehicles == 0] <- 0 + AnnVmt_Ve <- AveAnnVmtPV_Hh[HhToVehIdx_Ve] + AnnVmt_Ve[IsCarSvc] <- 0 + + #Calculate annual depreciation cost + DeprCost_Ve <- + calcVehDepr(L$Year$Vehicle$Type, L$Year$Vehicle$Age, AnnVmt_Ve) + DeprCost_Ve[IsCarSvc] <- 0 + + #Calculate annual financing cost + FinCost_Ve <- + calcVehFin(L$Year$Vehicle$Type, L$Year$Vehicle$Age) + FinCost_Ve[IsCarSvc] <- 0 + + #Calculate annual insurance cost + InsCost_Ve <- VehOwnCost_ls$InsCost_Vt[L$Year$Vehicle$Type] + InsCost_Ve[IsCarSvc] <- 0 + + #Calculate annual taxes + TaxCost_Ve <- L$Year$Azone$VehOwnFlatRateFee[AzToVehIdx_Ve] + + calcAdValoremTax( + L$Year$Vehicle$Type, + L$Year$Vehicle$Age, + L$Year$Azone$VehOwnAdValoremTax[AzToVehIdx_Ve]) + TaxCost_Ve[IsCarSvc] <- 0 + + #Calculate residential parking cost + PkgCost_Ve <- local({ + NumPaidPkgSp_Hh <- + pmax(0, with(L$Year$Household, Vehicles - FreeParkingSpaces)) + AnnPkgCost_Hh <- 365 * L$Year$Household$ParkingUnitCost * NumPaidPkgSp_Hh + AnnPkgCostPV_Hh <- AnnPkgCost_Hh / L$Year$Household$Vehicles + PkgCost_Ve <- AnnPkgCostPV_Hh[HhToVehIdx_Ve] + PkgCost_Ve[IsCarSvc] <- 0 + PkgCost_Ve + }) + + #Calculate total ownership cost + TotCost_Ve <- DeprCost_Ve + FinCost_Ve + InsCost_Ve + TaxCost_Ve + PkgCost_Ve + TotCostPerMi_Ve <- local({ + TotCostPerMi_Ve <- TotCost_Ve / AnnVmt_Ve + TotCostPerMi_Ve[is.na(TotCostPerMi_Ve)] <- 0 + TotCostPerMi_Ve[IsCarSvc] <- 0 + MaxCostPerMi <- quantile(TotCostPerMi_Ve[IsOwn], 0.9999) + TotCostPerMi_Ve[TotCostPerMi_Ve > MaxCostPerMi] <- MaxCostPerMi + TotCostPerMi_Ve + }) + + #Assign PAYD insurance + L$Year$Household$PaydQualifies <- local({ + AgeThreshold <- as.numeric(L$G$Year) - 1996 + CanBePayd_Ve <- L$Year$Vehicle$Age <= AgeThreshold + CanBePayd_Ve[IsCarSvc] <- TRUE + Qualifies_Hh <- + tapply(CanBePayd_Ve, L$Year$Vehicle$HhId, function(x) all(x))[L$Year$Household$HhId] + Qualifies_Hh[L$Year$Household$Vehicles == 0] <- FALSE + Qualifies_Hh + }) + HasPaydIns_Hh <- setNames(integer(NumHh), L$Year$Household$HhId) + for (az in Az) { + HhIsAz <- L$Year$Household$Azone == az + HasPaydIns_Hx <- idPaydHh( + Household = lapply(L$Year$Household, function(x) x[HhIsAz]), + PaydHhProp = L$Year$Azone$PaydHhProp[L$Year$Azone$Azone == az] + ) + HasPaydIns_Hh[names(HasPaydIns_Hx)] <- HasPaydIns_Hx + } + + #Return the results + Out_ls <- initDataList() + Out_ls$Year$Vehicle <- list( + OwnCost = TotCost_Ve, + OwnCostPerMile = TotCostPerMi_Ve, + InsCost = InsCost_Ve + ) + Out_ls$Year$Household <- list( + HasPaydIns = unname(HasPaydIns_Hh) + ) + Out_ls +} + + +#=============================================================== +#SECTION 4: MODULE DOCUMENTATION AND AUXILLIARY DEVELOPMENT CODE +#=============================================================== +#Run module automatic documentation +#---------------------------------- +documentModule("CalculateVehicleOwnCost") + +#Test code to check specifications, loading inputs, and whether datastore +#contains data needed to run module. Return input list (L) to use for developing +#module functions +#------------------------------------------------------------------------------- +# #Load packages and test functions +# library(filesstrings) +# library(visioneval) +# library(ordinal) +# source("tests/scripts/test_functions.R") +# #Set up test environment +# TestSetup_ls <- list( +# TestDataRepo = "../Test_Data/VE-RSPM", +# DatastoreName = "Datastore.tar", +# LoadDatastore = TRUE, +# TestDocsDir = "verspm", +# ClearLogs = TRUE, +# # SaveDatastore = TRUE +# SaveDatastore = FALSE +# ) +# setUpTests(TestSetup_ls) +# #Run test module +# TestDat_ <- testModule( +# ModuleName = "CalculateVehicleOwnCost", +# LoadDatastore = TRUE, +# SaveDatastore = FALSE, +# DoRun = FALSE, +# RequiredPackages = "VEHouseholdTravel" +# ) +# L <- TestDat_$L +# M <- TestDat_$M +# R <- CalculateVehicleOwnCost(TestDat_$L, TestDat_$M) +# +# TestDat_ <- testModule( +# ModuleName = "CalculateVehicleOwnCost", +# LoadDatastore = TRUE, +# SaveDatastore = TRUE, +# DoRun = TRUE, +# RequiredPackages = "VEHouseholdTravel" +# ) diff --git a/sources/modules/VEHouseholdVehicles-old/R/CreateVehicleTable.R b/sources/modules/VEHouseholdVehicles-old/R/CreateVehicleTable.R new file mode 100644 index 000000000..e1d644915 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/R/CreateVehicleTable.R @@ -0,0 +1,366 @@ +#==================== +#CreateVehicleTable.R +#==================== +# +# +# +## CreateVehicleTable Module +#### June 5, 2020 +# +#This module creates a vehicle table and populates it with household ID and geography fields. +# +### Model Parameter Estimation +# +#This module has no estimated parameters. +# +### How the Module Works +# +#This module initializes the 'Vehicle' table and populates it with the household ID (HhId), vehicle ID (VehID), Azone ID (Azone), Marea ID (Marea), and vehicle access type (VehicleAccess) datasets. The Vehicle table has a record for every vehicle owned by the household. If there are more driving age persons than vehicles in the household, there is also a record for each driving age person for which there is no vehicle. The VehicleAccess designation is Own for each vehicle owned by a household. The designation is either LowCarSvc or HighCarSvc for each record corresponding to difference between driving age persons and owned vehicles. It is LowCarSvc if the household is in a Bzone having a low level of car service and HighCarSvc if the Bzone car service level is high. +# +# + + +#============================================= +#SECTION 1: ESTIMATE AND SAVE MODEL PARAMETERS +#============================================= +#This module initializes the 'Vehicle' table and populates it with the +#household ID (HhId), vehicle ID (VehID), Azone ID (Azone), Marea ID (Marea), +#and vehicle access type (VehicleAccess) datasets. The Vehicle table has a +#record for every vehicle owned by the household. If there are more driving age +#persons than vehicles in the household, there is also a record for each driving +#age person for which there is no vehicle. The VehicleAccess designation is Own +#for each vehicle owned by a household. The designation is either LowCarSvc or +#HighCarSvc for each record corresponding to difference between driving age +#persons and owned vehicles. It is LowCarSvc if the household is in a Bzone +#having a low level of car service and HighCarSvc if the Bzone car service level +#is high. + + +#================================================ +#SECTION 2: DEFINE THE MODULE DATA SPECIFICATIONS +#================================================ + +#Define the data specifications +#------------------------------ +CreateVehicleTableSpecifications <- list( + #Level of geography module is applied at + RunBy = "Region", + #Specify new tables to be created by Inp if any + #Specify new tables to be created by Set if any + NewSetTable = items( + item( + TABLE = "Vehicle", + GROUP = "Year" + ) + ), + #Specify input data + Inp = items( + item( + NAME = + items( + "HighCarSvcCost", + "LowCarSvcCost"), + FILE = "azone_carsvc_characteristics.csv", + TABLE = "Azone", + GROUP = "Year", + TYPE = "currency", + UNITS = "USD", + NAVALUE = -1, + SIZE = 0, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + UNLIKELY = "", + TOTAL = "", + DESCRIPTION = + items( + "Average cost in dollars per mile for travel by high service level car service exclusive of the cost of fuel, road use taxes, and carbon taxes (and any other social costs charged to vehicle use).", + "Average cost in dollars per mile for travel by low service level car service exclusive of the cost of fuel, road use taxes, and carbon taxes (and any other social costs charged to vehicle use)." + ) + ), + item( + NAME = "AveCarSvcVehicleAge", + FILE = "azone_carsvc_characteristics.csv", + TABLE = "Azone", + GROUP = "Year", + TYPE = "time", + UNITS = "YR", + NAVALUE = -1, + SIZE = 0, + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "", + UNLIKELY = "", + TOTAL = "", + DESCRIPTION = "Average age of car service vehicles in years" + ), + item( + NAME = + items( + "LtTrkCarSvcSubProp", + "AutoCarSvcSubProp"), + FILE = "azone_carsvc_characteristics.csv", + TABLE = "Azone", + GROUP = "Year", + TYPE = "double", + UNITS = "proportion", + NAVALUE = -1, + SIZE = 0, + PROHIBIT = c("NA", "< 0", "> 1"), + ISELEMENTOF = "", + UNLIKELY = "", + TOTAL = "", + DESCRIPTION = + items( + "The proportion of light-truck owners who would substitute a less-costly car service option for owning their light truck", + "Th proportion of automobile owners who would substitute a less-costly car service option for owning their automobile" + ) + ) + ), + #Specify data to be loaded from data store + Get = items( + item( + NAME = + items("HhId", + "Azone", + "Bzone", + "Marea"), + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + PROHIBIT = "", + ISELEMENTOF = "" + ), + item( + NAME = items( + "NumLtTrk", + "NumAuto"), + TABLE = "Household", + GROUP = "Year", + TYPE = "vehicles", + UNITS = "VEH", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "Vehicles", + TABLE = "Household", + GROUP = "Year", + TYPE = "vehicles", + UNITS = "VEH", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "DrvAgePersons", + TABLE = "Household", + GROUP = "Year", + TYPE = "people", + UNITS = "PRSN", + PROHIBIT = c("NA", "< 0"), + ISELEMENTOF = "" + ), + item( + NAME = "CarSvcLevel", + TABLE = "Household", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + PROHIBIT = "", + ISELEMENTOF = c("Low", "High") + ) + ), + #Specify data to saved in the data store + Set = items( + item( + NAME = + items("HhId", + "VehId", + "Azone", + "Bzone", + "Marea"), + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "ID", + NAVALUE = -1, + PROHIBIT = "", + ISELEMENTOF = "", + DESCRIPTION = + items("Unique household ID", + "Unique vehicle ID", + "Azone ID", + "Bzone ID", + "Marea ID") + ), + item( + NAME = "VehicleAccess", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + NAVALUE = "NA", + PROHIBIT = "", + ISELEMENTOF = c("Own", "LowCarSvc", "HighCarSvc"), + SIZE = 10, + DESCRIPTION = "Identifier whether vehicle is owned by household (Own), if vehicle is low level car service (LowCarSvc), or if vehicle is high level car service (HighCarSvc)" + ), + item( + NAME = "Type", + TABLE = "Vehicle", + GROUP = "Year", + TYPE = "character", + UNITS = "category", + NAVALUE = -1, + PROHIBIT = "NA", + ISELEMENTOF = c("Auto", "LtTrk"), + SIZE = 5, + DESCRIPTION = "Vehicle body type: Auto = automobile, LtTrk = light trucks (i.e. pickup, SUV, Van)" + ) + ) +) + +#Save the data specifications list +#--------------------------------- +#' Specifications list for CreateVehicleTable module +#' +#' A list containing specifications for the CreateVehicleTable module. +#' +#' @format A list containing 5 components: +#' \describe{ +#' \item{NewSetTable}{table to be created} +#' \item{RunBy}{the level of geography that the module is run at} +#' \item{Inp}{model inputs to be saved to the datastore} +#' \item{Get}{module inputs to be read from the datastore} +#' \item{Set}{module outputs to be written to the datastore} +#' } +#' @source CreateVehicleTable.R script. +"CreateVehicleTableSpecifications" +usethis::use_data(CreateVehicleTableSpecifications, overwrite = TRUE) + + +#======================================================= +#SECTION 3: DEFINE FUNCTIONS THAT IMPLEMENT THE SUBMODEL +#======================================================= +#This function initializes the 'Vehicle' table and populates it with the +#household ID (HhId), vehicle ID (VehID), Azone ID (Azone), Marea ID (Marea), +#and vehicle access type (VehicleAccess) datasets. The Vehicle table has a +#record for every vehicle owned by the household. If there are more driving age +#persons than vehicles in the household, there is also a record for each driving +#age person for which there is no vehicle. The VehicleAccess designation is Own +#for each vehicle owned by a household. The designation is either LowCarSvc or +#HighCarSvc for each record corresponding to difference between driving age +#persons and owned vehicles. It is LowCarSvc if the household is in a Bzone +#having a low level of car service and HighCarSvc if the Bzone car service level +#is high. + +#Main module function to create vehicle table with HhId and Azone datasets +#------------------------------------------------------------------------- +#' Create vehicle table and populate with HhId and Azone datasets. +#' +#' \code{CreateVehicleTable} create the vehicle table and populate with HhId +#' and Azone datasets. +#' +#' This function creates the 'Vehicle' table in the datastore and populates it +#' with HhId and Azone datasets. +#' +#' @param L A list containing the components listed in the Get specifications +#' for the module. +#' @return A list containing the components specified in the Set +#' specifications for the module. +#' @name CreateVehicleTable +#' @import visioneval +#' @export +CreateVehicleTable <- function(L) { + #Initialize the output list + Out_ls <- initDataList() + #Calculate number of vehicles accessed (owned and car service) + NumOwned_Hh <- L$Year$Household$Vehicles + NumCarSvc_Hh <- L$Year$Household$DrvAgePersons - NumOwned_Hh + NumCarSvc_Hh[NumCarSvc_Hh < 0] <- 0 + NumVeh_Hh <- NumOwned_Hh + NumCarSvc_Hh + NumLtTrk_Hh <- L$Year$Household$NumLtTrk + NumAuto_Hh <- L$Year$Household$NumAuto + #Create a vehicle table + Out_ls$Year$Vehicle <- list() + attributes(Out_ls$Year$Vehicle)$LENGTH <- sum(NumVeh_Hh) + #Add household ID to table + HhId_Ve <- rep(L$Year$Household$HhId, NumVeh_Hh) + Out_ls$Year$Vehicle$HhId <- HhId_Ve + attributes(Out_ls$Year$Vehicle$HhId)$SIZE <- max(nchar(HhId_Ve)) + #Add vehicle ID to table + #Note: ignore group quarters households that are under 15 years old (i.e. are + #not driving age) by definition, these have no vehicle access. + Out_ls$Year$Vehicle$VehId <- + paste(HhId_Ve, unlist(sapply(NumVeh_Hh[NumVeh_Hh > 0], function(x) 1:x)), sep = "-") + attributes(Out_ls$Year$Vehicle$VehId)$SIZE <- max(nchar(Out_ls$Year$Vehicle$VehId)) + #Add Azone ID to table + Out_ls$Year$Vehicle$Azone <- rep(L$Year$Household$Azone, NumVeh_Hh) + attributes(Out_ls$Year$Vehicle$Azone)$SIZE <- max(nchar(Out_ls$Year$Vehicle$Azone)) + #Add Bzone ID to table + Out_ls$Year$Vehicle$Bzone <- rep(L$Year$Household$Bzone, NumVeh_Hh) + attributes(Out_ls$Year$Vehicle$Bzone)$SIZE <- max(nchar(Out_ls$Year$Vehicle$Bzone)) + #Add Marea ID to table + Out_ls$Year$Vehicle$Marea <- rep(L$Year$Household$Marea, NumVeh_Hh) + attributes(Out_ls$Year$Vehicle$Marea)$SIZE <- max(nchar(Out_ls$Year$Vehicle$Marea)) + #Add vehicle ownership or car service designation + assignVehAccess <- function(NumOwn, NumCarSvc, CarSvcLevel) { + c(rep("Own", NumOwn), rep(CarSvcLevel, NumCarSvc)) + } + CarSvcLevel_Hh <- paste0(L$Year$Household$CarSvcLevel, "CarSvc") + Out_ls$Year$Vehicle$VehicleAccess <- + unlist(mapply(assignVehAccess, NumOwned_Hh, NumCarSvc_Hh, CarSvcLevel_Hh)) + #Assign vehicle type designation + assignVehType <- function(NumLtTrk, NumAuto, NumCarSvc) { + c(rep("LtTrk", NumLtTrk), rep("Auto", NumAuto), rep("Auto", NumCarSvc)) + } + Out_ls$Year$Vehicle$Type <- + unlist(mapply(assignVehType, NumLtTrk_Hh, NumAuto_Hh, NumCarSvc_Hh)) + #Return the outputs list + Out_ls +} + + +#=============================================================== +#SECTION 4: MODULE DOCUMENTATION AND AUXILLIARY DEVELOPMENT CODE +#=============================================================== +#Run module automatic documentation +#---------------------------------- +documentModule("CreateVehicleTable") + +#Test code to check specifications, loading inputs, and whether datastore +#contains data needed to run module. Return input list (L) to use for developing +#module functions +#------------------------------------------------------------------------------- +# #Load packages and test functions +# library(filesstrings) +# library(visioneval) +# library(ordinal) +# source("tests/scripts/test_functions.R") +# #Set up test environment +# TestSetup_ls <- list( +# TestDataRepo = "../Test_Data/VE-RSPM", +# DatastoreName = "Datastore.tar", +# LoadDatastore = TRUE, +# TestDocsDir = "verspm", +# ClearLogs = TRUE, +# # SaveDatastore = TRUE +# SaveDatastore = FALSE +# ) +# setUpTests(TestSetup_ls) +# #Run test module +# TestDat_ <- testModule( +# ModuleName = "CreateVehicleTable", +# LoadDatastore = TRUE, +# SaveDatastore = FALSE, +# DoRun = FALSE +# ) +# L <- TestDat_$L +# R <- CreateVehicleTable(L) +# +# #Run test module +# TestDat_ <- testModule( +# ModuleName = "CreateVehicleTable", +# LoadDatastore = TRUE, +# SaveDatastore = TRUE, +# DoRun = TRUE +# ) diff --git a/sources/modules/VEHouseholdVehicles-old/README.md b/sources/modules/VEHouseholdVehicles-old/README.md new file mode 100644 index 000000000..d14ed2025 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/README.md @@ -0,0 +1,5 @@ +# VEVehicleOwnership +Vehicle ownership simulation package for VisionEval +This package contains modules that work in the VisionEval framework to calculate vehicle ownership and to adjust ownership based on participation in carsharing programs. + +See [Getting Started](https://github.com/VisionEval/VisionEval/wiki/Getting-Started) diff --git a/sources/modules/VEHouseholdVehicles-old/data/AdjustVehicleOwnershipSpecifications.rda b/sources/modules/VEHouseholdVehicles-old/data/AdjustVehicleOwnershipSpecifications.rda new file mode 100644 index 000000000..25fcfbd9a Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/AdjustVehicleOwnershipSpecifications.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/data/AssignDriversSpecifications.rda b/sources/modules/VEHouseholdVehicles-old/data/AssignDriversSpecifications.rda new file mode 100644 index 000000000..e5b43490d Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/AssignDriversSpecifications.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/data/AssignVehicleAgeSpecifications.rda b/sources/modules/VEHouseholdVehicles-old/data/AssignVehicleAgeSpecifications.rda new file mode 100644 index 000000000..4d00b8cbd Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/AssignVehicleAgeSpecifications.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/data/AssignVehicleFeaturesFutureSpecifications.rda b/sources/modules/VEHouseholdVehicles-old/data/AssignVehicleFeaturesFutureSpecifications.rda new file mode 100644 index 000000000..5389a8497 Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/AssignVehicleFeaturesFutureSpecifications.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/data/AssignVehicleFeaturesSpecifications.rda b/sources/modules/VEHouseholdVehicles-old/data/AssignVehicleFeaturesSpecifications.rda new file mode 100644 index 000000000..4991f1366 Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/AssignVehicleFeaturesSpecifications.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/data/AssignVehicleOwnershipSpecifications.rda b/sources/modules/VEHouseholdVehicles-old/data/AssignVehicleOwnershipSpecifications.rda new file mode 100644 index 000000000..867beb86f Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/AssignVehicleOwnershipSpecifications.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/data/AssignVehicleTypeSpecifications.rda b/sources/modules/VEHouseholdVehicles-old/data/AssignVehicleTypeSpecifications.rda new file mode 100644 index 000000000..c96cd877a Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/AssignVehicleTypeSpecifications.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/data/AutoOwnModels_ls.rda b/sources/modules/VEHouseholdVehicles-old/data/AutoOwnModels_ls.rda new file mode 100644 index 000000000..e9e9da8ff Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/AutoOwnModels_ls.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/data/CalculateVehicleOwnCostSpecifications.rda b/sources/modules/VEHouseholdVehicles-old/data/CalculateVehicleOwnCostSpecifications.rda new file mode 100644 index 000000000..b2a3040d8 Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/CalculateVehicleOwnCostSpecifications.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/data/CreateVehicleTableSpecifications.rda b/sources/modules/VEHouseholdVehicles-old/data/CreateVehicleTableSpecifications.rda new file mode 100644 index 000000000..a497271ed Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/CreateVehicleTableSpecifications.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/data/DriverModel_ls.rda b/sources/modules/VEHouseholdVehicles-old/data/DriverModel_ls.rda new file mode 100644 index 000000000..23271c0fc Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/DriverModel_ls.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/data/LtTruckModels_ls.rda b/sources/modules/VEHouseholdVehicles-old/data/LtTruckModels_ls.rda new file mode 100644 index 000000000..bbdf03edc Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/LtTruckModels_ls.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/data/PaydWts_.rda b/sources/modules/VEHouseholdVehicles-old/data/PaydWts_.rda new file mode 100644 index 000000000..5a339bc5f Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/PaydWts_.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/data/VehOwnCost_ls.rda b/sources/modules/VEHouseholdVehicles-old/data/VehOwnCost_ls.rda new file mode 100644 index 000000000..2108acb64 Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/VehOwnCost_ls.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/data/VehOwnModels_ls.rda b/sources/modules/VEHouseholdVehicles-old/data/VehOwnModels_ls.rda new file mode 100644 index 000000000..b15bef2d3 Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/VehOwnModels_ls.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/data/VehicleAgeModel_ls.rda b/sources/modules/VEHouseholdVehicles-old/data/VehicleAgeModel_ls.rda new file mode 100644 index 000000000..59bec6287 Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/VehicleAgeModel_ls.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/data/VehicleTypeModel_ls.rda b/sources/modules/VEHouseholdVehicles-old/data/VehicleTypeModel_ls.rda new file mode 100644 index 000000000..fdc4928f2 Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/data/VehicleTypeModel_ls.rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/inst/NOTICE b/sources/modules/VEHouseholdVehicles-old/inst/NOTICE new file mode 100644 index 000000000..3555956a1 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/inst/NOTICE @@ -0,0 +1,6 @@ +Copyright [2017] [AASHTO] +Based in part on works previously copyrighted by the Oregon Department of +Transportation and made available under the Apache License, Version 2.0 and +compatible open-source licenses. + +This software was developed by Brian Gregor, Oregon Systems Analytics LLC (gregor@or-analytics.com) diff --git a/sources/modules/VEHouseholdVehicles-old/inst/extdata/aaa_vehicle_ownership_costs.csv b/sources/modules/VEHouseholdVehicles-old/inst/extdata/aaa_vehicle_ownership_costs.csv new file mode 100644 index 000000000..aff0657b6 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/inst/extdata/aaa_vehicle_ownership_costs.csv @@ -0,0 +1,7 @@ +Category,SmallSedan,MediumSedan,LargeSedan,SmallSUV,MediumSUV,Minivan,Pickup +Insurance,1288,1202,1200,1076,1089,1075,1229 +License/Registration/Taxes,454,639,757,607,831,726,984 +Finance,396,597,706,567,806,692,922 +Depreciation10KPerYear,1969,3028,3601,2646,3479,3654,3308 +Depreciation15KPerYear,2114,3187,3799,2840,3720,3839,3587 +Depreciation20KPerYear,2489,3592,4300,3319,4309,4298,4258 diff --git a/sources/modules/VEHouseholdVehicles-old/inst/extdata/aaa_vehicle_ownership_costs.txt b/sources/modules/VEHouseholdVehicles-old/inst/extdata/aaa_vehicle_ownership_costs.txt new file mode 100644 index 000000000..927e96d0f --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/inst/extdata/aaa_vehicle_ownership_costs.txt @@ -0,0 +1,30 @@ +================================================= +Documentation for aaa_vehicle_ownership_costs.csv +================================================= +Data in this file is used in the CalculateVehicleOwnCost module to compute the cost of owning a vehicle. These costs are used to assess whether households will substitute the use of car services for one or more household vehicle and to compute the ownership cost of the vehicles they own. + +File Structure +-------------- +Rows contain data for cost categories. +Column names as follows: +Category: ownership cost categories which include the following + Insurance: annual cost of a full-coverage insurance policy for personal use of the vehicle + License/Registration/Taxes: cost of all vehicle purchase taxes and annual license and registration fees + Depreciation10KPerYear: value of depreciation for vehicle driven 10,000 miles per year + Depreciation15KPerYear: value of depreciation for vehicle driven 15,000 miles per year + Depreciation20KPerYear: value of depreciation for vehicle driven 20,000 miles per year +SmallSedan: annual cost in dollars for small sedans +MediumSedan: annual cost in dollars for medium sedans +LargeSedan: annual cost in dollars for large sedans +SmallSUV: annual cost in dollars for small sport utility vehicles +MediumSUV: annual cost in dollars for medium sport utility vehicles +Minivan: annual cost in dollars for minivans +Pickup: annual cost in dollars for pickup trucks + +Notes: +Costs are annual averages for vehicles that are purchased new and owned for 5 years. + +Source: +------- +Your Driving Costs: How much are you really paying to drive, American Automobile Association, 2017. Accessed from: +http://exchange.aaa.com/wp-content/uploads/2017/08/17-0013_Your-Driving-Costs-Brochure-2017-FNL-CX-1.pdf diff --git a/sources/modules/VEHouseholdVehicles-old/inst/module_docs/AdjustVehicleOwnership.md b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/AdjustVehicleOwnership.md new file mode 100644 index 000000000..d399a5fbd --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/AdjustVehicleOwnership.md @@ -0,0 +1,91 @@ + +# AdjustVehicleOwnership Module +### November 23, 2018 + +This module adjusts household vehicle ownership based on a comparison of the cost of owning a vehicle per mile of travel compared to the cost per mile of using a car service where the level of service is high. The determination of whether car services are substituted for ownership also depends on input assumptions regarding the average likelihood that an owner would substitute car services for a household vehicle. + +## Model Parameter Estimation + +This module has no estimated parameters. + +## How the Module Works + +The module loads car service cost and substitution probability datasets that are inputs to the CreateVehicleTable module, car service service levels that are inputs from the AssignCarSvcAvailability module, and household vehicle ownership cost data that are outputs of the CalculateVehicleOwnCost module. The module compares the vehicle ownership cost per mile of travel for all vehicles of households living in zones where there is a high level of car service with the cost per mile of using a car service. The module flags all all vehicles where car service is high and the car service use cost is lower than the ownership cost. For those flagged vehicles, the module randomly changes their status from ownership to car service where the probability of change is the substitution probability. For example, if the user believes that only a quarter of light truck owners would substitute car services for owning a light truck (because car services wouldn't enable them to use their light truck as they intend, such as towing a trailer), then the substitution probability would be 0.25. For vehicles where it is determined that car services will substitute for a household vehicle, then the vehicle status is changed from 'Own' to 'HighCarSvc' and the ownership and insurance costs are changed as well. The household's vehicle totals are changed as well. + + +## User Inputs +This module has no user input requirements. + +## Datasets Used by the Module +The following table documents each dataset that is retrieved from the datastore and used by the module. Each row in the table describes a dataset. All the datasets must be present in the datastore. One or more of these datasets may be entered into the datastore from the user input files. The table names and their meanings are as follows: + +NAME - The dataset name. + +TABLE - The table in the datastore that the data is retrieved from. + +GROUP - The group in the datastore where the table is located. Note that the datastore has a group named 'Global' and groups for every model run year. For example, if the model run years are 2010 and 2050, then the datastore will have a group named '2010' and a group named '2050'. If the value for 'GROUP' is 'Year', then the dataset will exist in each model run year group. If the value for 'GROUP' is 'BaseYear' then the dataset will only exist in the base year group (e.g. '2010'). If the value for 'GROUP' is 'Global' then the dataset will only exist in the 'Global' group. + +TYPE - The data type. The framework uses the type to check units and inputs. Refer to the model system design and users guide for information on allowed types. + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values in the datastore do not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Values in the datastore are one or more of the listed values. + +|NAME |TABLE |GROUP |TYPE |UNITS |PROHIBIT |ISELEMENTOF | +|:-------------------|:---------|:-----|:---------|:----------|:------------|:--------------------------| +|Azone |Azone |Year |character |ID | | | +|HighCarSvcCost |Azone |Year |currency |USD |NA, < 0 | | +|LowCarSvcCost |Azone |Year |currency |USD |NA, < 0 | | +|AveCarSvcVehicleAge |Azone |Year |time |YR |NA, < 0 | | +|LtTrkCarSvcSubProp |Azone |Year |double |proportion |NA, < 0, > 1 | | +|AutoCarSvcSubProp |Azone |Year |double |proportion |NA, < 0, > 1 | | +|HhId |Household |Year |character |ID | | | +|Vehicles |Household |Year |vehicles |VEH |NA, < 0 | | +|NumLtTrk |Household |Year |vehicles |VEH |NA, < 0 | | +|NumAuto |Household |Year |vehicles |VEH |NA, < 0 | | +|CarSvcLevel |Household |Year |character |category | |Low, High | +|Azone |Vehicle |Year |character |ID |NA | | +|HhId |Vehicle |Year |character |ID |NA | | +|VehId |Vehicle |Year |character |ID |NA | | +|VehicleAccess |Vehicle |Year |character |category | |Own, LowCarSvc, HighCarSvc | +|Type |Vehicle |Year |character |category |NA |Auto, LtTrk | +|Age |Vehicle |Year |time |YR |NA, < 0 | | +|OwnCost |Vehicle |Year |currency |USD |NA, < 0 | | +|OwnCostPerMile |Vehicle |Year |currency |USD |NA, < 0 | | +|InsCost |Vehicle |Year |currency |USD |NA, < 0 | | + +## Datasets Produced by the Module +The following table documents each dataset that is retrieved from the datastore and used by the module. Each row in the table describes a dataset. All the datasets must be present in the datastore. One or more of these datasets may be entered into the datastore from the user input files. The table names and their meanings are as follows: + +NAME - The dataset name. + +TABLE - The table in the datastore that the data is retrieved from. + +GROUP - The group in the datastore where the table is located. Note that the datastore has a group named 'Global' and groups for every model run year. For example, if the model run years are 2010 and 2050, then the datastore will have a group named '2010' and a group named '2050'. If the value for 'GROUP' is 'Year', then the dataset will exist in each model run year. If the value for 'GROUP' is 'BaseYear' then the dataset will only exist in the base year group (e.g. '2010'). If the value for 'GROUP' is 'Global' then the dataset will only exist in the 'Global' group. + +TYPE - The data type. The framework uses the type to check units and inputs. Refer to the model system design and users guide for information on allowed types. + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values in the datastore do not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Values in the datastore are one or more of the listed values. + +DESCRIPTION - A description of the data. + +|NAME |TABLE |GROUP |TYPE |UNITS |PROHIBIT |ISELEMENTOF |DESCRIPTION | +|:--------------|:---------|:-----|:---------|:--------|:--------|:--------------------------|:------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------| +|Age |Vehicle |Year |time |YR |NA, < 0 | |Vehicle age in years | +|VehicleAccess |Vehicle |Year |character |category | |Own, LowCarSvc, HighCarSvc |Identifier whether vehicle is owned by household (Own), if vehicle is low level car service (LowCarSvc), or if vehicle is high level car service (HighCarSvc) | +|OwnCost |Vehicle |Year |currency |USD |NA, < 0 | |Annual cost of vehicle ownership including depreciation, financing, insurance, taxes, and residential parking in dollars | +|OwnCostPerMile |Vehicle |Year |currency |USD |NA, < 0 | |Annual cost of vehicle ownership per mile of vehicle travel (dollars per mile) | +|InsCost |Vehicle |Year |currency |USD |NA, < 0 | |Annual vehicle insurance cost in dollars | +|SwitchToCarSvc |Vehicle |Year |integer |binary | |0, 1 |Identifies whether a vehicle was switched from owned to car service | +|OwnCostSavings |Household |Year |currency |USD |NA, < 0 | |Annual vehicle ownership cost (depreciation, finance, insurance, taxes) savings in dollars resulting from substituting the use of car services for a household vehicle | +|OwnCost |Household |Year |currency |USD |NA, < 0 | |Annual household vehicle ownership cost (depreciation, finance, insurance, taxes) savings in dollars | +|Vehicles |Household |Year |vehicles |VEH |NA, < 0 | |Number of automobiles and light trucks owned or leased by the household including high level car service vehicles available to driving-age persons | +|NumLtTrk |Household |Year |vehicles |VEH |NA, < 0 | |Number of light trucks (pickup, sport-utility vehicle, and van) owned or leased by household | +|NumAuto |Household |Year |vehicles |VEH |NA, < 0 | |Number of automobiles (i.e. 4-tire passenger vehicles that are not light trucks) owned or leased by household | +|NumHighCarSvc |Household |Year |vehicles |VEH |NA, < 0 | |Number of high level service car service vehicles available to the household (difference between number of vehicles owned by the household and number of driving age persons for households having availability of high level car services | diff --git a/sources/modules/VEHouseholdVehicles-old/inst/module_docs/AssignDrivers.md b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/AssignDrivers.md new file mode 100644 index 000000000..dade0fcf4 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/AssignDrivers.md @@ -0,0 +1,201 @@ + +# AssignDrivers Module +### September 6, 2018 + +This module assigns drivers by age group to each household as a function of the numbers of persons and workers by age group, the household income, land use characteristics, and public transit availability. Users may specify the relative driver licensing rate relative to the model estimation data year in order to account for observed or projected changes in licensing rates. + +## Model Parameter Estimation + +Binary logit models are estimated to predict the probability that a person has a drivers license. Two versions of the model are estimated, one for persons in a metropolitan (i.e. urbanized) area, and another for persons located in non-metropolitan areas. There are different versions because the estimation data have more information about transportation system and land use characteristics for households located in urbanized areas. In both versions, the probability that a person has a drivers license is a function of the age group of the person, whether the person is a worker, the number of persons in the household, the income and squared income of the household, whether the household lives in a single-family dwelling, and the population density of the Bzone where the person lives. In the metropolitan area model, the bus-equivalent transit revenue miles and whether the household resides in an urban mixed-use neighborhood are significant factors. Following are the summary statistics for the metropolitan model: + +``` + +Call: +glm(formula = makeFormula(StartTerms_), family = binomial, data = EstData_df[TrainIdx, + ]) + +Deviance Residuals: + Min 1Q Median 3Q Max +-3.3122 0.1289 0.2081 0.3996 3.0679 + +Coefficients: + Estimate Std. Error z value Pr(>|z|) +(Intercept) -1.800e+01 1.045e+02 -0.172 0.863 +Age15to19 1.718e+01 1.045e+02 0.164 0.869 +Age20to29 1.954e+01 1.045e+02 0.187 0.852 +Age30to54 1.987e+01 1.045e+02 0.190 0.849 +Age55to64 1.974e+01 1.045e+02 0.189 0.850 +Age65Plus 1.915e+01 1.045e+02 0.183 0.855 +Worker 1.302e+00 5.138e-02 25.337 <2e-16 *** +HhSize -2.781e-01 1.649e-02 -16.865 <2e-16 *** +Income 4.400e-05 1.991e-06 22.095 <2e-16 *** +IncomeSq -1.825e-10 1.190e-11 -15.338 <2e-16 *** +IsSF 4.571e-01 5.111e-02 8.943 <2e-16 *** +PopDensity -3.915e-05 3.173e-06 -12.341 <2e-16 *** +IsUrbanMixNbrhd -6.387e-01 5.952e-02 -10.730 <2e-16 *** +TranRevMiPC -7.978e-03 7.545e-04 -10.573 <2e-16 *** +--- +Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +(Dispersion parameter for binomial family taken to be 1) + + Null deviance: 26571 on 31294 degrees of freedom +Residual deviance: 14829 on 31281 degrees of freedom + (10267 observations deleted due to missingness) +AIC: 14857 + +Number of Fisher Scoring iterations: 16 + +``` + +Following are the summary statistics for the non-metropolitan model: + +``` + +Call: +glm(formula = makeFormula(StartTerms_), family = binomial, data = EstData_df[TrainIdx, + ]) + +Deviance Residuals: + Min 1Q Median 3Q Max +-3.2933 0.1200 0.1757 0.3438 2.2095 + +Coefficients: + Estimate Std. Error z value Pr(>|z|) +(Intercept) -1.949e+01 1.143e+02 -0.171 0.865 +Age15to19 1.853e+01 1.143e+02 0.162 0.871 +Age20to29 2.086e+01 1.143e+02 0.183 0.855 +Age30to54 2.108e+01 1.143e+02 0.184 0.854 +Age55to64 2.105e+01 1.143e+02 0.184 0.854 +Age65Plus 2.038e+01 1.143e+02 0.178 0.858 +Worker 1.585e+00 4.617e-02 34.327 <2e-16 *** +HhSize -2.360e-01 1.486e-02 -15.884 <2e-16 *** +Income 4.486e-05 1.815e-06 24.721 <2e-16 *** +IncomeSq -2.045e-10 1.143e-11 -17.895 <2e-16 *** +IsSF 4.546e-01 4.316e-02 10.532 <2e-16 *** +PopDensity -6.087e-05 3.704e-06 -16.436 <2e-16 *** +--- +Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +(Dispersion parameter for binomial family taken to be 1) + + Null deviance: 43356 on 57771 degrees of freedom +Residual deviance: 21625 on 57760 degrees of freedom + (16574 observations deleted due to missingness) +AIC: 21649 + +Number of Fisher Scoring iterations: 17 + +``` + +The models are estimated using the *Hh_df* (household) and *Per_df* (person) datasets in the VE2001NHTS package. Information about these datasets and how they were developed from the 2001 National Household Travel Survey public use dataset is included in that package. + +## How the Module Works + +The module iterates through each age group excluding the 0-14 year age group and creates a temporary set of person records for households in the region. For each household there are as many person records as there are persons in the age group in the household. A worker status attribute is added to each record based on the number of workers in the age group in the household. For example, if a household has 2 persons and 1 worker in the 20-29 year age group, one of the records would have its worker status attribute equal to 1 and the other would have its worker status attribute equal to 0. The person records are also populated with the household characteristics used in the model. The binomial logit model is applied to the person records to determine the probability that each person is a driver. The driver status of each person is determined by random draws with the modeled probability determining the likelihood that the person is determined to be a driver. The resulting number of drivers in the age group is then tabulated by household. + + +## User Inputs +The following table(s) document each input file that must be provided in order for the module to run correctly. User input files are comma-separated valued (csv) formatted text files. Each row in the table(s) describes a field (column) in the input file. The table names and their meanings are as follows: + +NAME - The field (column) name in the input file. Note that if the 'TYPE' is 'currency' the field name must be followed by a period and the year that the currency is denominated in. For example if the NAME is 'HHIncomePC' (household per capita income) and the input values are in 2010 dollars, the field name in the file must be 'HHIncomePC.2010'. The framework uses the embedded date information to convert the currency into base year currency amounts. The user may also embed a magnitude indicator if inputs are in thousand, millions, etc. The VisionEval model system design and users guide should be consulted on how to do that. + +TYPE - The data type. The framework uses the type to check units and inputs. The user can generally ignore this, but it is important to know whether the 'TYPE' is 'currency' + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values may not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Value must be one of the listed values. + +UNLIKELY - Values that are unlikely. Values that meet any of the listed conditions are permitted but a warning message will be given when the input data are processed. + +DESCRIPTION - A description of the data. + +### region_hh_driver_adjust_prop.csv +This input file is OPTIONAL. + +|NAME |TYPE |UNITS |PROHIBIT |ISELEMENTOF |UNLIKELY |DESCRIPTION | +|:----------------|:------|:----------|:--------|:-----------|:--------|:----------------------------------------------------------------------------------------------| +|Year | | | | | |Must contain a record for each model run year | +|Drv15to19AdjProp |double |proportion |NA, < 0 | |> 1.5 |Target proportion of unadjusted model number of drivers 15 to 19 years old (1 = no adjustment) | +|Drv20to29AdjProp |double |proportion |NA, < 0 | |> 1.5 |Target proportion of unadjusted model number of drivers 20 to 29 years old (1 = no adjustment) | +|Drv30to54AdjProp |double |proportion |NA, < 0 | |> 1.5 |Target proportion of unadjusted model number of drivers 30 to 54 years old (1 = no adjustment) | +|Drv55to64AdjProp |double |proportion |NA, < 0 | |> 1.5 |Target proportion of unadjusted model number of drivers 55 to 64 years old (1 = no adjustment) | +|Drv65PlusAdjProp |double |proportion |NA, < 0 | |> 1.5 |Target proportion of unadjusted model number of drivers 65 or older (1 = no adjustment) | + +## Datasets Used by the Module +The following table documents each dataset that is retrieved from the datastore and used by the module. Each row in the table describes a dataset. All the datasets must be present in the datastore. One or more of these datasets may be entered into the datastore from the user input files. The table names and their meanings are as follows: + +NAME - The dataset name. + +TABLE - The table in the datastore that the data is retrieved from. + +GROUP - The group in the datastore where the table is located. Note that the datastore has a group named 'Global' and groups for every model run year. For example, if the model run years are 2010 and 2050, then the datastore will have a group named '2010' and a group named '2050'. If the value for 'GROUP' is 'Year', then the dataset will exist in each model run year group. If the value for 'GROUP' is 'BaseYear' then the dataset will only exist in the base year group (e.g. '2010'). If the value for 'GROUP' is 'Global' then the dataset will only exist in the 'Global' group. + +TYPE - The data type. The framework uses the type to check units and inputs. Refer to the model system design and users guide for information on allowed types. + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values in the datastore do not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Values in the datastore are one or more of the listed values. + +|NAME |TABLE |GROUP |TYPE |UNITS |PROHIBIT |ISELEMENTOF | +|:----------------|:---------|:-----|:---------|:----------|:--------|:------------------| +|Drv15to19AdjProp |Region |Year |double |proportion |NA, < 0 | | +|Drv20to29AdjProp |Region |Year |double |proportion |NA, < 0 | | +|Drv30to54AdjProp |Region |Year |double |proportion |NA, < 0 | | +|Drv55to64AdjProp |Region |Year |double |proportion |NA, < 0 | | +|Drv65PlusAdjProp |Region |Year |double |proportion |NA, < 0 | | +|Marea |Marea |Year |character |ID | | | +|TranRevMiPC |Marea |Year |compound |MI/PRSN/YR |NA, < 0 | | +|Bzone |Bzone |Year |character |ID | | | +|D1B |Bzone |Year |compound |PRSN/SQMI |NA, < 0 | | +|Marea |Household |Year |character |ID | | | +|Bzone |Household |Year |character |ID | | | +|HhId |Household |Year |character |ID | | | +|Age15to19 |Household |Year |people |PRSN |NA, < 0 | | +|Age20to29 |Household |Year |people |PRSN |NA, < 0 | | +|Age30to54 |Household |Year |people |PRSN |NA, < 0 | | +|Age55to64 |Household |Year |people |PRSN |NA, < 0 | | +|Age65Plus |Household |Year |people |PRSN |NA, < 0 | | +|Wkr15to19 |Household |Year |people |PRSN |NA, < 0 | | +|Wkr20to29 |Household |Year |people |PRSN |NA, < 0 | | +|Wkr30to54 |Household |Year |people |PRSN |NA, < 0 | | +|Wkr55to64 |Household |Year |people |PRSN |NA, < 0 | | +|Wkr65Plus |Household |Year |people |PRSN |NA, < 0 | | +|Income |Household |Year |currency |USD.2001 |NA, < 0 | | +|HhSize |Household |Year |people |PRSN |NA, <= 0 | | +|HouseType |Household |Year |character |category | |SF, MF, GQ | +|IsUrbanMixNbrhd |Household |Year |integer |binary |NA |0, 1 | +|LocType |Household |Year |character |category |NA |Urban, Town, Rural | + +## Datasets Produced by the Module +The following table documents each dataset that is retrieved from the datastore and used by the module. Each row in the table describes a dataset. All the datasets must be present in the datastore. One or more of these datasets may be entered into the datastore from the user input files. The table names and their meanings are as follows: + +NAME - The dataset name. + +TABLE - The table in the datastore that the data is retrieved from. + +GROUP - The group in the datastore where the table is located. Note that the datastore has a group named 'Global' and groups for every model run year. For example, if the model run years are 2010 and 2050, then the datastore will have a group named '2010' and a group named '2050'. If the value for 'GROUP' is 'Year', then the dataset will exist in each model run year. If the value for 'GROUP' is 'BaseYear' then the dataset will only exist in the base year group (e.g. '2010'). If the value for 'GROUP' is 'Global' then the dataset will only exist in the 'Global' group. + +TYPE - The data type. The framework uses the type to check units and inputs. Refer to the model system design and users guide for information on allowed types. + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values in the datastore do not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Values in the datastore are one or more of the listed values. + +DESCRIPTION - A description of the data. + +|NAME |TABLE |GROUP |TYPE |UNITS |PROHIBIT |ISELEMENTOF |DESCRIPTION | +|:-------------|:---------|:-----|:------|:-----|:--------|:-----------|:------------------------------------------------------| +|Drv15to19 |Household |Year |people |PRSN |NA, < 0 | |Number of drivers 15 to 19 years old | +|Drv20to29 |Household |Year |people |PRSN |NA, < 0 | |Number of drivers 20 to 29 years old | +|Drv30to54 |Household |Year |people |PRSN |NA, < 0 | |Number of drivers 30 to 54 years old | +|Drv55to64 |Household |Year |people |PRSN |NA, < 0 | |Number of drivers 55 to 64 years old | +|Drv65Plus |Household |Year |people |PRSN |NA, < 0 | |Number of drivers 65 or older | +|Drivers |Household |Year |people |PRSN |NA, < 0 | |Number of drivers in household | +|DrvAgePersons |Household |Year |people |PRSN |NA, < 0 | |Number of people 15 year old or older in the household | diff --git a/sources/modules/VEHouseholdVehicles-old/inst/module_docs/AssignVehicleAge.md b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/AssignVehicleAge.md new file mode 100644 index 000000000..6487a9485 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/AssignVehicleAge.md @@ -0,0 +1,108 @@ + +# AssignVehicleAge Module +### September 7, 2018 + +This module assigns vehicle ages to each household vehicle. Vehicle age is assigned as a function of the vehicle type (auto or light truck), household income, and assumed mean vehicle age by vehicle type and Azone. Car service vehicles are assigned an age based on input assumptions with no distinction between vehicle type. + +## Model Parameter Estimation + +The models are estimated using the *Hh_df* (household) and *Veh_df* (vehicle) datasets in the VE2001NHTS package. Information about these datasets and how they were developed from the 2001 National Household Travel Survey public use dataset is included in that package. For each vehicle type (auto, light truck), tabulations are made of cumulative proportions of vehicles by age (i.e. proportion of vehicles less than or equal to the age) and the joint proportion of vehicles by age and income group. For these tabulations, the maximum vehicle age was set at 30 years. This ignores about 1.5% of the vehicle records. + +The following figure shows the cumulative proportions of vehicles by vehicle age. + +![cum_age_props_by_veh-type.png](cum_age_props_by_veh-type.png) + +The following figure compares the age proportions of automobiles by income group. It can be seen that as income decreases, the age distribution shifts towards older vehicles. The 6 income groups are $0 to $20,000, $20,000 to $40,000, $40,000 to $60,000, $60,000 to $80,000, $80,000 to $100,000, $100,000 plus. + +![auto_age_props_by_inc.png](auto_age_props_by_inc.png) + +The following figure compares the age proportions of light trucks by income group. As with automobiles, as increases, the age distributions shifts to older vehicles. + +![lttrk_age_props_by_inc.png](lttrk_age_props_by_inc.png) + +## How the Module Works + +The module auto and light truck vehicle age distributions which match user inputs for mean auto age and mean light truck age. The module adjusts the cumulative age distribution to match a target mean age. This is done by either expanding the age interval (i.e. a year is 10% longer) if the mean age increases, or compressing the age interval if the mean age decreases. A binary search function is used to determine the amount of expansion or compression of the estimated age distribution is necessary in order to match the input mean age. The age distribution for the vehicles is derived from the adjusted cumulative age distribution. + +Once the age distribution for a vehicle type has been determined, the module calculates vehicle age distributions by household income group. It takes marginal distributions of vehicles by age and vehicles by household income group along with a seed matrix of the joint probability distribution of vehicles by age and income group, and then uses iterative proportional fitting to adjust the joint probabilities to match the margins. The age probability by income group is calculated from the joint probability matrix. These probabilities are then used as sampling distributions to determine the age of each household vehicle as a function of the vehicle type and the household income. + + +## User Inputs +The following table(s) document each input file that must be provided in order for the module to run correctly. User input files are comma-separated valued (csv) formatted text files. Each row in the table(s) describes a field (column) in the input file. The table names and their meanings are as follows: + +NAME - The field (column) name in the input file. Note that if the 'TYPE' is 'currency' the field name must be followed by a period and the year that the currency is denominated in. For example if the NAME is 'HHIncomePC' (household per capita income) and the input values are in 2010 dollars, the field name in the file must be 'HHIncomePC.2010'. The framework uses the embedded date information to convert the currency into base year currency amounts. The user may also embed a magnitude indicator if inputs are in thousand, millions, etc. The VisionEval model system design and users guide should be consulted on how to do that. + +TYPE - The data type. The framework uses the type to check units and inputs. The user can generally ignore this, but it is important to know whether the 'TYPE' is 'currency' + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values may not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Value must be one of the listed values. + +UNLIKELY - Values that are unlikely. Values that meet any of the listed conditions are permitted but a warning message will be given when the input data are processed. + +DESCRIPTION - A description of the data. + +### azone_hh_veh_mean_age.csv +|NAME |TYPE |UNITS |PROHIBIT |ISELEMENTOF |UNLIKELY |DESCRIPTION | +|:------------|:----|:-----|:--------------|:-----------|:--------|:--------------------------------------------------------| +|Geo | | | |Azones | |Must contain a record for each Azone and model run year. | +|Year | | | | | |Must contain a record for each Azone and model run year. | +|AutoMeanAge |time |YR |NA, < 5, >= 14 | | |Mean age of automobiles owned or leased by households. | +|LtTrkMeanAge |time |YR |NA, < 5, >= 14 | | |Mean age of light trucks owned or leased by households. | + +## Datasets Used by the Module +The following table documents each dataset that is retrieved from the datastore and used by the module. Each row in the table describes a dataset. All the datasets must be present in the datastore. One or more of these datasets may be entered into the datastore from the user input files. The table names and their meanings are as follows: + +NAME - The dataset name. + +TABLE - The table in the datastore that the data is retrieved from. + +GROUP - The group in the datastore where the table is located. Note that the datastore has a group named 'Global' and groups for every model run year. For example, if the model run years are 2010 and 2050, then the datastore will have a group named '2010' and a group named '2050'. If the value for 'GROUP' is 'Year', then the dataset will exist in each model run year group. If the value for 'GROUP' is 'BaseYear' then the dataset will only exist in the base year group (e.g. '2010'). If the value for 'GROUP' is 'Global' then the dataset will only exist in the 'Global' group. + +TYPE - The data type. The framework uses the type to check units and inputs. Refer to the model system design and users guide for information on allowed types. + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values in the datastore do not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Values in the datastore are one or more of the listed values. + +|NAME |TABLE |GROUP |TYPE |UNITS |PROHIBIT |ISELEMENTOF | +|:-------------------|:---------|:-----|:---------|:--------|:--------|:--------------------------| +|Azone |Azone |Year |character |ID | | | +|AutoMeanAge |Azone |Year |time |YR |NA, <= 0 | | +|LtTrkMeanAge |Azone |Year |time |YR |NA, <= 0 | | +|Azone |Household |Year |character |ID | | | +|HhId |Household |Year |character |ID | | | +|Income |Household |Year |currency |USD.2001 |NA, < 0 | | +|Azone |Vehicle |Year |character |ID | | | +|HhId |Vehicle |Year |character |ID |NA | | +|VehId |Vehicle |Year |character |ID |NA | | +|VehicleAccess |Vehicle |Year |character |category | |Own, LowCarSvc, HighCarSvc | +|Type |Vehicle |Year |character |category |NA |Auto, LtTrk | +|AveCarSvcVehicleAge |Azone |Year |time |YR |NA, < 0 | | + +## Datasets Produced by the Module +The following table documents each dataset that is retrieved from the datastore and used by the module. Each row in the table describes a dataset. All the datasets must be present in the datastore. One or more of these datasets may be entered into the datastore from the user input files. The table names and their meanings are as follows: + +NAME - The dataset name. + +TABLE - The table in the datastore that the data is retrieved from. + +GROUP - The group in the datastore where the table is located. Note that the datastore has a group named 'Global' and groups for every model run year. For example, if the model run years are 2010 and 2050, then the datastore will have a group named '2010' and a group named '2050'. If the value for 'GROUP' is 'Year', then the dataset will exist in each model run year. If the value for 'GROUP' is 'BaseYear' then the dataset will only exist in the base year group (e.g. '2010'). If the value for 'GROUP' is 'Global' then the dataset will only exist in the 'Global' group. + +TYPE - The data type. The framework uses the type to check units and inputs. Refer to the model system design and users guide for information on allowed types. + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values in the datastore do not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Values in the datastore are one or more of the listed values. + +DESCRIPTION - A description of the data. + +|NAME |TABLE |GROUP |TYPE |UNITS |PROHIBIT |ISELEMENTOF |DESCRIPTION | +|:----|:-------|:-----|:----|:-----|:--------|:-----------|:--------------------| +|Age |Vehicle |Year |time |YR |NA, < 0 | |Vehicle age in years | diff --git a/sources/modules/VEHouseholdVehicles-old/inst/module_docs/AssignVehicleOwnership.md b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/AssignVehicleOwnership.md new file mode 100644 index 000000000..39dd5f578 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/AssignVehicleOwnership.md @@ -0,0 +1,203 @@ + +# AssignVehicleOwnership Module +### November 23, 2018 + +This module determines the number of vehicles owned or leased by each household as a function of household characteristics, land use characteristics, and transportation system characteristics. + +## Model Parameter Estimation + +The vehicle ownership model is segmented for metropolitan and non-metropolitan households because additional information about transit supply and the presence of urban mixed-use neighborhoods is available for metropolitan households that is not available for non-metropolitan households. There are two models for each segment. A binary logit model is used to predict which households own no vehicles. An ordered logit model is used to predict how many vehicles a household owns if they own any vehicles. The number of vehicles a household may be assigned is 6. + +The metropolitan model for determining whether a household owns no vehicles is documented below. As expected, the probability that a household is carless is greater for low income households (less than $20,000), households living in higher density and/or mixed-use neighborhoods, and households living in metropolitan areas having higher levels of transit service. The probability decreases as the number of drivers in the household increases, household income increases, and if the household lives in a single-family dwelling. The number of drivers has the greatest influence on car ownership. The number of workers increases the probability of no vehicle ownership, but since the model includes drivers, this coefficient probably reflects the effect of non-driving workers on vehicle ownership. + +``` + +Call: +glm(formula = ZeroVeh ~ Workers + LowInc + LogIncome + IsSF + + Drivers + IsUrbanMixNbrhd + LogDensity + TranRevMiPC, family = binomial, + data = EstData_df) + +Deviance Residuals: + Min 1Q Median 3Q Max +-2.7069 -0.2152 -0.0628 -0.0332 4.4914 + +Coefficients: + Estimate Std. Error z value Pr(>|z|) +(Intercept) 1.347976 0.766875 1.758 0.0788 . +Workers 0.432869 0.061513 7.037 1.96e-12 *** +LowInc 0.759137 0.125686 6.040 1.54e-09 *** +LogIncome -0.366476 0.066661 -5.498 3.85e-08 *** +IsSF -0.682829 0.086989 -7.850 4.17e-15 *** +Drivers -3.193416 0.090087 -35.448 < 2e-16 *** +IsUrbanMixNbrhd 0.839238 0.093167 9.008 < 2e-16 *** +LogDensity 0.239777 0.039492 6.072 1.27e-09 *** +TranRevMiPC 0.014992 0.001327 11.299 < 2e-16 *** +--- +Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +(Dispersion parameter for binomial family taken to be 1) + + Null deviance: 12200.1 on 19630 degrees of freedom +Residual deviance: 5159.1 on 19622 degrees of freedom +AIC: 5177.1 + +Number of Fisher Scoring iterations: 8 + +``` + +The non-metropolitan model for zero car ownership is shown below. The model terms are the same as for the metropolitan model with the exception of the urban mixed-use and transit supply variables. The signs of the variables are the same as for the metropolitan model and the values are of similar magnitude. + +``` + +Call: +glm(formula = ZeroVeh ~ Workers + LowInc + LogIncome + IsSF + + Drivers + LogDensity, family = binomial, data = EstData_df) + +Deviance Residuals: + Min 1Q Median 3Q Max +-2.7362 -0.1636 -0.0262 -0.0190 6.3244 + +Coefficients: + Estimate Std. Error z value Pr(>|z|) +(Intercept) 6.52758 0.79801 8.180 2.84e-16 *** +Workers 0.32080 0.07781 4.123 3.74e-05 *** +LowInc 0.56568 0.13351 4.237 2.26e-05 *** +LogIncome -0.65297 0.07470 -8.741 < 2e-16 *** +IsSF -0.77947 0.08803 -8.854 < 2e-16 *** +Drivers -4.11347 0.09972 -41.248 < 2e-16 *** +LogDensity 0.13658 0.02565 5.324 1.01e-07 *** +--- +Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +(Dispersion parameter for binomial family taken to be 1) + + Null deviance: 10952 on 34081 degrees of freedom +Residual deviance: 4448 on 34075 degrees of freedom +AIC: 4462 + +Number of Fisher Scoring iterations: 9 + +``` + +The ordered logit model for the number of vehicles owned by metropolitan households that own at least one vehicle is shown below. Households are likely to own more vehicles if they live in a single-family dwelling, have higher incomes, have more workers, and have more drivers. Households are likely to own fewer vehicles if all household members are elderly, they live in a higher density and/or urban mixed-use neighborhood, they live in a metropolitan area with a higher level of transit service, and if more persons are in the household. The latter result is at surprising at first glance, but since the model also includes the number of drivers and number of workers, the household size coefficient is probably showing the effect of non-drivers non-workers in the household. + +``` +formula: +VehOrd ~ Workers + LogIncome + Drivers + HhSize + OnlyElderly + IsSF + IsUrbanMixNbrhd + LogDensity + TranRevMiPC +data: EstData_df + + link threshold nobs logLik AIC niter max.grad cond.H + logit equidistant 17794 -14662.10 29346.20 7(0) 4.54e-11 9.7e+05 + +Coefficients: + Estimate Std. Error z value Pr(>|z|) +Workers 0.2402913 0.0263983 9.103 < 2e-16 *** +LogIncome 0.5090310 0.0257440 19.773 < 2e-16 *** +Drivers 2.3220340 0.0376671 61.646 < 2e-16 *** +HhSize -0.0635976 0.0156797 -4.056 4.99e-05 *** +OnlyElderly -0.4343603 0.0575421 -7.549 4.40e-14 *** +IsSF 0.7784887 0.0422429 18.429 < 2e-16 *** +IsUrbanMixNbrhd -0.2344384 0.0482043 -4.863 1.15e-06 *** +LogDensity -0.2022960 0.0127091 -15.917 < 2e-16 *** +TranRevMiPC -0.0031226 0.0005294 -5.899 3.66e-09 *** +--- +Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +Threshold coefficients: + Estimate Std. Error z value +threshold.1 7.68088 0.29013 26.47 +spacing 2.99870 0.02662 112.65 +``` + +The ordered logit model for non-metropolitan household vehicle ownership is described below. The variables are the same as for the metropolitan model with the exception of the urban mixed-use neighborhood and transit variables. The signs of the coefficients are the same and the magnitudes are similar. + +``` +formula: +VehOrd ~ Workers + LogIncome + Drivers + HhSize + OnlyElderly + IsSF + LogDensity +data: EstData_df + + link threshold nobs logLik AIC niter max.grad cond.H + logit equidistant 32796 -30632.66 61283.32 7(0) 1.78e-10 4.8e+04 + +Coefficients: + Estimate Std. Error z value Pr(>|z|) +Workers 0.291080 0.018607 15.643 < 2e-16 *** +LogIncome 0.513030 0.017744 28.913 < 2e-16 *** +Drivers 2.083690 0.026662 78.151 < 2e-16 *** +HhSize -0.059411 0.011301 -5.257 1.46e-07 *** +OnlyElderly -0.352559 0.037467 -9.410 < 2e-16 *** +IsSF 0.710680 0.035003 20.303 < 2e-16 *** +LogDensity -0.167458 0.006486 -25.818 < 2e-16 *** +--- +Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +Threshold coefficients: + Estimate Std. Error z value +threshold.1 7.81783 0.18654 41.91 +spacing 2.68819 0.01687 159.37 +``` + +## How the Module Works + +For each household, the metropolitan or non-metropolitan binary logit model is run to predict the probability that the household owns no vehicles. A random number is drawn from a uniform distribution in the interval from 0 to 1 and if the result is less than the probability of zero-vehicle ownership, the household is assigned no vehicles. Households that have no drivers are also assigned 0 vehicles. The metropolitan or non-metropolitan ordered logit model is run to predict the number of vehicles owned by the household if they own any. + + +## User Inputs +This module has no user input requirements. + +## Datasets Used by the Module +The following table documents each dataset that is retrieved from the datastore and used by the module. Each row in the table describes a dataset. All the datasets must be present in the datastore. One or more of these datasets may be entered into the datastore from the user input files. The table names and their meanings are as follows: + +NAME - The dataset name. + +TABLE - The table in the datastore that the data is retrieved from. + +GROUP - The group in the datastore where the table is located. Note that the datastore has a group named 'Global' and groups for every model run year. For example, if the model run years are 2010 and 2050, then the datastore will have a group named '2010' and a group named '2050'. If the value for 'GROUP' is 'Year', then the dataset will exist in each model run year group. If the value for 'GROUP' is 'BaseYear' then the dataset will only exist in the base year group (e.g. '2010'). If the value for 'GROUP' is 'Global' then the dataset will only exist in the 'Global' group. + +TYPE - The data type. The framework uses the type to check units and inputs. Refer to the model system design and users guide for information on allowed types. + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values in the datastore do not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Values in the datastore are one or more of the listed values. + +|NAME |TABLE |GROUP |TYPE |UNITS |PROHIBIT |ISELEMENTOF | +|:---------------|:---------|:-----|:---------|:----------|:--------|:------------------| +|Marea |Marea |Year |character |ID | | | +|TranRevMiPC |Marea |Year |compound |MI/PRSN/YR |NA, < 0 | | +|Marea |Bzone |Year |character |ID | | | +|Bzone |Bzone |Year |character |ID | | | +|D1B |Bzone |Year |compound |PRSN/SQMI |NA, < 0 | | +|Bzone |Household |Year |character |ID | | | +|Workers |Household |Year |people |PRSN |NA, < 0 | | +|Drivers |Household |Year |people |PRSN |NA, < 0 | | +|Income |Household |Year |currency |USD.2001 |NA, < 0 | | +|HouseType |Household |Year |character |category | |SF, MF, GQ | +|HhSize |Household |Year |people |PRSN |NA, <= 0 | | +|Age65Plus |Household |Year |people |PRSN |NA, < 0 | | +|IsUrbanMixNbrhd |Household |Year |integer |binary |NA |0, 1 | +|LocType |Household |Year |character |category |NA |Urban, Town, Rural | + +## Datasets Produced by the Module +The following table documents each dataset that is retrieved from the datastore and used by the module. Each row in the table describes a dataset. All the datasets must be present in the datastore. One or more of these datasets may be entered into the datastore from the user input files. The table names and their meanings are as follows: + +NAME - The dataset name. + +TABLE - The table in the datastore that the data is retrieved from. + +GROUP - The group in the datastore where the table is located. Note that the datastore has a group named 'Global' and groups for every model run year. For example, if the model run years are 2010 and 2050, then the datastore will have a group named '2010' and a group named '2050'. If the value for 'GROUP' is 'Year', then the dataset will exist in each model run year. If the value for 'GROUP' is 'BaseYear' then the dataset will only exist in the base year group (e.g. '2010'). If the value for 'GROUP' is 'Global' then the dataset will only exist in the 'Global' group. + +TYPE - The data type. The framework uses the type to check units and inputs. Refer to the model system design and users guide for information on allowed types. + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values in the datastore do not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Values in the datastore are one or more of the listed values. + +DESCRIPTION - A description of the data. + +|NAME |TABLE |GROUP |TYPE |UNITS |PROHIBIT |ISELEMENTOF |DESCRIPTION | +|:--------|:---------|:-----|:--------|:-----|:--------|:-----------|:--------------------------------------------------------------------------------------------------------------------------------------------------| +|Vehicles |Household |Year |vehicles |VEH |NA, < 0 | |Number of automobiles and light trucks owned or leased by the household including high level car service vehicles available to driving-age persons | diff --git a/sources/modules/VEHouseholdVehicles-old/inst/module_docs/AssignVehicleType.md b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/AssignVehicleType.md new file mode 100644 index 000000000..7a53e9b89 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/AssignVehicleType.md @@ -0,0 +1,159 @@ + +# AssignVehicleType Module +### November 23, 2018 + +This module identifies how many household vehicles are light trucks and how many are automobiles. Light trucks include pickup trucks, sport utility vehicles, vans, and any other vehicle not classified as a passenger car. Automobiles are vehicles classified as passenger cars. The crossover vehicle category [blurs the line between light trucks and passenger vehicles](https://www.eia.gov/todayinenergy/detail.php?id=31352). Their classification as light trucks or automobiles depends on the agency doing the classification and purpose of the classification. These vehicles were not a significant portion of the market when the model estimation data were collected and so are not explictly considered. How they are classified is up to the model user who is responsible for specifying the light truck proportion of the vehicle fleet. + +## Model Parameter Estimation + +A binary logit models are estimated to predict the probability that a household vehicle is a light truck. A summary of the estimated model follows. The probability that a vehicle is a light truck increases if: + +* The ratio of the number of persons in the household to the number of vehicles in the household increases; + +* The number of children in the household increases; + +* The ratio of vehicles to drivers increases, especially if the number of vehicles is greater than the number of drivers; and, + +* The household lives in a single-family dwelling. + +The probability decreases if: + +* The household only owns one vehicle; + +* The household has low income (less than $20,000 in year 2000 dollars); + +* The household lives in a higher density neighborhood; and, + +* The household lives in an urban mixed-use neighborhood. + +``` + +Call: +glm(formula = makeFormula(StartTerms_), family = binomial, data = EstData_df) + +Deviance Residuals: + Min 1Q Median 3Q Max +-3.2093 -0.7703 -0.2093 0.5060 3.6297 + +Coefficients: + Estimate Std. Error z value Pr(>|z|) +(Intercept) -0.280653 0.052778 -5.318 1.05e-07 *** +PrsnPerVeh 0.280447 0.018733 14.971 < 2e-16 *** +NumChild 0.093490 0.009726 9.612 < 2e-16 *** +NumVehGtNumDvr 0.416944 0.035014 11.908 < 2e-16 *** +NumVehEqNumDvr 0.216757 0.029180 7.428 1.10e-13 *** +IsSF 0.372638 0.020487 18.189 < 2e-16 *** +OnlyOneVeh -0.699185 0.024482 -28.559 < 2e-16 *** +IsLowIncome -0.269053 0.024296 -11.074 < 2e-16 *** +LogDensity -0.130321 0.003887 -33.532 < 2e-16 *** +IsUrbanMixNbrhd -0.156379 0.030344 -5.154 2.56e-07 *** +--- +Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 + +(Dispersion parameter for binomial family taken to be 1) + + Null deviance: 66655 on 51781 degrees of freedom +Residual deviance: 60046 on 51772 degrees of freedom +AIC: 93279 + +Number of Fisher Scoring iterations: 4 + +``` + +The model and all of its independent variables are significant, but it only explains a modest proportion of the observed variation in light truck ownership. When the model is applied to the estimation dataset, it correctly predicts the number of light trucks for about 46% of the households. Over predictions and under predictions are approximately equal as shown in the following table. + + +|Prediction | Proportion| +|:-----------------|----------:| +|Under Predict | 0.269| +|Correctly Predict | 0.462| +|Over Predict | 0.269| + +## How the Module Works + +The user inputs the light truck proportion of vehicles observed or assumed each each Azone. The module calls the `applyBinomialModel` function (part of the *visioneval* framework package), passing it the estimated binomial logit model and a data frame of values for the independent variables, and the user-supplied light truck proportion. The `applyBinomialModel` function uses a binary search algorithm to adjust the intercept of the model so that the resulting light truck proportion of all household vehicles in the Azone equals the user input. + + +## User Inputs +The following table(s) document each input file that must be provided in order for the module to run correctly. User input files are comma-separated valued (csv) formatted text files. Each row in the table(s) describes a field (column) in the input file. The table names and their meanings are as follows: + +NAME - The field (column) name in the input file. Note that if the 'TYPE' is 'currency' the field name must be followed by a period and the year that the currency is denominated in. For example if the NAME is 'HHIncomePC' (household per capita income) and the input values are in 2010 dollars, the field name in the file must be 'HHIncomePC.2010'. The framework uses the embedded date information to convert the currency into base year currency amounts. The user may also embed a magnitude indicator if inputs are in thousand, millions, etc. The VisionEval model system design and users guide should be consulted on how to do that. + +TYPE - The data type. The framework uses the type to check units and inputs. The user can generally ignore this, but it is important to know whether the 'TYPE' is 'currency' + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values may not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Value must be one of the listed values. + +UNLIKELY - Values that are unlikely. Values that meet any of the listed conditions are permitted but a warning message will be given when the input data are processed. + +DESCRIPTION - A description of the data. + +### azone_hh_lttrk_prop.csv +|NAME |TYPE |UNITS |PROHIBIT |ISELEMENTOF |UNLIKELY |DESCRIPTION | +|:---------|:------|:----------|:--------------|:-----------|:--------|:-------------------------------------------------------------------------| +|Geo | | | |Azones | |Must contain a record for each Azone and model run year. | +|Year | | | | | |Must contain a record for each Azone and model run year. | +|LtTrkProp |double |proportion |NA, <= 0, >= 1 | | |Proportion of household vehicles that are light trucks (pickup, SUV, van) | + +## Datasets Used by the Module +The following table documents each dataset that is retrieved from the datastore and used by the module. Each row in the table describes a dataset. All the datasets must be present in the datastore. One or more of these datasets may be entered into the datastore from the user input files. The table names and their meanings are as follows: + +NAME - The dataset name. + +TABLE - The table in the datastore that the data is retrieved from. + +GROUP - The group in the datastore where the table is located. Note that the datastore has a group named 'Global' and groups for every model run year. For example, if the model run years are 2010 and 2050, then the datastore will have a group named '2010' and a group named '2050'. If the value for 'GROUP' is 'Year', then the dataset will exist in each model run year group. If the value for 'GROUP' is 'BaseYear' then the dataset will only exist in the base year group (e.g. '2010'). If the value for 'GROUP' is 'Global' then the dataset will only exist in the 'Global' group. + +TYPE - The data type. The framework uses the type to check units and inputs. Refer to the model system design and users guide for information on allowed types. + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values in the datastore do not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Values in the datastore are one or more of the listed values. + +|NAME |TABLE |GROUP |TYPE |UNITS |PROHIBIT |ISELEMENTOF | +|:---------------|:---------|:-----|:---------|:----------|:--------------|:-----------| +|Azone |Azone |Year |character |ID | | | +|LtTrkProp |Azone |Year |double |proportion |NA, <= 0, >= 1 | | +|D1B |Bzone |Year |compound |PRSN/SQMI |NA, < 0 | | +|Bzone |Bzone |Year |character |ID | | | +|Azone |Bzone |Year |character |ID | | | +|HhId |Household |Year |character |ID | | | +|Bzone |Household |Year |character |ID | | | +|Azone |Household |Year |character |ID | | | +|HhSize |Household |Year |people |PRSN |NA, <= 0 | | +|Age0to14 |Household |Year |people |PRSN |NA, < 0 | | +|Age15to19 |Household |Year |people |PRSN |NA, < 0 | | +|Income |Household |Year |currency |USD.2001 |NA, < 0 | | +|HouseType |Household |Year |character |category | |SF, MF, GQ | +|IsUrbanMixNbrhd |Household |Year |integer |binary |NA |0, 1 | +|Vehicles |Household |Year |vehicles |VEH |NA, < 0 | | +|Drivers |Household |Year |people |PRSN |NA, < 0 | | + +## Datasets Produced by the Module +The following table documents each dataset that is retrieved from the datastore and used by the module. Each row in the table describes a dataset. All the datasets must be present in the datastore. One or more of these datasets may be entered into the datastore from the user input files. The table names and their meanings are as follows: + +NAME - The dataset name. + +TABLE - The table in the datastore that the data is retrieved from. + +GROUP - The group in the datastore where the table is located. Note that the datastore has a group named 'Global' and groups for every model run year. For example, if the model run years are 2010 and 2050, then the datastore will have a group named '2010' and a group named '2050'. If the value for 'GROUP' is 'Year', then the dataset will exist in each model run year. If the value for 'GROUP' is 'BaseYear' then the dataset will only exist in the base year group (e.g. '2010'). If the value for 'GROUP' is 'Global' then the dataset will only exist in the 'Global' group. + +TYPE - The data type. The framework uses the type to check units and inputs. Refer to the model system design and users guide for information on allowed types. + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values in the datastore do not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Values in the datastore are one or more of the listed values. + +DESCRIPTION - A description of the data. + +|NAME |TABLE |GROUP |TYPE |UNITS |PROHIBIT |ISELEMENTOF |DESCRIPTION | +|:--------|:---------|:-----|:--------|:-----|:--------|:-----------|:-------------------------------------------------------------------------------------------------------------| +|NumLtTrk |Household |Year |vehicles |VEH |NA, < 0 | |Number of light trucks (pickup, sport-utility vehicle, and van) owned or leased by household | +|NumAuto |Household |Year |vehicles |VEH |NA, < 0 | |Number of automobiles (i.e. 4-tire passenger vehicles that are not light trucks) owned or leased by household | diff --git a/sources/modules/VEHouseholdVehicles-old/inst/module_docs/CalculateVehicleOwnCost.md b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/CalculateVehicleOwnCost.md new file mode 100644 index 000000000..e6f00cb58 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/CalculateVehicleOwnCost.md @@ -0,0 +1,187 @@ + +# CalculateVehicleOwnCost Module +### November 23, 2018 + +This module calculates average vehicle ownership cost for each vehicle based on the vehicle type and age using data from the American Automobile Association (AAA). To this are added the cost of parking at the vehicle residence if free parking is not available for all household vehicles. The ownership cost is converted into an average ownership cost per mile by predicting the household DVMT given the number of owned vehicles and splitting the miles equally among the vehicles. Vehicle ownership costs are used by the AdjustVehicleOwnership module to determine whether it would be more cost-effective for a household to substitute the use of car services for one or more of vehicles that they otherwise would own. + +The module also assigns pay-as-you-drive (PAYD) insurance to households based on household characteristics and input assumption about the proportion of households who have PAYD insurance. PAYD insurance does not affect the cost of vehicle ownership when determining whether a household will substitute car services for one or more of their vehicles. It does affect the operating cost of the vehicle and determination of whether the amount of vehicle travel fits within the household's vehicle operations budget. + +## Model Parameter Estimation + +Vehicle ownership cost data from the American Automobile Association (AAA) are used along with information on vehicle depreciation rates to develop a model of vehicle ownership cost as a function of vehicle type, vehicle age, and miles driven. + +The AAA cost data is described in the *aaa_vehicle_ownership_costs.txt* file in the *inst/extdata* directory of this package. Data are included on insurance, license/registration/taxes, finance, and depreciation (at 3 annual mileage rates) for 7 light duty body types (small sedan, medium sedan, large sedan, small SUV, medium SUV, minivan, and pickup). Data are also included for hybrids and electric vehicles but these are not used in the model because these vehicle types are relatively new (especially electric vehicles) and are not split out by body type. The following table show these data which are for the year [2017](http://exchange.aaa.com/wp-content/uploads/2017/08/17-0013_Your-Driving-Costs-Brochure-2017-FNL-CX-1.pdf). + + +| | SmallSedan| MediumSedan| LargeSedan| SmallSUV| MediumSUV| Minivan| Pickup| +|:--------------------------|----------:|-----------:|----------:|--------:|---------:|-------:|------:| +|Insurance | 1288| 1202| 1200| 1076| 1089| 1075| 1229| +|License/Registration/Taxes | 454| 639| 757| 607| 831| 726| 984| +|Finance | 396| 597| 706| 567| 806| 692| 922| +|Depreciation10KPerYear | 1969| 3028| 3601| 2646| 3479| 3654| 3308| +|Depreciation15KPerYear | 2114| 3187| 3799| 2840| 3720| 3839| 3587| +|Depreciation20KPerYear | 2489| 3592| 4300| 3319| 4309| 4298| 4258| + +The AAA data body type values are aggregated into vehicle type (auto, light truck) values by taking the midpoint of the range of values for the body types corresponding to each vehicle type. The values for the 3 sedan body types are aggregated to calculate the auto type value. Likewise, the values for the 4 other body types are aggregated to calculate the light truck type value. + +Building an ownership cost model requires additional information because the AAA data only address cost during the first 5 years of a vehicle's life and only 3 levels for annual miles driven whereas the cost model needs to address vehicles up to 30 years old and a continuous range of annual vehicle miles driven. The model is created by combining the AAA data with average vehicle depreciation rate data from the [National Automobile Dealers Association *Used Vehicle Price Report: Age-level Analysis and Forecast, Q3 2013*](https://www.nada.com/b2b/Portals/0/assets/pdf/Q3%20Whitepaper%20Age-level%20Analysis%20and%20Forecast.pdf). This report estimates that light-duty vehicles depreciate at an average rate of 15% per year. + +The first step in building a model is to calculate the average vehicle value by year and body type for vehicles having a midrange value for annual mileage (15,000). This starts with calculating the new car value for each of the body types. To do this, the total depreciation for the first five years is calculated by multiplying the reported annual depreciation values by 5 since the AAA data represent annual costs over the first 5 years of the vehicle life. From that, the corresponding new vehicle value is calculated using the assumed annual depreciation rate of 15%. The new vehicle values by vehicle type (auto, light truck) are computed by taking the midpoint of the ranges of the the corresponding body types. The following table shows the estimated 2017 new car prices by body type and vehicle type. + + +|Body |Price | +|:-----------|:-------| +|SmallSedan |$19,001 | +|MediumSedan |$28,645 | +|LargeSedan |$34,146 | +|SmallSUV |$25,526 | +|MediumSUV |$33,436 | +|Minivan |$34,505 | +|Pickup |$32,240 | +|Auto |$26,573 | +|LtTrk |$30,016 | + +Once the new car value by vehicle type has been calculated, the values by vehicle age are computed by applying the annual depreciation rate. Then the annual depreciation values are computed as the differences in annual vehicle values. The following figure illustrates the annual depreciation for auto and light truck that are driven 15,000 miles per year. + +![depreciation_expense.png](depreciation_expense.png) + +The depreciation models adjusts depreciation to account for the effect of miles driven. As can be seen from the examination of the AAA data, depreciation increases at an increasing rate as annual mileage increases. To account for the effect of miles driven on depreciation, a linear model is estimated to predict the ratio of depreciation at the annual mileage driven to depreciation at 15,000 miles driven. This model is used to adjust the depreciation schedule shown in the figure above. The steps in creating this depreciation adjustment model are as follows: + +* The AAA data on depreciation by body type and mileage is aggregated to the vehicle types (auto, light truck) by taking the midpoint of the range of values for the corresponding body types. + +* The ratios of annual depreciation to depreciation at 15,000 miles are calculated. + +* The relationship between mileage and depreciation ratio is linearized by power-transforming the mileage. Mileage is divided by 1000 to reduce the size of the power-transformed result. The linearizing power transform is estimated using binary search to find the value at which the slopes are equal. + +* A linear regression model is estimated to find the slope and intercept of the line describing the relationship between mileage and relative depreciation. + +The following figure illustrates the resulting estimated relationship between depreciation and miles driven for 5-year old autos and light trucks. + +![depreciation_by_annual_miles.png](depreciation_by_annual_miles.png) + +A finance cost model calculates finance cost as a function of the vehicle age. To estimate this model, first the AAA values for finance cost by body type are aggregated to vehicle types. This is done by taking the midpoint values of the body types that correspond to each vehicle type. Since the AAA data represent the first 5 years of a vehicle's life and since auto loans typically have a duration of 5 years, it is assumed that the AAA data represent the average finance cost for a new vehicle. Therefore the annual finance cost for different vehicle can be calculated by multiplying the new car finance cost by the estimated proportion of new car value for the vehicle age. It is important to note that finance cost is the cost of financing the vehicle loan, not the cost of purchasing the car. Depreciation accounts for purchase cost and residual value. + +To calculate the cost of insurance, the AAA values for insurance cost by body type are aggregated to vehicle types in the manner described above. Since insurance cost is largely a function of driver characteristics (e.g. age) and weakly related to vehicle value, no adjustments are made to the AAA values as a function of vehicle value. + +The module also identifies which households are assigned to pay-as-you-drive (PAYD) insurance to satisfy user input on the proportion of households having that type of insurance. PAYD insurance is limited to 1996 or later model years because it requires OBD-II ports that were made mandatory on all vehicles in that year. This model has no estimated parameters, rather it weights various household characteristics based on judgements regarding the relative value of PAYD insurance to different users based on reviewing the literature. Undoubtedly there are correlations between the factors and therefore potential for double-counting, but substantially more data and study is required to sort out the effects. The characteristics and relative weights are as follows: + +* Teen Drivers (2 points) - households with one or more teenage drivers are benefitted by the monitoring and feedback provided by the technology; + +* Lower Mileage (3 points) - PAYD insurance is relatively more economical for households that have relatively low annual mileage (less than 15,000 miles per vehicle); + +* Older Adult Drivers (2 points) - Households with older adult drivers (30 or older) are more likely to use than households with younger adult drivers; + +* Lower Income (2 points) - Lower income households are more likely to use because of the lower costs and ability to moderate behavior to save additional money. Low income threshold is an annual household income of $45,000 in 2005 dollars. + +* Auto Proportion (2 points) - Households owning automobiles are more likely to use than households owning light trucks; and, + +* In Metropolitan Area (3 points) - Households in metropolitan areas are more likely to use. + +## How the Module Works + +The module loads data on the type and age of each vehicle. It calls the CalculateHouseholdVmt module to calculate average daily vehicle miles traveled for each household. This is converted to annual miles and split equally among household vehicles. The depreciation model is applied to calculate vehicle depreciation cost as a function of the vehicle type, the vehicle age, and annual miles driven. The finance cost model is applied to calculate the finance cost as a function of the vehicle type and age. The insurance cost is calculated as a function of the vehicle type. Vehicle licensing/registration/tax costs are not calculated from the AAA values because these values can vary substantially by state and because they may changed to implement policy objectives. The user provides inputs for flat fees/taxes (i.e. annual cost per vehicle) and ad valorem taxes (i.e. percentage of vehicle value paid in taxes). The flat fees/taxes are applied to each vehicle. The ad valorem taxes are calculated by multiplying the vehicle value, which varies by type and age, by the tax rate. The module also loads household residential parking cost data calculated by the AssignParkingRestrictions module. The household parking costs are split equally among vehicles. Total ownership cost for each vehicle is then calculated by summing the depreciation, finance, insurance, fees/taxes, and parking costs. Total ownership cost is divided by vehicle miles to calculate the cost of ownership per mile of travel. + +The module also identifies which households will be assigned PAYD insurance given user inputs on the proportion of households having PAYD insurance. The module identifies which households qualify for PAYD insurance based on whether any of their vehicles are 1996 model year vehicles or later. The vehicle and household characteristics (identified above) are evaluated and points assigned. The total points are calculated for each households. Random sampling is used to choose a number of households to equal the input proportion where the probability that each household is chosen is a function of the ratio of the household weight to the maximum household weight. + + +## User Inputs +The following table(s) document each input file that must be provided in order for the module to run correctly. User input files are comma-separated valued (csv) formatted text files. Each row in the table(s) describes a field (column) in the input file. The table names and their meanings are as follows: + +NAME - The field (column) name in the input file. Note that if the 'TYPE' is 'currency' the field name must be followed by a period and the year that the currency is denominated in. For example if the NAME is 'HHIncomePC' (household per capita income) and the input values are in 2010 dollars, the field name in the file must be 'HHIncomePC.2010'. The framework uses the embedded date information to convert the currency into base year currency amounts. The user may also embed a magnitude indicator if inputs are in thousand, millions, etc. The VisionEval model system design and users guide should be consulted on how to do that. + +TYPE - The data type. The framework uses the type to check units and inputs. The user can generally ignore this, but it is important to know whether the 'TYPE' is 'currency' + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values may not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Value must be one of the listed values. + +UNLIKELY - Values that are unlikely. Values that meet any of the listed conditions are permitted but a warning message will be given when the input data are processed. + +DESCRIPTION - A description of the data. + +### azone_hh_veh_own_taxes.csv +|NAME |TYPE |UNITS |PROHIBIT |ISELEMENTOF |UNLIKELY |DESCRIPTION | +|:------------------|:--------|:----------|:------------|:-----------|:--------|:--------------------------------------------------------| +|Geo | | | |Azones | |Must contain a record for each Azone and model run year. | +|Year | | | | | |Must contain a record for each Azone and model run year. | +|VehOwnFlatRateFee |currency |USD |NA, < 0 | | |Annual flat rate tax per vehicle in dollars | +|VehOwnAdValoremTax |double |proportion |NA, < 0, > 1 | | |Annual proportion of vehicle value paid in taxes | +### azone_payd_insurance_prop.csv +| |NAME |TYPE |UNITS |PROHIBIT |ISELEMENTOF |UNLIKELY |DESCRIPTION | +|:--|:----------|:------|:----------|:------------|:-----------|:--------|:--------------------------------------------------------------------------------------------| +|1 |Geo | | | |Azones | |Must contain a record for each Azone and model run year. | +|11 |Year | | | | | |Must contain a record for each Azone and model run year. | +|3 |PaydHhProp |double |proportion |NA, < 0, > 1 | | |Proportion of households in the Azone who have pay-as-you-drive insurance for their vehicles | + +## Datasets Used by the Module +The following table documents each dataset that is retrieved from the datastore and used by the module. Each row in the table describes a dataset. All the datasets must be present in the datastore. One or more of these datasets may be entered into the datastore from the user input files. The table names and their meanings are as follows: + +NAME - The dataset name. + +TABLE - The table in the datastore that the data is retrieved from. + +GROUP - The group in the datastore where the table is located. Note that the datastore has a group named 'Global' and groups for every model run year. For example, if the model run years are 2010 and 2050, then the datastore will have a group named '2010' and a group named '2050'. If the value for 'GROUP' is 'Year', then the dataset will exist in each model run year group. If the value for 'GROUP' is 'BaseYear' then the dataset will only exist in the base year group (e.g. '2010'). If the value for 'GROUP' is 'Global' then the dataset will only exist in the 'Global' group. + +TYPE - The data type. The framework uses the type to check units and inputs. Refer to the model system design and users guide for information on allowed types. + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values in the datastore do not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Values in the datastore are one or more of the listed values. + +|NAME |TABLE |GROUP |TYPE |UNITS |PROHIBIT |ISELEMENTOF | +|:------------------|:---------|:-----|:---------|:--------------|:------------|:--------------------------| +|Azone |Azone |Year |character |ID | | | +|VehOwnFlatRateFee |Azone |Year |currency |USD.2017 |NA, < 0 | | +|VehOwnAdValoremTax |Azone |Year |double |proportion |NA, < 0, > 1 | | +|PaydHhProp |Azone |Year |double |proportion |NA, < 0, > 1 | | +|Azone |Household |Year |character |ID | | | +|HhId |Household |Year |character |ID | | | +|Vehicles |Household |Year |vehicles |VEH |NA, < 0 | | +|HhId |Vehicle |Year |character |ID |NA | | +|Azone |Vehicle |Year |character |ID | | | +|VehId |Vehicle |Year |character |ID |NA | | +|VehicleAccess |Vehicle |Year |character |category | |Own, LowCarSvc, HighCarSvc | +|Type |Vehicle |Year |character |category |NA |Auto, LtTrk | +|Age |Vehicle |Year |time |YR |NA, < 0 | | +|FreeParkingSpaces |Household |Year |integer |parking spaces |NA, < 0 | | +|ParkingUnitCost |Household |Year |currency |USD.2017 |NA, < 0 | | +|Drivers |Household |Year |people |PRSN |NA, < 0 | | +|Drv15to19 |Household |Year |people |PRSN |NA, < 0 | | +|Drv20to29 |Household |Year |people |PRSN |NA, < 0 | | +|Drv30to54 |Household |Year |people |PRSN |NA, < 0 | | +|Drv55to64 |Household |Year |people |PRSN |NA, < 0 | | +|Drv65Plus |Household |Year |people |PRSN |NA, < 0 | | +|Income |Household |Year |currency |USD.2005 |NA, < 0 | | +|LocType |Household |Year |character |category |NA |Urban, Town, Rural | +|NumLtTrk |Household |Year |vehicles |VEH |NA, < 0 | | +|NumAuto |Household |Year |vehicles |VEH |NA, < 0 | | + +## Datasets Produced by the Module +The following table documents each dataset that is retrieved from the datastore and used by the module. Each row in the table describes a dataset. All the datasets must be present in the datastore. One or more of these datasets may be entered into the datastore from the user input files. The table names and their meanings are as follows: + +NAME - The dataset name. + +TABLE - The table in the datastore that the data is retrieved from. + +GROUP - The group in the datastore where the table is located. Note that the datastore has a group named 'Global' and groups for every model run year. For example, if the model run years are 2010 and 2050, then the datastore will have a group named '2010' and a group named '2050'. If the value for 'GROUP' is 'Year', then the dataset will exist in each model run year. If the value for 'GROUP' is 'BaseYear' then the dataset will only exist in the base year group (e.g. '2010'). If the value for 'GROUP' is 'Global' then the dataset will only exist in the 'Global' group. + +TYPE - The data type. The framework uses the type to check units and inputs. Refer to the model system design and users guide for information on allowed types. + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values in the datastore do not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Values in the datastore are one or more of the listed values. + +DESCRIPTION - A description of the data. + +|NAME |TABLE |GROUP |TYPE |UNITS |PROHIBIT |ISELEMENTOF |DESCRIPTION | +|:--------------|:---------|:-----|:--------|:--------|:--------|:-----------|:------------------------------------------------------------------------------------------------------------------------| +|OwnCost |Vehicle |Year |currency |USD.2017 |NA, < 0 | |Annual cost of vehicle ownership including depreciation, financing, insurance, taxes, and residential parking in dollars | +|OwnCostPerMile |Vehicle |Year |currency |USD.2017 |NA, < 0 | |Annual cost of vehicle ownership per mile of vehicle travel (dollars per mile) | +|InsCost |Vehicle |Year |currency |USD.2017 |NA, < 0 | |Annual vehicle insurance cost in dollars | +|HasPaydIns |Household |Year |integer |binary | |0, 1 |Identifies whether household has pay-as-you-drive insurance for vehicles: 1 = Yes, 0 = no | diff --git a/sources/modules/VEHouseholdVehicles-old/inst/module_docs/CreateVehicleTable.md b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/CreateVehicleTable.md new file mode 100644 index 000000000..7e0619a2e --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/CreateVehicleTable.md @@ -0,0 +1,100 @@ + +# CreateVehicleTable Module +### January 7, 2020 + +This module creates a vehicle table and populates it with household ID and geography fields. + +## Model Parameter Estimation + +This module has no estimated parameters. + +## How the Module Works + +This module initializes the 'Vehicle' table and populates it with the household ID (HhId), vehicle ID (VehID), Azone ID (Azone), Marea ID (Marea), and vehicle access type (VehicleAccess) datasets. The Vehicle table has a record for every vehicle owned by the household. If there are more driving age persons than vehicles in the household, there is also a record for each driving age person for which there is no vehicle. The VehicleAccess designation is Own for each vehicle owned by a household. The designation is either LowCarSvc or HighCarSvc for each record corresponding to difference between driving age persons and owned vehicles. It is LowCarSvc if the household is in a Bzone having a low level of car service and HighCarSvc if the Bzone car service level is high. + + +## User Inputs +The following table(s) document each input file that must be provided in order for the module to run correctly. User input files are comma-separated valued (csv) formatted text files. Each row in the table(s) describes a field (column) in the input file. The table names and their meanings are as follows: + +NAME - The field (column) name in the input file. Note that if the 'TYPE' is 'currency' the field name must be followed by a period and the year that the currency is denominated in. For example if the NAME is 'HHIncomePC' (household per capita income) and the input values are in 2010 dollars, the field name in the file must be 'HHIncomePC.2010'. The framework uses the embedded date information to convert the currency into base year currency amounts. The user may also embed a magnitude indicator if inputs are in thousand, millions, etc. The VisionEval model system design and users guide should be consulted on how to do that. + +TYPE - The data type. The framework uses the type to check units and inputs. The user can generally ignore this, but it is important to know whether the 'TYPE' is 'currency' + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values may not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Value must be one of the listed values. + +UNLIKELY - Values that are unlikely. Values that meet any of the listed conditions are permitted but a warning message will be given when the input data are processed. + +DESCRIPTION - A description of the data. + +### azone_carsvc_characteristics.csv +|NAME |TYPE |UNITS |PROHIBIT |ISELEMENTOF |UNLIKELY |DESCRIPTION | +|:-------------------|:--------|:----------|:------------|:-----------|:--------|:--------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------| +|Geo | | | |Azones | |Must contain a record for each Azone and model run year. | +|Year | | | | | |Must contain a record for each Azone and model run year. | +|HighCarSvcCost |currency |USD |NA, < 0 | | |Average cost in dollars per mile for travel by high service level car service exclusive of the cost of fuel, road use taxes, and carbon taxes (and any other social costs charged to vehicle use). | +|LowCarSvcCost |currency |USD |NA, < 0 | | |Average cost in dollars per mile for travel by low service level car service exclusive of the cost of fuel, road use taxes, and carbon taxes (and any other social costs charged to vehicle use). | +|AveCarSvcVehicleAge |time |YR |NA, < 0 | | |Average age of car service vehicles in years | +|LtTrkCarSvcSubProp |double |proportion |NA, < 0, > 1 | | |The proportion of light-truck owners who would substitute a less-costly car service option for owning their light truck | +|AutoCarSvcSubProp |double |proportion |NA, < 0, > 1 | | |Th proportion of automobile owners who would substitute a less-costly car service option for owning their automobile | + +## Datasets Used by the Module +The following table documents each dataset that is retrieved from the datastore and used by the module. Each row in the table describes a dataset. All the datasets must be present in the datastore. One or more of these datasets may be entered into the datastore from the user input files. The table names and their meanings are as follows: + +NAME - The dataset name. + +TABLE - The table in the datastore that the data is retrieved from. + +GROUP - The group in the datastore where the table is located. Note that the datastore has a group named 'Global' and groups for every model run year. For example, if the model run years are 2010 and 2050, then the datastore will have a group named '2010' and a group named '2050'. If the value for 'GROUP' is 'Year', then the dataset will exist in each model run year group. If the value for 'GROUP' is 'BaseYear' then the dataset will only exist in the base year group (e.g. '2010'). If the value for 'GROUP' is 'Global' then the dataset will only exist in the 'Global' group. + +TYPE - The data type. The framework uses the type to check units and inputs. Refer to the model system design and users guide for information on allowed types. + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values in the datastore do not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Values in the datastore are one or more of the listed values. + +|NAME |TABLE |GROUP |TYPE |UNITS |PROHIBIT |ISELEMENTOF | +|:-------------|:---------|:-----|:---------|:--------|:--------|:-----------| +|HhId |Household |Year |character |ID | | | +|Azone |Household |Year |character |ID | | | +|Bzone |Household |Year |character |ID | | | +|Marea |Household |Year |character |ID | | | +|NumLtTrk |Household |Year |vehicles |VEH |NA, < 0 | | +|NumAuto |Household |Year |vehicles |VEH |NA, < 0 | | +|Vehicles |Household |Year |vehicles |VEH |NA, < 0 | | +|DrvAgePersons |Household |Year |people |PRSN |NA, < 0 | | +|CarSvcLevel |Household |Year |character |category | |Low, High | + +## Datasets Produced by the Module +The following table documents each dataset that is retrieved from the datastore and used by the module. Each row in the table describes a dataset. All the datasets must be present in the datastore. One or more of these datasets may be entered into the datastore from the user input files. The table names and their meanings are as follows: + +NAME - The dataset name. + +TABLE - The table in the datastore that the data is retrieved from. + +GROUP - The group in the datastore where the table is located. Note that the datastore has a group named 'Global' and groups for every model run year. For example, if the model run years are 2010 and 2050, then the datastore will have a group named '2010' and a group named '2050'. If the value for 'GROUP' is 'Year', then the dataset will exist in each model run year. If the value for 'GROUP' is 'BaseYear' then the dataset will only exist in the base year group (e.g. '2010'). If the value for 'GROUP' is 'Global' then the dataset will only exist in the 'Global' group. + +TYPE - The data type. The framework uses the type to check units and inputs. Refer to the model system design and users guide for information on allowed types. + +UNITS - The units that input values need to represent. Some data types have defined units that are represented as abbreviations or combinations of abbreviations. For example 'MI/HR' means miles per hour. Many of these abbreviations are self evident, but the VisionEval model system design and users guide should be consulted. + +PROHIBIT - Values that are prohibited. Values in the datastore do not meet any of the listed conditions. + +ISELEMENTOF - Categorical values that are permitted. Values in the datastore are one or more of the listed values. + +DESCRIPTION - A description of the data. + +|NAME |TABLE |GROUP |TYPE |UNITS |PROHIBIT |ISELEMENTOF |DESCRIPTION | +|:-------------|:-------|:-----|:---------|:--------|:--------|:--------------------------|:-------------------------------------------------------------------------------------------------------------------------------------------------------------| +|HhId |Vehicle |Year |character |ID | | |Unique household ID | +|VehId |Vehicle |Year |character |ID | | |Unique vehicle ID | +|Azone |Vehicle |Year |character |ID | | |Azone ID | +|Bzone |Vehicle |Year |character |ID | | |Bzone ID | +|Marea |Vehicle |Year |character |ID | | |Marea ID | +|VehicleAccess |Vehicle |Year |character |category | |Own, LowCarSvc, HighCarSvc |Identifier whether vehicle is owned by household (Own), if vehicle is low level car service (LowCarSvc), or if vehicle is high level car service (HighCarSvc) | +|Type |Vehicle |Year |character |category |NA |Auto, LtTrk |Vehicle body type: Auto = automobile, LtTrk = light trucks (i.e. pickup, SUV, Van) | diff --git a/sources/modules/VEHouseholdVehicles-old/inst/module_docs/auto_age_props_by_inc.png b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/auto_age_props_by_inc.png new file mode 100644 index 000000000..0668774ee Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/auto_age_props_by_inc.png differ diff --git a/sources/modules/VEHouseholdVehicles-old/inst/module_docs/cum_age_props_by_veh-type.png b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/cum_age_props_by_veh-type.png new file mode 100644 index 000000000..b5c6ca808 Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/cum_age_props_by_veh-type.png differ diff --git a/sources/modules/VEHouseholdVehicles-old/inst/module_docs/depreciation_by_annual_miles.png b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/depreciation_by_annual_miles.png new file mode 100644 index 000000000..3baabcad5 Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/depreciation_by_annual_miles.png differ diff --git a/sources/modules/VEHouseholdVehicles-old/inst/module_docs/depreciation_expense.png b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/depreciation_expense.png new file mode 100644 index 000000000..43bf8a601 Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/depreciation_expense.png differ diff --git a/sources/modules/VEHouseholdVehicles-old/inst/module_docs/lttrk_age_props_by_inc.png b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/lttrk_age_props_by_inc.png new file mode 100644 index 000000000..dc1edf886 Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/inst/module_docs/lttrk_age_props_by_inc.png differ diff --git a/sources/modules/VEHouseholdVehicles-old/man/AdjustVehicleOwnership.Rd b/sources/modules/VEHouseholdVehicles-old/man/AdjustVehicleOwnership.Rd new file mode 100644 index 000000000..0cb09c69a --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/AdjustVehicleOwnership.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AdjustVehicleOwnership.R +\name{AdjustVehicleOwnership} +\alias{AdjustVehicleOwnership} +\title{Adjust household vehicle ownership when car service cost is less.} +\usage{ +AdjustVehicleOwnership(L) +} +\arguments{ +\item{L}{A list containing the components listed in the Get specifications +for the module.} +} +\value{ +A list containing the components specified in the Set +specifications for the module. +} +\description{ +\code{AdjustVehicleOwnership} adjusts household vehicle ownership by +substituting use of car service when the level of car service is high and +when cost per mile to use car service is less than the cost per mile to +own vehicle +} +\details{ +This function calculates the ownership cost per mile for household vehicles +and compares with the cost per mile to use car service vehicles if the level +of car service is high. If ownership is more costly for a vehicle, +substitution is determined by random draw using the car service substitution +probability for the vehicle type. If a substitution is made, the vehicle +access status is changed from 'Own' to 'HighCarSvc'. The ownership cost is +changed to 0 as is the insurance cost. The household vehicle inventory is +also updated. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/AdjustVehicleOwnershipSpecifications.Rd b/sources/modules/VEHouseholdVehicles-old/man/AdjustVehicleOwnershipSpecifications.Rd new file mode 100644 index 000000000..5ab09352b --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/AdjustVehicleOwnershipSpecifications.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AdjustVehicleOwnership.R +\docType{data} +\name{AdjustVehicleOwnershipSpecifications} +\alias{AdjustVehicleOwnershipSpecifications} +\title{Specifications list for AdjustVehicleOwnership module} +\format{A list containing 4 components: +\describe{ + \item{RunBy}{the level of geography that the module is run at} + \item{Inp}{model inputs to be saved to the datastore} + \item{Get}{module inputs to be read from the datastore} + \item{Set}{module outputs to be written to the datastore} +}} +\source{ +AdjustVehicleOwnership.R script. +} +\usage{ +AdjustVehicleOwnershipSpecifications +} +\description{ +A list containing specifications for the AdjustVehicleOwnership module. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/AssignDrivers.Rd b/sources/modules/VEHouseholdVehicles-old/man/AssignDrivers.Rd new file mode 100644 index 000000000..351ccb463 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/AssignDrivers.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignDrivers.R +\name{AssignDrivers} +\alias{AssignDrivers} +\title{Main module function to assign drivers by age group to each household.} +\usage{ +AssignDrivers(L) +} +\arguments{ +\item{L}{A list containing the components listed in the Get specifications +for the module.} +} +\value{ +A list containing the components specified in the Set +specifications for the module. +} +\description{ +\code{AssignDrivers} assigns number of drivers by age group to each household. +} +\details{ +This function assigns the number of drivers in each age group to each +household. It also computes the total number of drivers in the household. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/AssignDriversSpecifications.Rd b/sources/modules/VEHouseholdVehicles-old/man/AssignDriversSpecifications.Rd new file mode 100644 index 000000000..5a3f2e478 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/AssignDriversSpecifications.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignDrivers.R +\docType{data} +\name{AssignDriversSpecifications} +\alias{AssignDriversSpecifications} +\title{Specifications list for PredictHousing module} +\format{A list containing 4 components: +\describe{ + \item{RunBy}{the level of geography that the module is run at} + \item{Inp}{scenario input data to be loaded into the datastore for this + module} + \item{Get}{module inputs to be read from the datastore} + \item{Set}{module outputs to be written to the datastore} +}} +\source{ +AssignDrivers.R script. +} +\usage{ +AssignDriversSpecifications +} +\description{ +A list containing specifications for the PredictHousing module. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleAge.Rd b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleAge.Rd new file mode 100644 index 000000000..09aa92527 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleAge.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleAge.R +\name{AssignVehicleAge} +\alias{AssignVehicleAge} +\title{Create vehicle table and populate with vehicle type and age records.} +\usage{ +AssignVehicleAge(L) +} +\arguments{ +\item{L}{A list containing the components listed in the Get specifications +for the module.} +} +\value{ +A list containing the components specified in the Set +specifications for the module. +} +\description{ +\code{AssignVehicleAge} create the vehicle table and populate with vehicle +age and type records. +} +\details{ +This function creates the 'Vehicle' table in the datastore and populates it +with records of vehicle types and ages along with household IDs. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleAgeSpecifications.Rd b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleAgeSpecifications.Rd new file mode 100644 index 000000000..edbb3be9f --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleAgeSpecifications.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleAge.R +\docType{data} +\name{AssignVehicleAgeSpecifications} +\alias{AssignVehicleAgeSpecifications} +\title{Specifications list for AssignVehicleAge module} +\format{A list containing 5 components: +\describe{ + \item{NewSetTable}{table to be created} + \item{RunBy}{the level of geography that the module is run at} + \item{Inp}{model inputs to be saved to the datastore} + \item{Get}{module inputs to be read from the datastore} + \item{Set}{module outputs to be written to the datastore} +}} +\source{ +AssignVehicleAge.R script. +} +\usage{ +AssignVehicleAgeSpecifications +} +\description{ +A list containing specifications for the AssignVehicleAge module. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleFeatures.Rd b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleFeatures.Rd new file mode 100644 index 000000000..cf5f540e7 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleFeatures.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleFeatures.R +\name{AssignVehicleFeatures} +\alias{AssignVehicleFeatures} +\title{Create vehicle table and populate with vehicle type, age, and mileage records.} +\usage{ +AssignVehicleFeatures(L) +} +\arguments{ +\item{L}{A list containing the components listed in the Get specifications +for the module.} +} +\value{ +A list containing the components specified in the Set +specifications for the module. +} +\description{ +\code{AssignVehicleFeatures} create vehicle table and populate with +vehicle type, age, and mileage records. +} +\details{ +This function creates the 'Vehicle' table in the datastore and populates it +with records of vehicle types, ages, mileage, and mileage proportions +along with household IDs. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleFeaturesFuture.Rd b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleFeaturesFuture.Rd new file mode 100644 index 000000000..dbf116e86 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleFeaturesFuture.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleFeaturesFuture.R +\name{AssignVehicleFeaturesFuture} +\alias{AssignVehicleFeaturesFuture} +\title{Create vehicle table and populate with vehicle type, age, and mileage records.} +\usage{ +AssignVehicleFeaturesFuture(L) +} +\arguments{ +\item{L}{A list containing the components listed in the Get specifications +for the module.} +} +\value{ +A list containing the components specified in the Set +specifications for the module. +} +\description{ +\code{AssignVehicleFeaturesFuture} populate vehicle table with +vehicle type, age, and mileage records using future data. +} +\details{ +This function populates vehicle table with records of +vehicle types, ages, mileage, and mileage proportions +along with household IDs using future data. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleFeaturesFutureSpecifications.Rd b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleFeaturesFutureSpecifications.Rd new file mode 100644 index 000000000..9b75ab615 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleFeaturesFutureSpecifications.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleFeaturesFuture.R +\docType{data} +\name{AssignVehicleFeaturesFutureSpecifications} +\alias{AssignVehicleFeaturesFutureSpecifications} +\title{Specifications list for AssignVehicleFeaturesFuture module} +\format{A list containing 3 components: +\describe{ + \item{RunBy}{the level of geography that the module is run at} + \item{Get}{module inputs to be read from the datastore} + \item{Set}{module outputs to be written to the datastore} +}} +\source{ +AssignVehicleFeaturesFuture.R script. +} +\usage{ +AssignVehicleFeaturesFutureSpecifications +} +\description{ +A list containing specifications for the AssignVehicleFeaturesFuture module. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleFeaturesSpecifications.Rd b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleFeaturesSpecifications.Rd new file mode 100644 index 000000000..4b9efd49b --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleFeaturesSpecifications.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleFeatures.R +\docType{data} +\name{AssignVehicleFeaturesSpecifications} +\alias{AssignVehicleFeaturesSpecifications} +\title{Specifications list for AssignVehicleFeatures module} +\format{A list containing 3 components: +\describe{ + \item{RunBy}{the level of geography that the module is run at} + \item{Get}{module inputs to be read from the datastore} + \item{Set}{module outputs to be written to the datastore} +}} +\source{ +AssignVehicleFeatures.R script. +} +\usage{ +AssignVehicleFeaturesSpecifications +} +\description{ +A list containing specifications for the AssignVehicleFeatures module. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleOwnership.Rd b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleOwnership.Rd new file mode 100644 index 000000000..82c664da0 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleOwnership.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleOwnership.R +\name{AssignVehicleOwnership} +\alias{AssignVehicleOwnership} +\title{Calculate the number of vehicles owned by the household.} +\usage{ +AssignVehicleOwnership(L) +} +\arguments{ +\item{L}{A list containing the components listed in the Get specifications +for the module.} +} +\value{ +A list containing the components specified in the Set +specifications for the module. +} +\description{ +\code{AssignVehicleOwnership} calculate the number of vehicles owned by each +household. +} +\details{ +This function calculates the number of vehicles owned by each household +given the characteristic of the household and the area where it resides. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleOwnershipSpecifications.Rd b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleOwnershipSpecifications.Rd new file mode 100644 index 000000000..bace8a7df --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleOwnershipSpecifications.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleOwnership.R +\docType{data} +\name{AssignVehicleOwnershipSpecifications} +\alias{AssignVehicleOwnershipSpecifications} +\title{Specifications list for AssignVehicleOwnership module} +\format{A list containing 3 components: +\describe{ + \item{RunBy}{the level of geography that the module is run at} + \item{Get}{module inputs to be read from the datastore} + \item{Set}{module outputs to be written to the datastore} +}} +\source{ +AssignVehicleOwnership.R script. +} +\usage{ +AssignVehicleOwnershipSpecifications +} +\description{ +A list containing specifications for the AssignVehicleOwnership module. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleType.Rd b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleType.Rd new file mode 100644 index 000000000..f26466639 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleType.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleType.R +\name{AssignVehicleType} +\alias{AssignVehicleType} +\title{Assign number of autos and light trucks for each household.} +\usage{ +AssignVehicleType(L) +} +\arguments{ +\item{L}{A list containing the components listed in the Get specifications +for the module.} +} +\value{ +A list containing the components specified in the Set +specifications for the module. +} +\description{ +\code{AssignVehicleType} assigns the numbers of autos and light trucks in +each household. +} +\details{ +This function assigns the numbers of autos and light trucks in each +household. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleTypeSpecifications.Rd b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleTypeSpecifications.Rd new file mode 100644 index 000000000..35c862acd --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/AssignVehicleTypeSpecifications.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleType.R +\docType{data} +\name{AssignVehicleTypeSpecifications} +\alias{AssignVehicleTypeSpecifications} +\title{Specifications list for AssignVehicleType module} +\format{A list containing 5 components: +\describe{ + \item{RunBy}{the level of geography that the module is run at} + \item{Inp}{model inputs to be saved to the datastore} + \item{Get}{module inputs to be read from the datastore} + \item{Set}{module outputs to be written to the datastore} +}} +\source{ +AssignVehicleType.R script. +} +\usage{ +AssignVehicleTypeSpecifications +} +\description{ +A list containing specifications for the AssignVehicleType module. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/AutoOwnModels_ls.Rd b/sources/modules/VEHouseholdVehicles-old/man/AutoOwnModels_ls.Rd new file mode 100644 index 000000000..feeba027b --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/AutoOwnModels_ls.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleOwnership.R +\docType{data} +\name{AutoOwnModels_ls} +\alias{AutoOwnModels_ls} +\title{Auto ownership model} +\format{A list having the following components: +\describe{ + \item{Metro}{a list containing two models for metropolitan areas: a Zero + component that is a binomial logit model for determining which households + own no vehicles and a Count component that is an ordered logit model for + determining how many vehicles a household who has vehicles owns} + \item{NonMetro}{a list containing two models for non-metropolitan areas: a + Zero component that is a binomial logit model for determining which households + own no vehicles and a Count component that is an ordered logit model for + determining how many vehicles a household who has vehicles owns} +}} +\source{ +AssignVehicleOwnership.R script. +} +\usage{ +AutoOwnModels_ls +} +\description{ +A list containing the auto ownership model equation and other information +needed to implement the auto ownership model. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/CalculateVehicleOwnCost.Rd b/sources/modules/VEHouseholdVehicles-old/man/CalculateVehicleOwnCost.Rd new file mode 100644 index 000000000..f2113de2f --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/CalculateVehicleOwnCost.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CalculateVehicleOwnCost.R +\name{CalculateVehicleOwnCost} +\alias{CalculateVehicleOwnCost} +\title{Calculate household vehicle ownership cost} +\usage{ +CalculateVehicleOwnCost(L, M) +} +\arguments{ +\item{L}{A list containing the components listed in the Get specifications +for the module.} + +\item{M}{A list the module functions of modules called by this module.} +} +\value{ +A list containing the components specified in the Set +specifications for the module. +} +\description{ +\code{CalculateVehicleOwnCost} calculates the average annual cost of +ownership and per mile cost of each household vehicle +} +\details{ +This function calculates the average annual ownership cost for each household +vehicle. It also calculates what that cost works out to on a per mile basis +by calculating average daily household DVMT given the number of household +vehicles owned, splitting the DVMT evenly among household vehicles, and +calculating the average per mile cost. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/CalculateVehicleOwnCostSpecifications.Rd b/sources/modules/VEHouseholdVehicles-old/man/CalculateVehicleOwnCostSpecifications.Rd new file mode 100644 index 000000000..a52cc90fa --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/CalculateVehicleOwnCostSpecifications.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CalculateVehicleOwnCost.R +\docType{data} +\name{CalculateVehicleOwnCostSpecifications} +\alias{CalculateVehicleOwnCostSpecifications} +\title{Specifications list for CalculateVehicleOwnCost module} +\format{A list containing 5 components: +\describe{ + \item{RunBy}{the level of geography that the module is run at} + \item{Inp}{model inputs to be saved to the datastore} + \item{Get}{module inputs to be read from the datastore} + \item{Set}{module outputs to be written to the datastore} + \item{Call}{alias and name of module to be called} +}} +\source{ +CalculateVehicleOwnCost.R script. +} +\usage{ +CalculateVehicleOwnCostSpecifications +} +\description{ +A list containing specifications for the CalculateVehicleOwnCost module. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/CreateVehicleTable.Rd b/sources/modules/VEHouseholdVehicles-old/man/CreateVehicleTable.Rd new file mode 100644 index 000000000..ec6ecade0 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/CreateVehicleTable.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CreateVehicleTable.R +\name{CreateVehicleTable} +\alias{CreateVehicleTable} +\title{Create vehicle table and populate with HhId and Azone datasets.} +\usage{ +CreateVehicleTable(L) +} +\arguments{ +\item{L}{A list containing the components listed in the Get specifications +for the module.} +} +\value{ +A list containing the components specified in the Set +specifications for the module. +} +\description{ +\code{CreateVehicleTable} create the vehicle table and populate with HhId +and Azone datasets. +} +\details{ +This function creates the 'Vehicle' table in the datastore and populates it +with HhId and Azone datasets. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/CreateVehicleTableSpecifications.Rd b/sources/modules/VEHouseholdVehicles-old/man/CreateVehicleTableSpecifications.Rd new file mode 100644 index 000000000..427110d83 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/CreateVehicleTableSpecifications.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CreateVehicleTable.R +\docType{data} +\name{CreateVehicleTableSpecifications} +\alias{CreateVehicleTableSpecifications} +\title{Specifications list for CreateVehicleTable module} +\format{A list containing 5 components: +\describe{ + \item{NewSetTable}{table to be created} + \item{RunBy}{the level of geography that the module is run at} + \item{Inp}{model inputs to be saved to the datastore} + \item{Get}{module inputs to be read from the datastore} + \item{Set}{module outputs to be written to the datastore} +}} +\source{ +CreateVehicleTable.R script. +} +\usage{ +CreateVehicleTableSpecifications +} +\description{ +A list containing specifications for the CreateVehicleTable module. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/DriverModel_ls.Rd b/sources/modules/VEHouseholdVehicles-old/man/DriverModel_ls.Rd new file mode 100644 index 000000000..50233f42d --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/DriverModel_ls.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignDrivers.R +\docType{data} +\name{DriverModel_ls} +\alias{DriverModel_ls} +\title{Driver choice model} +\format{A list having having Metro and NonMetro components, with each having the following components: +\describe{ + \item{Type}{a string identifying the type of model} + \item{Formula}{a string representation of the model formula} + \item{PrepFun}{a function that prepares inputs to be applied in the model} + \item{Summary}{the summary of the binomial logit model estimation results} + \item{Anova}{results of analysis of variance of the model} + \item{PropCorrectlyPredicted}{proportion of cases of validation dataset correctly predicted by model} + \item{SearchRange}{a two-element vector specifying the range of search values} +}} +\source{ +AssignDrivers.R script. +} +\usage{ +DriverModel_ls +} +\description{ +A list containing the driver choice models for metropolitan and +non-metropolitan areas. Includes model equations and other information +needed to implement the driver choice model. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/LtTruckModels_ls.Rd b/sources/modules/VEHouseholdVehicles-old/man/LtTruckModels_ls.Rd new file mode 100644 index 000000000..54617d42c --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/LtTruckModels_ls.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleFeatures.R +\docType{data} +\name{LtTruckModels_ls} +\alias{LtTruckModels_ls} +\title{Light truck ownership model} +\format{A list having the following components: +\describe{ + \item{OwnModel}{The light truck ownership model} +}} +\source{ +AssignVehicleFeatures.R script. +} +\usage{ +LtTruckModels_ls +} +\description{ +A list containing the light truck ownership model equation. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/PaydWts_.Rd b/sources/modules/VEHouseholdVehicles-old/man/PaydWts_.Rd new file mode 100644 index 000000000..3a9dbcefb --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/PaydWts_.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CalculateVehicleOwnCost.R +\docType{data} +\name{PaydWts_} +\alias{PaydWts_} +\title{Household attributes weights for PAYD insurance} +\format{A named vector of weights used for determining household weight for selecting PAYD insurance +\describe{ + \item{HasTeenDrv}{weight for households having one or more teenage drivers}, + \item{LowerMileage}{weight for households driving lower mileage (< 15,000 per vehicle)} + \item{OlderDrvProp}{weight for proportion of drivers in the household who are 30 or older} + \item{LowerIncome}{weight for lower income households (< 45,000 year 2005 dollars)} + \item{AutoProp}{weight for automobile proportion of vehicles owned by household} + \item{InMetroArea}{weight for household being located in a metropolitan (urbanized) area} +}} +\source{ +CalculateVehicleOwnCost.R script. +} +\usage{ +PaydWts_ +} +\description{ +Identifies household attributes associated with higher probability of PAYD +insurance and the relative weights of those attributes. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/VehOwnCost_ls.Rd b/sources/modules/VEHouseholdVehicles-old/man/VehOwnCost_ls.Rd new file mode 100644 index 000000000..42ce4f2a7 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/VehOwnCost_ls.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CalculateVehicleOwnCost.R +\docType{data} +\name{VehOwnCost_ls} +\alias{VehOwnCost_ls} +\title{Vehicle ownership cost model} +\format{A list containing the following four components: +\describe{ + \item{Depr_AgVt}{a matrix of annual depreciation cost by vehicle age and type in 2017 dollars} + \item{DeprAdjModel_ls}{a containing model coefficients for calculating adjustments to annual depreciation based on annual miles driven and vehicle type (Auto, LtTrk)} + \item{FinCost_AgVt}{a matrix of annual financing cost by vehicle age and type in 2017 dollars} + \item{InsCost_Vt}{a vector of annual insurance cost by vehicle type in 2017 dollars} +}} +\source{ +AdjustVehicleOwnership.R script. +} +\usage{ +VehOwnCost_ls +} +\description{ +A list containing data and estimated model for calculating vehicle +depreciation and financing cost. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/VehOwnModels_ls.Rd b/sources/modules/VEHouseholdVehicles-old/man/VehOwnModels_ls.Rd new file mode 100644 index 000000000..e3a7a9b6d --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/VehOwnModels_ls.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleFeatures.R +\docType{data} +\name{VehOwnModels_ls} +\alias{VehOwnModels_ls} +\title{Vehicle ownership model} +\format{A list having the following components: +\describe{ + \item{Metro}{a list containing four models for metropolitan areas: a Zero + component model and three separate models for non-zero component} + \item{NonMetro}{a list containing four models for non-metropolitan areas: a + Zero component model and three separate models for non-zero component} +}} +\source{ +AssignVehicleFeatures.R script. +} +\usage{ +VehOwnModels_ls +} +\description{ +A list containing the vehicle ownership model equation and other information +needed to implement the vehicle ownership model. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/VehicleAgeModel_ls.Rd b/sources/modules/VEHouseholdVehicles-old/man/VehicleAgeModel_ls.Rd new file mode 100644 index 000000000..720d0ffed --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/VehicleAgeModel_ls.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleAge.R +\docType{data} +\name{VehicleAgeModel_ls} +\alias{VehicleAgeModel_ls} +\title{Vehicle age model} +\format{A list having the following components: +\describe{ + \item{Auto$AgeCDF_Ag}{a vector of cumulative probability of autos by age} + \item{Auto$AgeIncJointProp_AgIg}{a matrix of the joint probability of autos by age and household income} + \item{LtTrk$AgeCDF_Ag}{a vector of cumulative probability of light trucks by age} + \item{LtTrk$AgeIncJointProp_AgIg}{a matrix of the joint probability of light trucks by age and household income} +}} +\source{ +AssignVehicleAge.R script. +} +\usage{ +VehicleAgeModel_ls +} +\description{ +A list containing the vehicle age model probability tables +needed to implement the vehicle age model. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/VehicleTypeModel_ls.Rd b/sources/modules/VEHouseholdVehicles-old/man/VehicleTypeModel_ls.Rd new file mode 100644 index 000000000..be463595f --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/VehicleTypeModel_ls.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleType.R +\docType{data} +\name{VehicleTypeModel_ls} +\alias{VehicleTypeModel_ls} +\title{Vehicle type choice model} +\format{A list having the following components: +\describe{ + \item{Type}{a string identifying the type of model ("binomial")} + \item{Formula}{makeModelFormulaString(VehicleTypeModel)} + \item{PrepFun}{a function that prepares inputs to be applied in the model} + \item{Summary}{the summary of the binomial logit model estimation results} + \item{SearchRange}{a two-element vector specifying the range of search values} +}} +\source{ +AssignVehicleType.R script. +} +\usage{ +VehicleTypeModel_ls +} +\description{ +A list containing the vehicle type choice model equation and other information +needed to implement the vehicle type choice model. +} +\keyword{datasets} diff --git a/sources/modules/VEHouseholdVehicles-old/man/adjAgeDistribution.Rd b/sources/modules/VEHouseholdVehicles-old/man/adjAgeDistribution.Rd new file mode 100644 index 000000000..fccdf8acb --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/adjAgeDistribution.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleFeatures.R +\name{adjAgeDistribution} +\alias{adjAgeDistribution} +\title{Adjust cumulative age distribution to match target ratio} +\usage{ +adjAgeDistribution(CumDist, AdjRatio) +} +\arguments{ +\item{CumDist}{A named numeric vector where the names are vehicle ages and +the values are the proportion of vehicles that age or younger. The names must +be an ordered sequence from 0 to 32.} + +\item{AdjRatio}{A number that is the target ratio value.} +} +\value{ +A numeric vector of adjusted distribution. +} +\description{ +\code{adjAgeDistribution} Adjusts a cumulative age distribution to match a +target ratio. +} +\details{ +This function adjusts a cumulative age distribution to match a target ratio. +The function returns the adjusted cumulative age distribution and the +corresponding age distribution. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/adjustAgeDistribution.Rd b/sources/modules/VEHouseholdVehicles-old/man/adjustAgeDistribution.Rd new file mode 100644 index 000000000..965633d17 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/adjustAgeDistribution.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleAge.R +\name{adjustAgeDistribution} +\alias{adjustAgeDistribution} +\title{Adjust cumulative age distribution to match target mean.} +\usage{ +adjustAgeDistribution(AgeCDF_Ag, TargetMean = NULL) +} +\arguments{ +\item{AgeCDF_Ag}{A named numeric vector where the names are vehicle ages and +the values are the proportion of vehicles that age or younger. The names must +be an ordered sequence from 0 to 30.} + +\item{TargetMean}{A number that is the target mean value.} +} +\value{ +A numeric value that is the mean vehicle age. +} +\description{ +\code{adjustAgeDistribution} Adjusts a cumulative age distribution to match a +target mean age. +} +\details{ +This function adjusts a cumulative age distribution to match a target mean +age. The function returns the adjusted cumulative age distribution and the +corresponding age distribution. If no target mean value is specified, the +function returns the input cumulative age distribution and the corresponding +age distribution for that input. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/apportionDvmt.Rd b/sources/modules/VEHouseholdVehicles-old/man/apportionDvmt.Rd new file mode 100644 index 000000000..0ba7ec800 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/apportionDvmt.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleFeatures.R +\name{apportionDvmt} +\alias{apportionDvmt} +\title{Assign VMT proportion to household vehicles.} +\usage{ +apportionDvmt(Hh_df, DvmtProp = NULL) +} +\arguments{ +\item{Hh_df}{A household data frame consisting of household characteristics.} + +\item{DvmtProp}{A data frame of distribution of VMT proportion by number of +vehicles in a household.} +} +\value{ +A list containing number of vehicles and ownership ratio for each household +} +\description{ +\code{apportionDvmt} Assign VMT proportion to household vehicles. +} +\details{ +This function assigns VMT proportions to household vehicles based on the +number of vehicles in the household and the probability distribution of proportion of +miles traveled by those vehicles. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/assignFuelEconomy.Rd b/sources/modules/VEHouseholdVehicles-old/man/assignFuelEconomy.Rd new file mode 100644 index 000000000..766c54f87 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/assignFuelEconomy.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleFeatures.R +\name{assignFuelEconomy} +\alias{assignFuelEconomy} +\title{Assignes mileage to vehicles in a household} +\usage{ +assignFuelEconomy(Hh_df, VehMpgYr = NULL, CurrentYear) +} +\arguments{ +\item{Hh_df}{A household data frame consisting of household characteristics.} + +\item{VehMpgYr}{A data frame of mileage of vehicles by type and year.} + +\item{CurrentYear}{A integer indicating the current year.} +} +\value{ +A numeric vector that indicates the mileage of vehicles. +} +\description{ +\code{assignFuelEconomy} Assignes mileage to vehicles in a household. +} +\details{ +This function assigns mileage to vehicles in a household based on type +age of the vehicles. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/calcAdValoremTax.Rd b/sources/modules/VEHouseholdVehicles-old/man/calcAdValoremTax.Rd new file mode 100644 index 000000000..d6053ef14 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/calcAdValoremTax.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CalculateVehicleOwnCost.R +\name{calcAdValoremTax} +\alias{calcAdValoremTax} +\title{Calculate vehicle Ad valorem tax} +\usage{ +calcAdValoremTax(Type_, Age_, TaxRate) +} +\arguments{ +\item{Type_}{A character vector of vehicle types (Auto, LtTrk)} + +\item{Age_}{A numeric vector of vehicle ages +vehicles} + +\item{TaxRate}{A numeric value that is the annual Ad valorem tax rate in +dollars of tax per dollar of vehicle value} +} +\value{ +A numeric vector of annual Ad valorem tax cost in 2017 dollars +} +\description{ +\code{calcAdValoremTax} calculates vehicle Ad valorem tax given vehicle type +and age +} +\details{ +This function calculates the annual Ad valorem tax (in 2017 dollars) of +vehicles as a function of the vehicle type (Auto, LtTrk) and age using the , +and annual vehicle value matrix (VehOwnCost_ls$Value_AgVt) calculated from +AAA data in the module script, and input Ad valorem tax rate. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/calcAgeDistributionByInc.Rd b/sources/modules/VEHouseholdVehicles-old/man/calcAgeDistributionByInc.Rd new file mode 100644 index 000000000..2c1a6de52 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/calcAgeDistributionByInc.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleAge.R +\name{calcAgeDistributionByInc} +\alias{calcAgeDistributionByInc} +\title{Calculate vehicle age distributions by income group.} +\usage{ +calcAgeDistributionByInc(Seed_AgIg, Margin_Ag, Margin_Ig, MaxIter = 100, + Closure = 1e-04) +} +\arguments{ +\item{Seed_AgIg}{A numeric matrix of the joint probabilities of vehicles +by age and income group.} + +\item{Margin_Ag}{A numeric vector of vehicle age probabilities.} + +\item{Margin_Ig}{A numeric vector of vehicle household income probabilities.} + +\item{MaxIter}{A numeric value specifying the maximum number of iterations +the iterative proportional fitting process will undertake.} + +\item{Closure}{A numeric value specifying the maximum allowed difference +between any margin value and corresponding sum of values of the joint +probability matrix.} +} +\value{ +A numeric value that is the mean vehicle age. +} +\description{ +\code{calcAgeDistributionByInc} Calculates vehicle age distributions by +household income group. +} +\details{ +This function calculates vehicle age distributions by household income group. +It takes marginal distributions of vehicles by age and vehicles by household +income group along with a seed matrix of the joint probability distribution +of vehicles by age and income group, and then uses iterative proportional +fitting to adjust the joint probabilities to match the margins. The +probabilities by income group are calculated from the fitted joint +probability matrix. The seed matrix is the joint age and income distribution +for autos or light trucks in the VehicleAgeModel_ls (AgeIncJointProp_AgIg). +The age margin is the proportional distribution of vehicles by age calculated +by adjusting the cumulative age distribution for autos or light trucks in the +VehicleAgeModel_ls (AgeCDF_AgTy) to match a target mean age. The income +margin is the proportional distribution of vehicles by household income group +($0-20K, $20K-40K, $40K-60K, $60K-80K, $80K-100K, $100K or more) calculated +from the modeled household values. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/calcVehAgePropByInc.Rd b/sources/modules/VEHouseholdVehicles-old/man/calcVehAgePropByInc.Rd new file mode 100644 index 000000000..419ce5bed --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/calcVehAgePropByInc.Rd @@ -0,0 +1,48 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleFeatures.R +\name{calcVehAgePropByInc} +\alias{calcVehAgePropByInc} +\title{Calculate vehicle age distributions by income group.} +\usage{ +calcVehAgePropByInc(VehAgIgProp, AgeGrp, AgeMargin, IncGrp, IncMargin, + MaxIter = 100, Closure = 0.001) +} +\arguments{ +\item{VehAgIgProp}{A numeric vector of joint probabilities of vehicle by +age and income group.} + +\item{AgeGrp}{A numeric vector indicating the vehicle ages.} + +\item{AgeMargin}{A named numeric vector indicating the marginal distribution +of vehicle by age.} + +\item{IncGrp}{A character vector indicating the income groups.} + +\item{IncMargin}{A named numeric vecotr indicating the marginal distribution +of vehicle by income groups.} + +\item{MaxIter}{A numeric indicating maximum number of iterations. (Default: 100)} + +\item{Closure}{A numeric indicating the tolerance level for conversion. (Default: 1e-3)} +} +\value{ +A numeric vector of joint probabilities of vehicle by age and income group. +} +\description{ +\code{calcVehAgePropByInc} Calculates vehicle age distributions by +household income group. +} +\details{ +This function calculates vehicle age distributions by household income group. +It takes marginal distributions of vehicles by age and households by income +group along with a data frame of the joint probability distribution of +vehicles by age and income group, and then uses iterative proportional +fitting to adjust the joint probabilities to match the margins. The +probabilities by income group are calculated from the fitted joint +probability matrix. The age margin is the proportional distribution of +vehicles by age calculated by adjusting the cumulative age distribution +for autos or light trucks to match a target mean age. The income +margin is the proportional distribution of vehicles by household income group +($0-20K, $20K-40K, $40K-60K, $60K-80K, $80K-100K, $100K or more) calculated +from the modeled household values. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/calcVehDepr.Rd b/sources/modules/VEHouseholdVehicles-old/man/calcVehDepr.Rd new file mode 100644 index 000000000..d621f14e4 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/calcVehDepr.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CalculateVehicleOwnCost.R +\name{calcVehDepr} +\alias{calcVehDepr} +\title{Calculate vehicle depreciation} +\usage{ +calcVehDepr(Type_, Age_, Vmt_) +} +\arguments{ +\item{Type_}{A character vector of vehicle types (Auto, LtTrk)} + +\item{Age_}{A numeric vector of vehicle ages} + +\item{Vmt_}{A numeric vector of the annual vehicle miles traveled for the +vehicles} +} +\value{ +A numeric vector of annual depreciation cost in 2017 dollars +} +\description{ +\code{calcVehDepr} calculates vehicle depreciation given vehicle type, age, +and annual mileage +} +\details{ +This function calculates the annual depreciation cost (in 2017 dollars) of +vehicles as a function of the vehicle type (Auto, LtTrk), age, and annual +mileage. A base depreciation value is calculated using the depreciation cost +matrix (VehOwnCost_ls$Depr_AgVt) calculated from AAA data in the module +script. The base depreciation is a function of vehicle type and age. The +base depreciation is adjusted based on the vehicle's annual mileage using the +depreciation adjustment models (VehOwnCost_ls$DeprAdjModel_ls). The models, +one for each vehicle type (Auto, LtTrk) are quadratic polynomials with +minimum values at 10,000 miles so the minimum vehicle VMT is constrained to +10,000 miles for use in the model. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/calcVehFin.Rd b/sources/modules/VEHouseholdVehicles-old/man/calcVehFin.Rd new file mode 100644 index 000000000..cfa9c2c06 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/calcVehFin.Rd @@ -0,0 +1,26 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CalculateVehicleOwnCost.R +\name{calcVehFin} +\alias{calcVehFin} +\title{Calculate vehicle finance cost} +\usage{ +calcVehFin(Type_, Age_) +} +\arguments{ +\item{Type_}{A character vector of vehicle types (Auto, LtTrk)} + +\item{Age_}{A numeric vector of vehicle ages +vehicles} +} +\value{ +A numeric vector of annual finance cost in 2017 dollars +} +\description{ +\code{calcVehFin} calculates vehicle finance cost given vehicle type and age +} +\details{ +This function calculates the annual financing cost (in 2017 dollars) of +vehicles as a function of the vehicle type (Auto, LtTrk) and age using the , +and annual finance cost matrix (VehOwnCost_ls$FinCost_AgVt) calculated from +AAA data in the module script. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/calcVehPropByIncome.Rd b/sources/modules/VEHouseholdVehicles-old/man/calcVehPropByIncome.Rd new file mode 100644 index 000000000..3e8fa25fe --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/calcVehPropByIncome.Rd @@ -0,0 +1,25 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleFeatures.R +\name{calcVehPropByIncome} +\alias{calcVehPropByIncome} +\title{Calculate vehicle type distributions by income group.} +\usage{ +calcVehPropByIncome(Hh_df) +} +\arguments{ +\item{Hh_df}{A household data frame consisting of household characteristics.} +} +\value{ +A data frame containing the distribution of vehicle types by income +groups. +} +\description{ +\code{calcVehPropByIncome} Calculates vehicle type distributions by +household income group. +} +\details{ +This function calculates vehicle type distributions by household +income group. It takes the the number of vehicles, vehicle types, and +income groups of each household and calculates the marginal distribution +of the vehicle types. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/calcVehicleAges.Rd b/sources/modules/VEHouseholdVehicles-old/man/calcVehicleAges.Rd new file mode 100644 index 000000000..8e359e6b6 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/calcVehicleAges.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleFeatures.R +\name{calcVehicleAges} +\alias{calcVehicleAges} +\title{Calculate vehicle type and age for each household.} +\usage{ +calcVehicleAges(Hh_df, VProp = NULL, AdjRatio = c(Auto = 1, LtTruck = + 1)) +} +\arguments{ +\item{Hh_df}{A household data frame consisting of household characteristics.} + +\item{VProp}{A list consisting of a cumulative distribution of vehicle age by +vehicle type and a joint distribution of vehicle age, type and income group of +the household.} + +\item{AdjRatio}{A number that is the target ratio value.} +} +\value{ +A list containing the vehicle types and ages for each household. +} +\description{ +\code{calcVehicleAges} Calculates vehicle type and age for each household. +} +\details{ +This function calculates the vehicle type and age for households. The function +uses characteristics of houshold and target marginal proportions to calculate +vehicle type and age. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/estimateVehicleTypeModel.Rd b/sources/modules/VEHouseholdVehicles-old/man/estimateVehicleTypeModel.Rd new file mode 100644 index 000000000..17044fdce --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/estimateVehicleTypeModel.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleType.R +\name{estimateVehicleTypeModel} +\alias{estimateVehicleTypeModel} +\title{Estimate vehicle type choice model} +\usage{ +estimateVehicleTypeModel(EstData_df, Counts_mx, StartTerms_) +} +\arguments{ +\item{EstData_df}{A data frame containing estimation data.} + +\item{Counts_mx}{A numeric matrix of counts of household light trucks and +automobiles for each household.} + +\item{StartTerms_}{A character vector of the terms of the model to be +tested in the model. The function estimates the model using these terms +and then drops all terms whose p value is greater than 0.05.} +} +\value{ +A list which has the following components: +Type: a string identifying the type of model ("binomial"), +Formula: a string representation of the model equation, +PrepFun: a function that prepares inputs to be applied in the binomial model, +OutFun: a function that transforms the result of applying the binomial model. +Summary: the summary of the binomial model estimation results. +} +\description{ +\code{estimateVehicleTypeModel} estimates a binomial logit model for choosing +between light trucks and automobiles. +} +\details{ +This function estimates a binomial logit model for predicting vehicle type +choice (automobile or light truck) as a function of the characteristics of +the household, the number of vehicles it owns, the place where the household +resides, and targets for light-truck ownership. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/findMeanAge.Rd b/sources/modules/VEHouseholdVehicles-old/man/findMeanAge.Rd new file mode 100644 index 000000000..262a288dd --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/findMeanAge.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleAge.R +\name{findMeanAge} +\alias{findMeanAge} +\title{Calculate mean vehicle age from cumulative age distribution.} +\usage{ +findMeanAge(AgeCDF_Ag) +} +\arguments{ +\item{AgeCDF_Ag}{A named numeric vector where the names are vehicle ages and +the values are the proportion of vehicles that age or younger. The names must +be an ordered sequence from 0 to 30.} +} +\value{ +A numeric value that is the mean vehicle age. +} +\description{ +\code{findMeanAge} calculates mean age from a cumulative age distribution. +} +\details{ +This function calculates a mean age from a cumulative age distribution vector +where the values of the vector are the cumulative proportions and the names +of the vector are the vehicle ages from 0 to 30 years. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/idPaydHh.Rd b/sources/modules/VEHouseholdVehicles-old/man/idPaydHh.Rd new file mode 100644 index 000000000..514635df4 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/idPaydHh.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/CalculateVehicleOwnCost.R +\name{idPaydHh} +\alias{idPaydHh} +\title{Assign pay-as-you-drive insurance propensity weights to households} +\usage{ +idPaydHh(Household, PaydHhProp) +} +\arguments{ +\item{Household}{A list containing the Household component of the list (L) +including Household table data listed in the Get specifications limited to +data for households in a specified Azone} + +\item{PaydHhProp}{A number identifying the proportion of households having +pay-as-you-drive insurance +for the module.} +} +\value{ +A numeric vector of weights assigned to each household +} +\description{ +\code{calcPaydWeights} Calculates household weight that reflect the relative +propensity of a household to purchase pay-as-you-drive insurance based on the +household characteristics +} +\details{ +Household PAYD propensity weights are assigned based on the presence of +teenager drivers, whether the average annual vehicle mileage is low, +the proportion of older drivers in the household, whether household income +is relatively low, the proportion of household vehicles that are autos, and +whether the household lives in a metropolitan area. All household vehicles +must be a 1996 or later model year. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/predictLtTruckOwn.Rd b/sources/modules/VEHouseholdVehicles-old/man/predictLtTruckOwn.Rd new file mode 100644 index 000000000..2c719e20b --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/predictLtTruckOwn.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleFeatures.R +\name{predictLtTruckOwn} +\alias{predictLtTruckOwn} +\title{Predict vehicle type (automobile or light truck) for household vehicles.} +\usage{ +predictLtTruckOwn(Hh_df, ModelType = LtTruckModels_ls, TruckProp = NA) +} +\arguments{ +\item{Hh_df}{A household data frame consisting of household characteristics.} + +\item{ModelType}{A list of light truck ownership model.} + +\item{TruckProp}{A numeric indicating the target proportion for light truck +ownership.} +} +\value{ +A list containing vehicle types for each household. +} +\description{ +\code{predictVehicleOwnership} Predict vehicle type (automobile or light truck) +for household vehicles. +} +\details{ +This function predict vehicle type (automobile or light truck) +for household vehicles based on characterisitics of the household, the place where +the household resides, the number of vehicles it owns, and areawide targets for +light truck ownership. +} diff --git a/sources/modules/VEHouseholdVehicles-old/man/predictVehicleOwnership.Rd b/sources/modules/VEHouseholdVehicles-old/man/predictVehicleOwnership.Rd new file mode 100644 index 000000000..5de2576fe --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/man/predictVehicleOwnership.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/AssignVehicleFeatures.R +\name{predictVehicleOwnership} +\alias{predictVehicleOwnership} +\title{Predict vehicle ownership to match the target proportion for a specific +region type.} +\usage{ +predictVehicleOwnership(Hh_df, ModelType = VehOwnModels_ls, + VehProp = NA, Type = "Metro") +} +\arguments{ +\item{Hh_df}{A household data frame consisting of household attributes.} + +\item{ModelType}{A list of vehicle ownership models.} + +\item{VehProp}{A list of data frame consisting of distribution of number +of vehicles by driving age population for each region type.} + +\item{Type}{A string indicating the region type ("Metro": Default, or "NonMetro")} +} +\value{ +A list containing number of vehicles and ownership ratio for each household +} +\description{ +\code{predictVehicleOwnership} Predict vehicle ownership to match the +target proportion for a specific region type. +} +\details{ +This function predicts the number of vehicles and the ratio of number of vehicles +to the driving age population (ownership ratio). +} diff --git a/sources/modules/VEHouseholdVehicles-old/tests/scripts/test.R b/sources/modules/VEHouseholdVehicles-old/tests/scripts/test.R new file mode 100644 index 000000000..c9a98763b --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/tests/scripts/test.R @@ -0,0 +1,9 @@ +#test.R +#------ +#Test script which calls scripts for testing modules of different models + +#Test for VERSPM +source("tests/scripts/verspm_test.R") + +#Test for VERPAT +source("tests/scripts/verpat_test.R") diff --git a/sources/modules/VEHouseholdVehicles-old/tests/scripts/test_functions.R b/sources/modules/VEHouseholdVehicles-old/tests/scripts/test_functions.R new file mode 100644 index 000000000..cfca8f4d8 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/tests/scripts/test_functions.R @@ -0,0 +1,90 @@ +#test_functions.R + +#Define function to set up environment for module tests +#------------------------------------------------------ +setUpTests <- function(TestSetup_ls) { + with(TestSetup_ls, { + #Copy datastore if required + if (LoadDatastore) { + DatastorePath <- file.path(TestDataRepo, DatastoreName) + file.copy(DatastorePath, file.path("tests", DatastoreName)) + if (DatastoreName == "Datastore.tar") { + setwd("tests") + untar("Datastore.tar") + file.remove("Datastore.tar") + setwd("..") + } + } + #Copy defs directory + dir.create("tests/defs") + DefsPath <- file.path(TestDataRepo, "defs") + file.copy(DefsPath, "tests", recursive = TRUE) + #Copy inputs directory + dir.create("tests/inputs") + InputsPath <- file.path(TestDataRepo, "inputs") + file.copy(InputsPath, "tests", recursive = TRUE) + #Create test documentation directory if it doesn't exist + if (!file.exists(file.path("tests", TestDocsDir))) { + dir.create(file.path("tests", TestDocsDir)) + dir.create(file.path("tests", TestDocsDir, "logs")) + } else { + #Clear log files if directed + if (ClearLogs) { + dir.remove(file.path("tests", TestDocsDir, "logs")) + dir.create(file.path("tests", TestDocsDir, "logs")) + } + } + }) +} + +#Define function to run a list of tests +#-------------------------------------- +doTests <- function(Tests_ls, TestSetup_ls) { + TestDocsDir <- TestSetup_ls$TestDocsDir + for (i in 1:length(Tests_ls)) { + ModuleName <- Tests_ls[[i]]$ModuleName + source(paste0("R/", ModuleName, ".R")) + L <- Tests_ls[[i]] + do.call(testModule, L) + LogFile <- paste0("Log_", ModuleName, ".txt") + file.copy( + file.path("tests", LogFile), + file.path("tests", TestDocsDir, "logs", LogFile)) + file.remove(file.path("tests", LogFile)) + } +} + +#Define function to save test results and clean up test environment +#------------------------------------------------------------------ +saveTestResults <- function(TestSetup_ls) { + with(TestSetup_ls, { + #Tar the datastore directory if DatastoreName is Datastore.tar + if (DatastoreName == "Datastore.tar") { + setwd("tests") + tar("Datastore.tar", "Datastore") + dir.remove("Datastore") + setwd("..") + } + #Save the datastore if SaveDatastore = TRUE + if (SaveDatastore) { + file.copy( + file.path("tests", DatastoreName), + file.path(TestDataRepo, DatastoreName), + overwrite = TRUE + ) + } + #Remove the datastore + file.remove(file.path("tests", DatastoreName)) + #Remove the defs directory + dir.remove("tests/defs") + #Remove the inputs directory + dir.remove("tests/inputs") + #Move the model state file to the test documentation directory + file.copy( + file.path("tests", "ModelState.Rda"), + file.path("tests", TestDocsDir, "ModelState.Rda"), + overwrite = TRUE) + file.remove(file.path("tests", "ModelState.Rda")) + }) +} + diff --git a/sources/modules/VEHouseholdVehicles-old/tests/scripts/veclmpo_test.R b/sources/modules/VEHouseholdVehicles-old/tests/scripts/veclmpo_test.R new file mode 100644 index 000000000..7b8b2f9cf --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/tests/scripts/veclmpo_test.R @@ -0,0 +1,44 @@ +#verspm_test.R +#------------- + +#Load packages and test functions +library(filesstrings) +library(visioneval) +library(ordinal) +source("tests/scripts/test_functions.R") + +#Define test setup parameters +TestSetup_ls <- list( + TestDataRepo = "../Test_Data/VE-CLMPO", + DatastoreName = "Datastore.tar", + LoadDatastore = TRUE, + TestDocsDir = "veclmpo", + ClearLogs = TRUE, + # SaveDatastore = TRUE + SaveDatastore = FALSE +) + +#Define the module tests +Tests_ls <- list( + list(ModuleName = "AssignDrivers", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE), + list(ModuleName = "AssignVehicleOwnership", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE), + list(ModuleName = "AssignVehicleType", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE), + list(ModuleName = "CreateVehicleTable", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE), + list(ModuleName = "AssignVehicleAge", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE), + list(ModuleName = "CalculateVehicleOwnCost", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE, + RequiredPackages = "VEHouseholdTravel"), + list(ModuleName = "AdjustVehicleOwnership", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE) +) + +#Set up, run tests, and save test results +setUpTests(TestSetup_ls) +doTests(Tests_ls, TestSetup_ls) +saveTestResults(TestSetup_ls) + diff --git a/sources/modules/VEHouseholdVehicles-old/tests/scripts/verpat_test.R b/sources/modules/VEHouseholdVehicles-old/tests/scripts/verpat_test.R new file mode 100644 index 000000000..1784d4693 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/tests/scripts/verpat_test.R @@ -0,0 +1,77 @@ +#verpat_test.R +#------------- + +#Test AssignVehicleFeatures module +#--------------------------------- +# Organize tests folder for testing the AssignVehicleFeatures module +file.copy("tests/verpat/Datastore_AssignVehicleFeatures.tar", "tests/Datastore_AssignVehicleFeatures.tar") +file.copy("tests/verpat/defs_AssignVehicleFeatures.tar", "tests/defs_AssignVehicleFeatures.tar") +file.copy("tests/verpat/ModelState_AssignVehicleFeatures.zip", "tests/ModelState_AssignVehicleFeatures.zip") +file.copy("tests/verpat/inputs_AssignVehicleFeatures.tar", "tests/inputs_AssignVehicleFeatures.tar") +setwd("tests") +untar("Datastore_AssignVehicleFeatures.tar") +untar("defs_AssignVehicleFeatures.tar") +unzip("ModelState_AssignVehicleFeatures.zip") +untar("inputs_AssignVehicleFeatures.tar") +file.remove(c( + "Datastore_AssignVehicleFeatures.tar", + "defs_AssignVehicleFeatures.tar", + "ModelState_AssignVehicleFeatures.zip", + "inputs_AssignVehicleFeatures.tar")) +setwd("..") +# Test AssignVehicleFeatures module +source("R/AssignVehicleFeatures.R") +testModule( + ModuleName = "AssignVehicleFeatures", + LoadDatastore = TRUE, + SaveDatastore = TRUE, + DoRun = TRUE, + RunFor = "NotBaseYear" +) +# Move the Log_AssignVehicleFeatures.txt file +setwd("tests") +file.copy("Log_AssignVehicleFeatures.txt", "verpat/Log_AssignVehicleFeatures.txt", overwrite = TRUE) +file.remove("Log_AssignVehicleFeatures.txt") +dir.remove("Datastore") +dir.remove("defs") +file.remove("ModelState.Rda") +setwd("..") + +#Test AssignVehicleFeaturesFuture module +#--------------------------------------- +# Organize tests folder for testing the AssignVehicleFeaturesFuture module +file.copy("tests/verpat/Datastore_AssignVehicleFeaturesFuture.tar", "tests/Datastore_AssignVehicleFeaturesFuture.tar") +file.copy("tests/verpat/defs_AssignVehicleFeaturesFuture.tar", "tests/defs_AssignVehicleFeaturesFuture.tar") +file.copy("tests/verpat/ModelState_AssignVehicleFeaturesFuture.zip", "tests/ModelState_AssignVehicleFeaturesFuture.zip") +setwd("tests") +untar("Datastore_AssignVehicleFeaturesFuture.tar") +untar("defs_AssignVehicleFeaturesFuture.tar") +unzip("ModelState_AssignVehicleFeaturesFuture.zip") +file.remove(c( + "Datastore_AssignVehicleFeaturesFuture.tar", + "defs_AssignVehicleFeaturesFuture.tar", + "ModelState_AssignVehicleFeaturesFuture.zip")) +setwd("..") +# Test AssignVehicleFeaturesFuture module +source("R/AssignVehicleFeaturesFuture.R") +testModule( + ModuleName = "AssignVehicleFeaturesFuture", + LoadDatastore = TRUE, + SaveDatastore = TRUE, + DoRun = TRUE, + RunFor = "NotBaseYear" +) +# Move the Log_AssignVehicleFeaturesFuture.txt file +setwd("tests") +file.copy("Log_AssignVehicleFeaturesFuture.txt", "verpat/Log_AssignVehicleFeaturesFuture.txt", overwrite = TRUE) +file.remove("Log_AssignVehicleFeaturesFuture.txt") +setwd("..") + +#Clean up the tests directory +#---------------------------- +setwd("tests") +dir.remove("Datastore") +dir.remove("defs") +dir.remove("inputs") +file.remove("ModelState.Rda") +setwd("..") diff --git a/sources/modules/VEHouseholdVehicles-old/tests/scripts/verspm_test.R b/sources/modules/VEHouseholdVehicles-old/tests/scripts/verspm_test.R new file mode 100644 index 000000000..0e34b36a9 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/tests/scripts/verspm_test.R @@ -0,0 +1,44 @@ +#verspm_test.R +#------------- + +#Load packages and test functions +library(filesstrings) +library(visioneval) +library(ordinal) +source("tests/scripts/test_functions.R") + +#Define test setup parameters +TestSetup_ls <- list( + TestDataRepo = "../Test_Data/VE-RSPM", + DatastoreName = "Datastore.tar", + LoadDatastore = TRUE, + TestDocsDir = "verspm", + ClearLogs = TRUE, + # SaveDatastore = TRUE + SaveDatastore = FALSE +) + +#Define the module tests +Tests_ls <- list( + list(ModuleName = "AssignDrivers", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE), + list(ModuleName = "AssignVehicleOwnership", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE), + list(ModuleName = "AssignVehicleType", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE), + list(ModuleName = "CreateVehicleTable", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE), + list(ModuleName = "AssignVehicleAge", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE), + list(ModuleName = "CalculateVehicleOwnCost", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE, + RequiredPackages = "VEHouseholdTravel"), + list(ModuleName = "AdjustVehicleOwnership", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE) +) + +#Set up, run tests, and save test results +setUpTests(TestSetup_ls) +doTests(Tests_ls, TestSetup_ls) +saveTestResults(TestSetup_ls) + diff --git a/sources/modules/VEHouseholdVehicles-old/tests/scripts/vestate_test.R b/sources/modules/VEHouseholdVehicles-old/tests/scripts/vestate_test.R new file mode 100644 index 000000000..a5849e7f3 --- /dev/null +++ b/sources/modules/VEHouseholdVehicles-old/tests/scripts/vestate_test.R @@ -0,0 +1,45 @@ +#vestate_test.R +#------------- + +#Load packages and test functions +library(filesstrings) +library(visioneval) +library(ordinal) +source("tests/scripts/test_functions.R") + +#Define test setup parameters +TestSetup_ls <- list( + TestDataRepo = "../Test_Data/VE-State", + DatastoreName = "Datastore.tar", + LoadDatastore = TRUE, + TestDocsDir = "vestate", + ClearLogs = TRUE, + # SaveDatastore = TRUE + SaveDatastore = FALSE +) + +#Define the module tests +Tests_ls <- list( + list(ModuleName = "AssignDrivers", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE), + list(ModuleName = "AssignVehicleOwnership", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE), + list(ModuleName = "AssignVehicleType", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE), + list(ModuleName = "CreateVehicleTable", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE), + list(ModuleName = "AssignVehicleAge", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE), + list(ModuleName = "CalculateVehicleOwnCost", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE, + RequiredPackages = "VEHouseholdTravel"), + list(ModuleName = "AdjustVehicleOwnership", + LoadDatastore = TRUE, SaveDatastore = TRUE, DoRun = TRUE) +) + +#Set up, run tests, and save test results +setUpTests(TestSetup_ls) +doTests(Tests_ls, TestSetup_ls) +saveTestResults(TestSetup_ls) + + diff --git a/sources/modules/VEHouseholdVehicles-old/tests/veclmpo/ModelState.Rda b/sources/modules/VEHouseholdVehicles-old/tests/veclmpo/ModelState.Rda new file mode 100644 index 000000000..3e6403466 Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/tests/veclmpo/ModelState.Rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/tests/verpat/Datastore_AssignVehicleFeatures.tar b/sources/modules/VEHouseholdVehicles-old/tests/verpat/Datastore_AssignVehicleFeatures.tar new file mode 100644 index 000000000..184dca94b Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/tests/verpat/Datastore_AssignVehicleFeatures.tar differ diff --git a/sources/modules/VEHouseholdVehicles-old/tests/verpat/Datastore_AssignVehicleFeaturesFuture.tar b/sources/modules/VEHouseholdVehicles-old/tests/verpat/Datastore_AssignVehicleFeaturesFuture.tar new file mode 100644 index 000000000..0dedf8fbf Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/tests/verpat/Datastore_AssignVehicleFeaturesFuture.tar differ diff --git a/sources/modules/VEHouseholdVehicles-old/tests/verpat/ModelState_AssignVehicleFeatures.zip b/sources/modules/VEHouseholdVehicles-old/tests/verpat/ModelState_AssignVehicleFeatures.zip new file mode 100644 index 000000000..3efe3b1b8 Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/tests/verpat/ModelState_AssignVehicleFeatures.zip differ diff --git a/sources/modules/VEHouseholdVehicles-old/tests/verpat/ModelState_AssignVehicleFeaturesFuture.zip b/sources/modules/VEHouseholdVehicles-old/tests/verpat/ModelState_AssignVehicleFeaturesFuture.zip new file mode 100644 index 000000000..4b78c905e Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/tests/verpat/ModelState_AssignVehicleFeaturesFuture.zip differ diff --git a/sources/modules/VEHouseholdVehicles-old/tests/verpat/defs_AssignVehicleFeatures.tar b/sources/modules/VEHouseholdVehicles-old/tests/verpat/defs_AssignVehicleFeatures.tar new file mode 100644 index 000000000..61e555cd5 Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/tests/verpat/defs_AssignVehicleFeatures.tar differ diff --git a/sources/modules/VEHouseholdVehicles-old/tests/verpat/defs_AssignVehicleFeaturesFuture.tar b/sources/modules/VEHouseholdVehicles-old/tests/verpat/defs_AssignVehicleFeaturesFuture.tar new file mode 100644 index 000000000..6920098be Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/tests/verpat/defs_AssignVehicleFeaturesFuture.tar differ diff --git a/sources/modules/VEHouseholdVehicles-old/tests/verpat/inputs_AssignVehicleFeatures.tar b/sources/modules/VEHouseholdVehicles-old/tests/verpat/inputs_AssignVehicleFeatures.tar new file mode 100644 index 000000000..bd13588ea Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/tests/verpat/inputs_AssignVehicleFeatures.tar differ diff --git a/sources/modules/VEHouseholdVehicles-old/tests/verspm/ModelState.Rda b/sources/modules/VEHouseholdVehicles-old/tests/verspm/ModelState.Rda new file mode 100644 index 000000000..5d06be58a Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/tests/verspm/ModelState.Rda differ diff --git a/sources/modules/VEHouseholdVehicles-old/tests/vestate/ModelState.Rda b/sources/modules/VEHouseholdVehicles-old/tests/vestate/ModelState.Rda new file mode 100644 index 000000000..15bb0edf7 Binary files /dev/null and b/sources/modules/VEHouseholdVehicles-old/tests/vestate/ModelState.Rda differ