R/MDCES_demand.R

In GE: General Equilibrium Modeling

#' @export
#' @title Modified Displaced CES Demand Function
#' @aliases MDCES_demand
#' @description Compute the modified displaced CES demand function.
#' Firstly, the (unmodified) DCES demand vector and the (unmodified) utility level are computed under the given income and prices.
#' Secondly, the modified beta and es are computed under the unmodified utility level.
#' Finally, the DCES demand vector (namely the modified DCES demand vector) and the utility level
#' (namely the modified DCES utility) are computed under the modified beta, the modified es, the given income and prices.
#' @param es the elasticity of substitution.
#' @param beta an n-vector consisting of the marginal expenditure share coefficients (Fullerton, 1989).
#' @param xi an n-vector. Each element of xi parameterizes whether
#' the particular good is a necessity for the household (Acemoglu, 2009, page 152).
#' For example, xi[i] > 0 may mean that the household needs to consume at least a certain amount of good i to survive.
#' @param w a scalar indicating the income.
#' @param p an n-vector indicating the prices.
#' @param betaMod a function with the unmodified utility level u.unmod as the argument.
#' @param esMod a function with the unmodified utility level u.unmod as the argument.
#' @param detail If detail==FALSE, the modified demand vector is returned.
#' If detail==TRUE, the returned vector consists of the modified demand vector,
#' the modified utility, the modified es, the modified beta, the unmodified utility and
#' the unmodified demand vector.
#' @references Acemoglu, D. (2009, ISBN: 9780691132921) Introduction to Modern Economic Growth. Princeton University Press.
#' @references Fullerton, D. (1989) Notes on Displaced CES Functional Forms. Available at: https://works.bepress.com/don_fullerton/39/
#' @examples
#' \donttest{
#' MDCES_demand(
#'   es = 1.7, beta = c(0.9, 0.1), xi = c(12, 48),
#'   w = 24, p = c(1, 1 / 400),
#'   betaMod = function(u.unmod) {
#'     beta2 <- min(0.1, 10 / u.unmod)
#'     c(1 - beta2, beta2)
#'   },
#'   detail = TRUE
#' )
#'
#' #### An example of computing the daily
#' #### labor supply at various wage rates.
#' result <- c()
#'
#' for (real.wage in 4:400) {
#'   x <- MDCES_demand(
#'     es = 1.7, beta = c(0.9, 0.1),
#'     xi = c(12, 48), w = 24,
#'     p = c(1, 1 / real.wage),
#'     betaMod = function(u.unmod) {
#'       beta2 <- min(0.1, 10 / u.unmod)
#'       c(1 - beta2, beta2)
#'     },
#'     detail = TRUE
#'   )
#'
#'   lab.supply <- unname(24 - x[1])
#'   result <- rbind(
#'     result,
#'     c(real.wage, lab.supply, x)
#'   )
#' }
#'
#' plot(result[, 1:2],
#'   type = "o", pch = 20,
#'   xlab = "hourly real wage",
#'   ylab = "daily labor supply"
#' )
#'
#' #### A 2-by-2 general equilibrium model
#' #### with a MDCES demand function
#' ge <- sdm2(
#'   A = function(state) {
#'     a.firm <- CD_A(alpha = 5, Beta = c(0.5, 0.5), state$p)
#'     a.consumer <-
#'       MDCES_demand(
#'         es = 1, beta = c(0.5, 0.5), xi = c(0, 0), w = state$w[2], p = state$p,
#'         betaMod = function(u.unmod) {
#'           beta2 <- 0.95 * plogis(u.unmod, location = 2, scale = 2)
#'           c(1 - beta2, beta2)
#'         }
#'       )
#'     cbind(a.firm, a.consumer)
#'   },
#'   B = matrix(c(
#'     1, 0,
#'     0, 0
#'   ), 2, 2, TRUE),
#'   S0Exg = matrix(c(
#'     NA, NA,
#'     NA, 1
#'   ), 2, 2, TRUE),
#'   names.commodity = c("prod", "lab"),
#'   names.agent = c("firm", "consumer"),
#'   numeraire = "lab"
#' )
#'
#' ge$z
#' ge$D
#' MDCES_demand(
#'   es = 1, beta = c(0.5, 0.5), xi = c(0, 0),
#'   w = 1, p = ge$p,
#'   betaMod = function(u.unmod) {
#'     beta2 <- 0.95 * plogis(u.unmod, location = 2, scale = 2)
#'     c(1 - beta2, beta2)
#'   }
#' )
#' }
MDCES_demand <- function(es, beta, xi, w, p,
                         betaMod = NULL, esMod = NULL, detail = FALSE) {
  x.unmod <- DCES_demand(
    es = es,
    beta = beta,
    xi = xi,
    w = w,
    p = p
  )

  u.unmod <- DCES_indirect(
    es = es,
    beta = beta,
    xi = xi,
    w = w,
    p = p
  )

  if (is.nan(u.unmod)) {
    warning("Li: w is too small.")
    return(NaN)
  }

  if (is.null(betaMod)) {
    beta.mod <- beta
  } else {
    beta.mod <- betaMod(u.unmod)
  }

  if (is.null(esMod)) {
    es.mod <- es
  } else {
    es.mod <- esMod(u.unmod)
  }

  x.mod <- DCES_demand(
    es = es.mod,
    beta = beta.mod,
    xi = xi,
    w = w,
    p = p
  )


  u.mod <- DCES(
    es = es.mod,
    beta = beta.mod,
    xi = xi,
    x = x.mod
  )

  if (detail) {
    return(c(
      x.mod = x.mod, u.mod = u.mod, es.mod = es.mod,
      beta.mod = beta.mod, u.unmod = u.unmod, x.unmod = x.unmod
    ))
  } else {
    return(x.mod)
  }
}