R/create_makeuse_coefficients.R

In tlumip/swimctr: Oregon SWIM v2.5 Commercial Transport (CT) Model

#' Create input-output make and use cofficients from PECAS AA accounts
#' 
#' @param pecas_makeuse Data frame containing statewide input-output flows in
#'   annual dollars, generated by the PECAS AA module
#' @param faf_data Data frame containing the reformatted Freight Analysis 
#'   Framework (FAF) annual flow data
#' @param save_to File name for saving the derived make and use coefficients in
#'   comma-separated value format (optional)
#'
#' @details This function converts the PECAS input-output flows by sector into
#'   make and use coefficients, used to map commodities produced or consumed by
#'   each sector (make and use coefficients, respectively). PECAS already
#'   splits flows between transportable and non-transportable commodities,
#'   making our job simpler. We simply have to put the data, which is produced
#'   for each year PECAS runs, into format we need. The transportable goods are
#'   defined using Standard Classification of Transportable Goods (SCTG) codes, 
#'   which are also used in USDOT data, including their Freight Analysis
#'   Framework (FAF), which we uses to define inter-regional flows. We read the
#'   FAF data in this function to create a list of each commodity defined within
#'   it, which is compared to those found in the make-use data. An error is
#'   thrown if one or more commodities are found in the FAF that are not in the 
#'   make-use data (although not vice-versa, for there might be local production
#'   not included in the inter-regional flows). The user can optionally save the
#'   derived coefficients in a text file in comma-separated value format. 
#'   
#' @export
#' @examples
#' make_use <- create_makeuse_coefficients(pecas_makeuse, faf_data,
#'   "make-use-coefficients.csv")

create_makeuse_coefficients <- function(pecas_makeuse, faf_data,
  save_to = NULL) {
  
  ct_msg(header = "Creating make and use coefficients from PECAS output")
  
  # Find all of the commodities defined in the FAF flow database, which we will
  # compare to the commodities we find make and use coefficients for later
  all_commodities <- sort(unique(faf_data$sctg2))
  
  # Start by processing the make coefficients
  make <- pecas_makeuse %>%
    dplyr::filter(MorU == "M") %>%
    
    # Remove non-transportable commodites, and extract two-digit SCTG from those
    # that remain
    dplyr::mutate(prefix = tolower(substr(Commodity, 1, 4)), 
      sctg2 = ifelse(prefix == "sctg", substr(Commodity, 5, 6), NA)) %>%
    dplyr::filter(!is.na(sctg2)) %>%
    
    # Remove households and imports from the activities, as we are only 
    # concerned with who locally produces each commodity
    dplyr::mutate(first_two = substr(Activity, 1, 2),
      prefix = ifelse(first_two == "sc", paste(first_two, 
        substr(Activity, 3, 4), sep = ''), first_two)) %>%
    dplyr::filter(prefix != "HH" & prefix != "sctg") %>%
    
    # And finally, calculate the resulting factors based upon the remaining 
    # fields
    dplyr::group_by(MorU, Activity, sctg2) %>%
    dplyr::summarise(Amount = sum(Amount)) %>%
    dplyr::mutate(coefficient = Amount/sum(Amount))
  
  # Tell us the dimensions of the resulting make coefficients table
  ct_msg(paste("Deriving", nrow(make), "make coefficients for",
    length(unique(make$Activity)), "sectors by",
    length(unique(make$sctg2)), "commodities"))
  
  # Figure out how many commodities do not have corresponding make coefficients
  make_commodities <- as.integer(sort(unique(make$sctg2)))
  not_found <- setdiff(all_commodities, make_commodities)
  ct_msg(paste("Warning: make coefficients not found for SCTG", not_found))

  # We will do more or less the same thing for the use coefficients
  use <- pecas_makeuse %>%
    dplyr::filter(MorU == "U") %>%
    
    # As before, remove non-transportable commodities, and extract the two-digit
    # SCTG code from commodity field for those that remain
    dplyr::mutate(prefix = tolower(substr(Commodity, 1, 4)),
      sctg2 = ifelse(prefix == "sctg", substr(Commodity, 5, 6), NA)) %>%
    dplyr::filter(!is.na(sctg2)) %>%
    
    # Remove exports from the activities, for we are only trying to portray
    # competing internal activities
    dplyr::mutate(prefix = tolower(substr(Activity, 1, 4))) %>%
    dplyr::filter(prefix != "sctg") %>%
    
    # We will collapse all households into a single activity category of the 
    # same name, for they are valid consumers of transportable commodities
    dplyr::mutate(prefix = substr(Activity, 1, 2),
      Activity = ifelse(prefix == "HH", "households", Activity)) %>%
    
    # And now we're finally ready to calculate the use coefficients
    dplyr::group_by(MorU, Activity, sctg2) %>%
    dplyr::summarise(Amount = sum(Amount)) %>%
    dplyr::mutate(coefficient = Amount/sum(Amount))
  
  # Tell us the outcome
  ct_msg(paste("Deriving", nrow(use), "use coefficients for",
    length(unique(use$sctg2)), "commodities by",
    length(unique(use$Activity)), "sectors"))
  
  # Figure out how many commodities do not have corresponding make coefficients
  use_commodities <- as.integer(sort(unique(use$sctg2)))
  not_found <- setdiff(all_commodities, use_commodities)
  ct_msg(paste("Warning: use coefficients not found for SCTG", not_found))
  
  # Recombine the two tables into a single file, and save them as intermediate
  # outputs if requested by the user
  makeuse <-
    dplyr::bind_rows(make, use) %>%
    dplyr::rename(sector = Activity) %>%
    dplyr::select(-Amount) %>%
    dplyr::arrange(MorU, sector, sctg2)
  if (!is.null(save_to)) readr::write_csv(makeuse, save_to)
  
  # Return the combined table
  makeuse
}