R/policy_analysis.R

In djmorris1989/iomodeltobalc: Input-Output Modelling of Tobacco and Alcohol Policy

#' Produce the Leontief inverse matrices for use in the analysis
#'
#' @param data list produced by `read_iotable` containing the IO data.
#' @param changes vector of sectoral proportionate changes in demand to model.
#' @param L1 the Leontief inverse matrix with households exogenous.
#' @param L2 the Leontief inverse matrix with households endogenous to the model.
#'
#' @return a table of output effects (in levels and percentages) and associated Type I and II multipliers.
#'
#' @export
policy_analysis <- function(changes = NULL,
                            L1 = leontief$Ltype1,
                            L2 = leontief$Ltype2,
                            data = data) {

  # produce the changes using the Type 1 matrix
  Ch.output.abs.1 <- L1 %*% changes
  Ch.output.perc.1  <- (Ch.output.abs.1/sum(data$total.output))*100

  # produce the change using the Type 2 matrix
  Ch.output.abs.2 <- L2 %*% c(changes,0)
  Ch.output.perc.2  <- (Ch.output.abs.2/sum(data$total.output))*100

  ##################
  # Type 1 Effects #

  # Direct effects are the effects on the economy of the change in demand.
  direct.abs  <- sum(changes)
  direct.perc <- (direct.abs/sum(data$total.output))*100

  # Indirect effects are the effects of the knock-on impacts across other sectors.
  indirect.abs  <- sum(Ch.output.abs.1) - direct.abs
  indirect.perc <- (indirect.abs/sum(data$total.output))*100

  # Total effects in the type 1 scenario are direct + indirect effects.
  total.type1.abs <- sum(Ch.output.abs.1)
  total.type1.perc <- sum(Ch.output.perc.1)

  # Type 1 multiplier - the effect on the economy over and above the direct change in demand
  multiplier.type1 <- total.type1.abs/direct.abs

  ##################
  # Type 2 Effects #

  total.type2.abs  <- sum(Ch.output.abs.2)
  total.type2.perc <- sum(Ch.output.perc.2)

  induced.perc <- total.type2.perc - direct.perc - indirect.perc
  induced.abs  <- total.type2.abs - direct.abs - indirect.abs

  multiplier.type2 <- total.type2.abs/direct.abs

  ##########################
  #### group into table ####

  output.abs  <- c(round(direct.abs,3) ,round(indirect.abs,3) ,round(total.type1.abs,3),
                   round(induced.abs,3) ,round(total.type2.abs,3),
                   round(multiplier.type1,3),round(multiplier.type2,3))
  output.perc <- c(round(direct.perc,3),round(indirect.perc,3),round(total.type1.perc,3),
                   round(induced.perc,3),round(total.type2.perc,3),
                   round(multiplier.type1,3),round(multiplier.type2,3))

  results <- matrix(c(output.abs,output.perc),byrow=FALSE,nrow=length(output.perc),
                    dimnames = list(c("Direct Effect","Indirect Effect","Total Effect (T1)","Induced Effect","Total Effect (T2)","T1 Multiplier","T2 Multiplier"),
                                    c("Output (£)","Output (%)")))
  #print(results)
  return(results)
}