R/demand_coefficient.R

In GE: General Equilibrium Modeling

#' @import CGE data.tree DiagrammeR
#' @export
#' @title Compute Demand Coefficients of an Agent with a Demand Structural Tree
#' @aliases demand_coefficient
#' @description Given a price vector, this function computes the demand coefficients of an agent with a demand structural tree.
#' The class of a demand structural tree is Node defined by the package data.tree.
#' @param node a demand structural tree.
#' @param p a price vector with names of commodities.
#' @param trace FALSE (default) or TRUE. If TRUE, calculation intermediate results will be recorded in nodes.
#' @return A vector consisting of demand coefficients.
#' @details Demand coefficients often indicate the quantity of various commodities needed by an economic agent in order to obtain a unit of output or utility,
#' and these commodities can include both real commodities and financial instruments such as tax receipts, stocks, bonds and currency.\cr
#' The demand for various commodities by an economic agent can be expressed by a demand structure tree.
#' Each non-leaf node can be regarded as the output of all its child nodes.
#' Each node can be regarded as an input of its parent node.
#' In other words, the commodity represented by each non-leaf node is a composite commodity composed of the
#' commodities represented by its child nodes.
#' Each non-leaf node usually has an attribute named type.
#' This attribute describes the input-output relationship between the child nodes and the parent node.
#' This relationship can sometimes be represented by a production function or a utility function.
#' The type attribute of each non-leaf node can take the following values.
#' \itemize{
#' \item SCES. In this case, this node also has parameters alpha, beta and es (or sigma = 1 - 1 / es).
#' alpha and es are scalars. beta is a vector. These parameters are parameters of a standard CES function (see \code{\link{SCES}} and \code{\link{SCES_A}}).
#' \item CES. In this case, this node also has parameters alpha, beta, theta (optional) and es (or sigma = 1 - 1 / es) (see CGE::CES_A).
#' \item Leontief. In this case, this node also has the parameter a,
#' which is a vector and is the parameter of a Leontief function.
#' \item CD. CD is Cobb-Douglas. In this case, this node also has parameters alpha and beta,
#' which are parameters of a Cobb-Douglas function.
#' \item CESAK. In this case, this node also has parameters es, alpha, betaK and alphaK,
#' which are parameters of the CESAK function (see \code{\link{CESAK_dc}}). Moreover, the first child node should represent capital goods.
#' \item FIN. That is the financial type.
#' In this case, this node also has the parameter rate or beta.
#' If the parameter beta is not NULL, then the parameter rate will be ignored.
#' The parameter rate applies to all situations, while the parameter beta only applies for some special cases.
#' For FIN nodes, the first child node should represent for a physical commodity or a composite commodity
#' containing a physical commodity, and other child nodes represent for financial instruments.
#' The parameter beta indicates the proportion of each child node's expenditure.
#' The parameter rate indicates the expenditure ratios between financial-instrument-type child nodes
#' and the first child node.
#' The first element of the parameter rate indicates the amount of the first child node needed to get a unit of output.
#' \item FUNC. That is the function type. In this case, this node also has an attribute named func.
#' The value of that attribute is a function which calculates the demand coefficient for the child nodes.
#' The argument of that function is a price vector.
#' The length of that price vector is equal to the number of the child nodes.
#' \item StickyLinear or SL. That is the sticky linear type. In this case, this node also has an attribute named beta that
#' contains the coefficients of the linear utility or production function.
#' In order to avoid too drastic changes in the demand structure, the adjustment process of the demand structure has a certain stickiness when prices change.
#' }
#'
#' @examples
#' #### a Leontief-type node
#' dst <- node_new("firm",
#'   type = "Leontief", a = c(0.5, 0.1),
#'   "wheat", "iron"
#' )
#' print(dst, "type")
#' node_print(dst)
#' plot(dst)
#' node_plot(dst, TRUE)
#'
#' demand_coefficient(dst, p = c(wheat = 1, iron = 2)) # the same as a = c(0.5, 0.1)
#'
#' #### a CD-type node
#' dst <- node_new("firm",
#'   type = "CD", alpha = 1, beta = c(0.5, 0.5),
#'   "wheat", "iron"
#' )
#'
#' demand_coefficient(dst, p = c(wheat = 1, iron = 2))
#' # the same as the following
#' CD_A(1, c(0.5, 0.5), c(1, 2))
#'
#' #### a SCES-type node
#' dst <- node_new("firm",
#'   type = "SCES",
#'   alpha = 2, beta = c(0.8, 0.2), es = 0.5,
#'   "wheat", "iron"
#' )
#'
#' demand_coefficient(dst, p = c(wheat = 1, iron = 2))
#'
#' # the same as the following
#' SCES_A(alpha = 2, Beta = c(0.8, 0.2), p = c(1, 2), es = 0.5)
#' CES_A(sigma = 1 - 1 / 0.5, alpha = 2, Beta = c(0.8, 0.2), p = c(1, 2), Theta = c(0.8, 0.2))
#'
#' #### a FUNC-type node
#' dst <- node_new("firm",
#'   type = "FUNC",
#'   func = function(p) {
#'     CES_A(
#'       sigma = -1, alpha = 2,
#'       Beta = c(0.8, 0.2), p,
#'       Theta = c(0.8, 0.2)
#'     )
#'   },
#'   "wheat", "iron"
#' )
#'
#' demand_coefficient(dst, p = c(wheat = 1, iron = 2))
#'
#' # the same as the following
#' CES_A(sigma = -1, alpha = 2, Beta = c(0.8, 0.2), p = c(1, 2), Theta = c(0.8, 0.2))
#'
#' ####
#' p <- c(wheat = 1, iron = 3, labor = 2, capital = 4)
#' dst <- node_new("firm 1",
#'   type = "SCES", sigma = -1, alpha = 1, beta = c(1, 1),
#'   "cc1", "cc2"
#' )
#' node_set(dst, "cc1",
#'   type = "Leontief", a = c(0.6, 0.4),
#'   "wheat", "iron"
#' )
#' node_set(dst, "cc2",
#'   type = "SCES", sigma = -1, alpha = 1, beta = c(1, 1),
#'   "labor", "capital"
#' )
#'
#' node_plot(dst)
#' demand_coefficient(dst, p)
#'
#' ####
#' p <- c(product = 1, labor = 1, money = 1)
#' dst <- node_new("firm",
#'   type = "FIN", rate = c(0.75, 1 / 3),
#'   "cc1", "money"
#' ) # a financial-type node
#' node_set(dst, "cc1",
#'   type = "Leontief", a = c(0.8, 0.2),
#'   "product", "labor"
#' )
#'
#' node_plot(dst)
#' demand_coefficient(dst, p)
#'
#' #### the same as above
#' p <- c(product = 1, labor = 1, money = 1)
#' dst <- node_new("firm",
#'   type = "Leontief", a = c(0.8, 0.2),
#'   "cc1", "cc2"
#' )
#' node_set(dst, "cc1",
#'   type = "FIN", rate = c(0.75, 1 / 3),
#'   "product", "money"
#' )
#'
#' node_set(dst, "cc2",
#'   type = "FIN", rate = c(0.75, 1 / 3),
#'   "labor", "money"
#' )
#' node_plot(dst)
#' demand_coefficient(dst, p)
#'
#' #### the same as above
#' p <- c(product = 1, labor = 1, money = 1)
#' dst <- node_new("firm",
#'   type = "FIN", rate = c(1, 1 / 3),
#'   "cc1", "money"
#' ) # Financial-type Demand Structure
#' node_set(dst, "cc1",
#'   type = "Leontief", a = c(0.6, 0.15),
#'   "product", "labor"
#' )
#'
#' node_plot(dst)
#' demand_coefficient(dst, p)
demand_coefficient <- function(node, p, trace = FALSE) {
  compute.price_dc <- function(node, p) {
    if (isLeaf(node)) {
      tmp.name <- node$name
      dc <- 1
      names(dc) <- tmp.name
      return(list(
        price = p[tmp.name],
        dc = dc
      ))
    }

    p_dc <- lapply(node$children, compute.price_dc, p)
    the.input.p <- sapply(p_dc, function(x) unname(x$p))
    child.dc <- lapply(p_dc, function(x) x$dc)

    switch(node$type,
      "SCES" = {
        if (!is.null(node$es)) {
          the.input.coef <- SCES_A(
            alpha = node$alpha, Beta = node$beta, p = the.input.p, es = node$es
          )
        } else {
          the.input.coef <- SCES_A(
            node$sigma, node$alpha, node$beta, the.input.p
          )
        }
      },
      "CES" = {
        if (!is.null(node$es)) {
          tmp.sigma <- 1 - 1 / node$es
        } else {
          tmp.sigma <- node$sigma
        }
        the.input.coef <- CES_A(
          sigma = tmp.sigma, alpha = node$alpha, Beta = node$beta,
          p = the.input.p, Theta = node$theta
        )
      },
      "CD" = {
        the.input.coef <- CD_A(node$alpha, node$beta, the.input.p)
      },
      "CESAK" = {
        the.input.coef <- CESAK_dc(node$alpha, node$betaK, node$alphaK, the.input.p, node$es)
      },
      "Leontief" = {
        the.input.coef <- node$a
      },
      "FIN" = {
        if (!is.null(node$beta)) {
          tmp.rate <- beta_to_rate(node$beta)
        } else {
          tmp.rate <- node$rate
        }
        if (length(tmp.rate) == length(the.input.p)) {
          tmp.input.value <- the.input.p[1] * tmp.rate[1]
          the.input.coef <- c(
            tmp.rate[1],
            tmp.input.value * tmp.rate[-1] / the.input.p[-1]
          )
        } else if (length(tmp.rate) == length(the.input.p) - 1) {
          the.input.coef <- c(1, the.input.p[1] * tmp.rate / the.input.p[-1])
        } else {
          stop("Li: wrong length of tmp.rate.")
        }
      },
      "FUNC" = {
        the.input.coef <- node$func(the.input.p) # the.input.coef is the direct demand coefficient for children.
      },
      "SL" = ,
      "StickyLinear" = {
        if (is.null(node$last.a)) node$last.a <- node$beta
        if (is.null(node$coef)) node$coef <- 0.2
        vmu <- node$beta / the.input.p
        ratio <- vmu / mean(vmu)
        a <- node$last.a * ratio_adjust(ratio, node$coef)
        a <- a / (sum(node$beta * a))
        the.input.coef <- node$last.a <- a
      },
      stop(paste0("Li: wrong node$type:", node$type))
    )

    price <- sum(the.input.p * the.input.coef)

    dc <- p * 0
    for (k in seq_along(the.input.coef)) {
      tmp <- unlist(child.dc[[k]]) * the.input.coef[k]
      dc[names(tmp)] <- dc[names(tmp)] + tmp
    }

    if (trace){
      node$the.input.p <- the.input.p
      node$the.input.coef <- the.input.coef
      node$price <- price
      node$dc <- dc
    }

    return(list(
      price = price,
      dc = dc
    ))
  }

  p_dc <- compute.price_dc(node, p)
  return(p_dc$dc)
}