R/gemAssetPricing_CUF.R

In GE: General Equilibrium Modeling

#' @export
#' @title Compute Asset Market Equilibria with Commodity Utility Functions for Some Simple Cases
#' @aliases gemAssetPricing_CUF
#' @description Compute the equilibrium of an asset market by the function sdm2 and by computing marginal utility of assets (see Sharpe, 2008).
#' The argument of the utility function used in the calculation is the commodity vector (i.e. payoff vector).
#' @param S an n-by-m supply matrix of assets.
#' @param UAP a unit asset payoff k-by-n matrix.
#' @param uf a utility function or a utility function list.
#' @param muf a marginal utility function or a marginal utility function list.
#' @param ratio_adjust_coef a scalar indicating the adjustment velocity of demand structure.
#' @param numeraire	the index of the numeraire commodity.
#' @param ... arguments to be passed to the function sdm2.
#' @return  A general equilibrium containing a value marginal utility matrix (VMU).
#' @references Danthine, J. P., Donaldson, J. (2005, ISBN: 9780123693808) Intermediate Financial Theory. Elsevier Academic Press.
#' @references Sharpe, William F. (2008, ISBN: 9780691138503) Investors and Markets: Portfolio Choices, Asset Prices, and Investment Advice. Princeton University Press.
#' @references Wang Jiang (2006, ISBN: 9787300073477) Financial Economics. Beijing: China Renmin University Press. (In Chinese)
#' @references Xu Gao (2018, ISBN: 9787300258232) Twenty-five Lectures on Financial Economics. Beijing: China Renmin University Press. (In Chinese)
#' @references https://web.stanford.edu/~wfsharpe/apsim/index.html
#' @seealso \code{\link{gemAssetPricingExample}}.
#' @examples
#' \donttest{
#' gemAssetPricing_CUF(muf = function(x) 1 / x)
#'
#' gemAssetPricing_CUF(
#'   S = cbind(c(1, 0), c(0, 2)),
#'   muf = function(x) 1 / x
#' )
#'
#' gemAssetPricing_CUF(
#'   UAP = cbind(c(1, 0), c(0, 2)),
#'   muf = function(x) 1 / x
#' )
#'
#' #### an example of Danthine and Donaldson (2005, section 8.3).
#' ge <- gemAssetPricing_CUF(
#'   S = matrix(c(
#'     10, 5,
#'     1, 4,
#'     2, 6
#'   ), 3, 2, TRUE),
#'   uf = function(x) 0.5 * x[1] + 0.9 * (1 / 3 * log(x[2]) + 2 / 3 * log(x[3]))
#' )
#'
#' ge$p
#'
#' #### an example of Sharpe (2008, chapter 2, case 1)
#' asset1 <- c(1, 0, 0, 0, 0)
#' asset2 <- c(0, 1, 1, 1, 1)
#' asset3 <- c(0, 5, 3, 8, 4) - 3 * asset2
#' asset4 <- c(0, 3, 5, 4, 8) - 3 * asset2
#' # unit asset payoff matrix
#' UAP <- cbind(asset1, asset2, asset3, asset4)
#'
#' prob <- c(0.15, 0.25, 0.25, 0.35)
#' wt <- prop.table(c(1, 0.96 * prob)) # weights
#'
#' geSharpe1 <- gemAssetPricing_CUF(
#'   S = matrix(c(
#'     49, 49,
#'     30, 30,
#'     10, 0,
#'     0, 10
#'   ), 4, 2, TRUE),
#'   UAP = UAP,
#'   uf = list(
#'     function(x) CES(alpha = 1, beta = wt, x = x, es = 1 / 1.5),
#'     function(x) CES(alpha = 1, beta = wt, x = x, es = 1 / 2.5)
#'   )
#' )
#' geSharpe1$p
#' geSharpe1$p[3:4] + 3 * geSharpe1$p[2]
#'
#' ## an example of Sharpe (2008, chapter 3, case 2)
#' geSharpe2 <- gemAssetPricing_CUF(
#'   S = matrix(c(
#'     49, 49, 98, 98,
#'     30, 30, 60, 60,
#'     10, 0, 20, 0,
#'     0, 10, 0, 20
#'   ), 4, 4, TRUE),
#'   UAP = UAP,
#'   uf = list(
#'     function(x) CES(alpha = 1, beta = wt, x = x, es = 1 / 1.5),
#'     function(x) CES(alpha = 1, beta = wt, x = x, es = 1 / 2.5),
#'     function(x) CES(alpha = 1, beta = wt, x = x, es = 1 / 1.5),
#'     function(x) CES(alpha = 1, beta = wt, x = x, es = 1 / 2.5)
#'   )
#' )
#'
#' geSharpe2$p
#' geSharpe2$p[3:4] + 3 * geSharpe2$p[2]
#' geSharpe2$D
#'
#' ## an example of Sharpe (2008, chapter 3, case 3)
#' geSharpe3 <- gemAssetPricing_CUF(UAP,
#'   uf = function(x) (x - x^2 / 400) %*% wt,
#'   S = matrix(c(
#'     49, 98,
#'     30, 60,
#'     5, 10,
#'     5, 10
#'   ), 4, 2, TRUE)
#' )
#' geSharpe3$p
#' geSharpe3$p[3:4] + 3 * geSharpe3$p[2]
#'
#' # the same as above
#' geSharpe3b <- gemAssetPricing_CUF(
#'   S = matrix(c(
#'     49, 98,
#'     30, 60,
#'     5, 10,
#'     5, 10
#'   ), 4, 2, TRUE),
#'   UAP = UAP,
#'   muf = function(x) (1 - x / 200) * wt
#' )
#'
#' geSharpe3b$p
#' geSharpe3b$p[3:4] + 3 * geSharpe3b$p[2]
#'
#' ## an example of Sharpe (2008, chapter 3, case 4)
#' geSharpe4 <- gemAssetPricing_CUF(
#'   S = matrix(c(
#'     49, 98,
#'     30, 60,
#'     5, 10,
#'     5, 10
#'   ), 4, 2, TRUE),
#'   UAP,
#'   muf = function(x) abs((x - 20)^(-1)) * wt,
#'   maxIteration = 100,
#'   numberOfPeriods = 300,
#'   ts = TRUE
#' )
#'
#' geSharpe4$p
#' geSharpe4$p[3:4] + 3 * geSharpe4$p[2]
#'
#' ## an example of Sharpe (2008, chapter 6, case 14)
#' prob1 <- c(0.15, 0.26, 0.31, 0.28)
#' wt1 <- prop.table(c(1, 0.96 * prob1))
#' prob2 <- c(0.08, 0.23, 0.28, 0.41)
#' wt2 <- prop.table(c(1, 0.96 * prob2))
#'
#' uf1 <- function(x) CES(alpha = 1, beta = wt1, x = x, es = 1 / 1.5)
#' uf2 <- function(x) CES(alpha = 1, beta = wt2, x = x, es = 1 / 2.5)
#' geSharpe14 <- gemAssetPricing_CUF(
#'   S = matrix(c(
#'     49, 49,
#'     30, 30,
#'     10, 0,
#'     0, 10
#'   ), 4, 2, TRUE),
#'   UAP = UAP,
#'   uf = list(uf1,uf2)
#' )
#'
#' geSharpe14$D
#' geSharpe14$p
#' geSharpe14$p[3:4] + 3 * geSharpe14$p[2]
#' mu <- marginal_utility(geSharpe14$Payoff, diag(5),uf=list(uf1,uf2))
#' mu[,1]/mu[1,1]
#' mu[,2]/mu[1,2]
#'
#' #### an example of Wang (2006, example 10.1, P146)
#' geWang <- gemAssetPricing_CUF(
#'   S = matrix(c(
#'     1, 0,
#'     0, 2,
#'     0, 1
#'   ), 3, 2, TRUE),
#'   muf = list(
#'     function(x) 1 / x * c(0.5, 0.25, 0.25),
#'     function(x) 1 / sqrt(x) * c(0.5, 0.25, 0.25)
#'   )
#' )
#'
#' geWang$p # c(1, (1 + sqrt(17)) / 16)
#'
#' # the same as above
#' geWang.b <- gemAssetPricing_CUF(
#'   S = matrix(c(
#'     1, 0,
#'     0, 2,
#'     0, 1
#'   ), 3, 2, TRUE),
#'   uf = list(
#'     function(x) log(x) %*% c(0.5, 0.25, 0.25),
#'     function(x) 2 * sqrt(x) %*% c(0.5, 0.25, 0.25)
#'   )
#' )
#'
#' geWang.b$p
#'
#' #### an example of Xu (2018, section 10.4, P151)
#' wt <- c(1, 0.5, 0.5)
#' ge <- gemAssetPricing_CUF(
#'   S = matrix(c(
#'     1, 0,
#'     0, 0.5,
#'     0, 2
#'   ), 3, 2, TRUE),
#'   uf = list(
#'     function(x) CRRA(x, gamma = 1, prob = wt)$u,
#'     function(x) CRRA(x, gamma = 0.5, prob = wt)$u
#'   )
#' )
#'
#' ge$p # c(1, (1 + sqrt(5)) / 4, (1 + sqrt(17)) / 16)
#'
#' #### an example of incomplete market
#' ge <- gemAssetPricing_CUF(
#'   UAP = cbind(c(1, 1), c(2, 1)),
#'   uf = list(
#'     function(x) sum(log(x)) / 2,
#'     function(x) sum(sqrt(x))
#'   ),
#'   ratio_adjust_coef = 0.1,
#'   priceAdjustmentVelocity = 0.05,
#'   policy = makePolicyMeanValue(span = 100),
#'   maxIteration = 1,
#'   numberOfPeriods = 2000,
#' )
#'
#' ge$p
#'
#' ## the same as above
#' ge.b <- gemAssetPricing_CUF(
#'   UAP = cbind(c(1, 1), c(2, 1)),
#'   muf = list(
#'     function(x) 1 / x * c(0.5, 0.5),
#'     function(x) 1 / sqrt(x) * c(0.5, 0.5)
#'   ),
#'   ratio_adjust_coef = 0.1,
#'   priceAdjustmentVelocity = 0.05,
#'   policy = makePolicyMeanValue(span = 100),
#'   maxIteration = 1,
#'   numberOfPeriods = 2000,
#'   ts = TRUE
#' )
#'
#' ge.b$p
#' matplot(ge.b$ts.p, type = "l")
#'
#' #### an example with outside position.
#' asset1 <- c(1, 0, 0)
#' asset2 <- c(0, 1, 1)
#'
#' # unit (asset) payoff matrix
#' UAP <- cbind(asset1, asset2)
#' wt <- c(0.5, 0.25, 0.25) # weights
#'
#' uf1 <- function(x) prod((x + c(0, 0, 2))^wt)
#' uf2 <- function(x) prod(x^wt)
#'
#' ge <- gemAssetPricing_CUF(
#'   S = matrix(c(
#'     1, 1,
#'     0, 2
#'   ), 2, 2, TRUE),
#'   UAP = UAP,
#'   uf = list(uf1, uf2),
#'   numeraire = 1
#' )
#'
#' ge$p
#' ge$z
#' uf1(ge$Payoff[,1])
#' uf2(ge$Payoff[,2])
#' }
#'
gemAssetPricing_CUF <- function(S = diag(2), UAP = diag(nrow(S)),
                               uf = NULL,
                               muf = NULL,
                               ratio_adjust_coef = 0.05,
                               numeraire = 1,
                               ...) {
  n <- nrow(S)
  m <- ncol(S)

  ge <- sdm2(
    A = function(state) {
      Payoff <- UAP %*% (state$last.A %*% dg(state$last.z))

      if (is.null(muf)) {
        VMU <- marginal_utility(Payoff, UAP, uf, price = state$p)
      } else {
        VMU <- marginal_utility(Payoff, UAP, price = state$p, muf = muf)
      }

      VMU <- pmax(VMU, 1e-10)

      Ratio <- sweep(VMU, 2, colMeans(VMU), "/")

      A <- state$last.A * ratio_adjust(Ratio, coef = ratio_adjust_coef, method = "linear")

      A <- prop.table(A, 2)
    },
    B = matrix(0, n, m),
    S0Exg = S,
    names.commodity = paste0("asset", 1:n),
    names.agent = paste0("agt", 1:m),
    numeraire = numeraire,
    ...
  )

  ge$Payoff <- UAP %*% ge$D
  ge$VMU <- marginal_utility(ge$Payoff, UAP, uf = uf, price = ge$p, muf = muf)

  ge
}