R/veh-op-costs.R

In DanBoyB/cba: A collection of tools for simple cost benefit analysis of simple road realignment schemes

#' Calculate vehicle operating costs over full appraisal period
#'
#' A function to read in appraisal paramaters, fuel and non-fuel costs 
#' calculated and traffic projections to calculate scheme vehicle operating
#' costs
#'
#' @param opening_yr The proposed year of scheme opening
#' @param appr_period The standard appraisal period in years
#' @param resid_period The residual value period in years (in
#' addition to the standard appraisal period)
#' @param disc_rate The test discount rate as a decimal
#' @param price_base_yr The price base year assumed for the 
#' appraisal. Defaults to 2011
#' @param ave_veh_occ The average vehicle occupancy (persions
#' per vehicle)
#' @param traffic_proj A dataframe of annual traffic flow projections
#' @param speed_ex Average speed on existing route in kph
#' @param speed_prop Average speed on proposed route in kph
#' @param fuel_costs Table of fuel costs generated by fuel_costs_km function
#' @param non_fuel_costs Table of non-fuel costs generated by non_fuel_cost_km
#' function
#'
#' @import dplyr
#' @return A dataframe of discounted scheme benefits
#' @export
#' 
veh_op_costs <- function(opening_yr, appr_period = 30, resid_period = 30,
                         disc_rate, price_base_yr = 2011, ave_veh_occ = 1.2,
                         traffic_proj, speed_ex, speed_prop, fuel_costs,
                         non_fuel_costs) {
    
    if (missing(opening_yr))
        stop("Need to specify opening year")
    
    if (missing(appr_period))
        stop("Need to specify appraisal period in years")
    
    if (missing(resid_period))
        stop("Need to specify residual value period in years")
    
    if (missing(disc_rate))
        stop("Need to specify test discount rate as a decimal")
    
    if (missing(price_base_yr))
        stop("Need to specify price base year")
    
    if (missing(traffic_proj))
        stop("Need to include dataframe of traffic projections")
    
    if (missing(speed_ex))
        stop("Need to specify the average speed on existing route in kph")
    
    if (missing(speed_prop))
        stop("Need to specify the average speed on proposed route in kph")
    
    if (missing(fuel_costs))
        stop("Need to specify table of fuel costs")
    
    if (missing(non_fuel_costs))
        stop("Need to specify table of non-fuel costs")
    
    fuel_cost_ex <- fuel_costs %>% 
        filter(speed == speed_ex) %>% 
        select(cost_per_km) %>% 
        as.numeric
    
    fuel_cost_prop <- fuel_costs %>% 
        filter(speed == speed_prop) %>% 
        select(cost_per_km) %>% 
        as.numeric
    
    nonfuel_cost_ex <- non_fuel_costs %>% 
        filter(speed == speed_ex) %>% 
        select(cost_per_km) %>% 
        as.numeric
    
    nonfuel_cost_prop <- non_fuel_costs %>% 
        filter(speed == speed_prop) %>% 
        select(cost_per_km) %>% 
        as.numeric
    
    costs <- traffic_proj %>%
        filter(year %in% c(opening_yr:(opening_yr + appr_period + resid_period - 1))) %>% 
        mutate(undisc_costs = ((fuel_cost_prop - fuel_cost_ex) + 
                   (nonfuel_cost_prop - nonfuel_cost_ex)) * total * ave_veh_occ, 
               disc_costs = undisc_costs / ((1 + disc_rate) ^ (year - price_base_yr))) %>% 
        select(year, disc_costs)
    
    return(costs)
}