# \donttest{
#### an example of Danthine and Donaldson (2005, section 8.3).
uf <- function(x) 0.5 * x[1] + 0.9 * (1 / 3 * log(x[2]) + 2 / 3 * log(x[3]))
ge <- sdm2(
A = function(state) {
VMU <- marginal_utility(state$last.A %*% dg(state$last.z), diag(3), uf, state$p)
Ratio <- sweep(VMU, 2, colMeans(VMU), "/")
A <- state$last.A * Ratio
prop.table(A, 2)
},
B = matrix(0, 3, 2),
S0Exg = matrix(c(
10, 5,
1, 4,
2, 6
), 3, 2, TRUE),
names.commodity = c("secy1", "secy2", "secy3"),
names.agent = c("agt1", "agt2"),
numeraire = "secy1",
ts = TRUE
)
ge$p
#### an example of Sharpe (2008, chapter 2)
secy1 <- c(1, 0, 0, 0, 0)
secy2 <- c(0, 1, 1, 1, 1)
secy3 <- c(0, 5, 3, 8, 4) - 3 * secy2
secy4 <- c(0, 3, 5, 4, 8) - 3 * secy2
# unit (security) payoff matrix
UP <- cbind(secy1, secy2, secy3, secy4)
prob <- c(0.15, 0.25, 0.25, 0.35)
wt <- prop.table(c(1, 0.96 * prob)) # weights
gamma.agt1 <- 1.5
gamma.agt2 <- 2.5
ge <- sdm2(
A = function(state) {
Payoff <- UP %*% (state$last.A %*% dg(state$last.z))
VMU <- marginal_utility(Payoff, UP, list(
function(x) CES(alpha = 1, beta = wt, x = x, es = 1 / gamma.agt1),
function(x) CES(alpha = 1, beta = wt, x = x, es = 1 / gamma.agt2)
), price = state$p)
Ratio <- sweep(VMU, 2, colMeans(VMU), "/")
A <- state$last.A * ratio_adjust(Ratio, coef = 0.05, method = "linear")
A <- prop.table(A, 2)
},
B = matrix(0, 4, 2),
S0Exg = matrix(c(
49, 49,
30, 30,
10, 0,
0, 10
), 4, 2, TRUE),
names.commodity = c("secy1", "secy2", "secy3", "secy4"),
names.agent = c("agt1", "agt2"),
numeraire = "secy1"
)
ge$p
ge$p[3:4] + 3 * ge$p[2]
#### an example of Xu (2018, section 10.4, P151)
secy1 <- c(1, 0, 0)
secy2 <- c(0, 1, 0)
secy3 <- c(0, 0, 1)
prob <- c(0.5, 0.5)
wt <- c(1, prob)
UP <- cbind(secy1, secy2, secy3)
gamma.agt1 <- 1
gamma.agt2 <- 0.5
ge <- sdm2(
A = function(state) {
Payoff <- UP %*% (state$last.A %*% dg(state$last.z))
VMU <- marginal_utility(Payoff, UP, list(
# Here CRRA(...)$u, CRRA(...)$CE and CES functions are interexchangeable.
function(x) CRRA(x, gamma = gamma.agt1, p = wt)$u,
function(x) CES(alpha = 1, beta = wt, x = x, es = 1 / gamma.agt2)
), state$p)
Ratio <- sweep(VMU, 2, colMeans(VMU), "/")
A <- state$last.A * Ratio
prop.table(A, 2)
},
B = matrix(0, 3, 2),
S0Exg = matrix(c(
1, 0,
0, 0.5,
0, 2
), 3, 2, TRUE),
names.commodity = c("secy1", "secy2", "secy3"),
names.agent = c("agt1", "agt2"),
numeraire = "secy1",
maxIteration = 1,
ts = TRUE
)
ge$p #c(1, (1 + sqrt(5)) / 4, (1 + sqrt(17)) / 16)
## the same as above.
dst.agt1 <- node_new("util",
type = "CD", alpha = 1, beta = c(0.5, 0.25, 0.25),
"secy1", "secy2", "secy3"
)
dst.agt2 <- node_new("util",
type = "CES", alpha = 1, beta = c(2, 1, 1), sigma = 0.5,
"secy1", "secy2", "secy3"
)
ge <- sdm2(
A = list(dst.agt1, dst.agt2),
B = matrix(0, 3, 2),
S0Exg = matrix(c(
1, 0,
0, 0.5,
0, 2
), 3, 2, TRUE),
names.commodity = c("secy1", "secy2", "secy3"),
names.agent = c("agt1", "agt2"),
numeraire = "secy1",
maxIteration = 1,
ts = TRUE
)
ge$p
#### an example with production.
asset1 <- c(1, 0, 0, 0, 0, 0)
asset2 <- c(0, 1, 0, 0, 0, 0)
asset3 <- c(0, 0, 1, 3, 1, 2)
asset4 <- c(0, 0, 4, 2, 6, 2)
asset5 <- c(0, 0, 1, 0, 2, 0)
# unit (asset) payoff matrix
UP <- cbind(asset1, asset2, asset3, asset4, asset5)
muf1 <- function(x) 1 / x
muf2 <- function(x) 1 / x * c(0.4, 0.1, 0.2, 0.05, 0.2, 0.05)
ge <- sdm2(
A = function(state) {
Payoff <- UP %*% (state$last.A[, 1:2] %*% dg(state$last.z[1:2]))
VMU <- marginal_utility(Payoff, UP, muf = list(muf1, muf2), price = state$p)
Ratio <- sweep(VMU, 2, colMeans(VMU), "/")
A <- state$last.A[, 1:2] * ratio_adjust(Ratio, coef = 0.15, method = "linear")
A <- prop.table(A, 2)
a.firm <- CD_A(alpha = 4, Beta = c(0.5, 0.5, 0, 0, 0), state$p)
A <- cbind(A, a.firm)
},
B = matrix(c(
0, 0, 0,
0, 0, 0,
0, 0, 0,
0, 0, 0,
0, 0, 1
), 5, 3, TRUE),
S0Exg = matrix(c(
1, 1, NA,
1, 2, NA,
1, NA, NA,
NA, 1, NA,
NA, NA, NA
), 5, 3, TRUE),
names.commodity = c("asset1", "asset2", "asset3", "asset4", "asset5"),
names.agent = c("consumer1", "consumer2", "firm"),
numeraire = "asset1"
)
ge$p
ge$z
#### an example with demand structure trees.
asset1 <- c(1, 0, 0, 0, 0)
asset2 <- c(0, 1, 3, 1, 2)
asset3 <- c(0, 2, 1, 3, 1)
# unit payoff matrix
UP <- cbind(asset1, asset2, asset3)
dst.consumer1 <- node_new("util",
type = "CES", es = 0.5, alpha = 1, beta = c(0.5, 0.5),
"x1", "u2"
)
node_set(dst.consumer1, "u2",
type = "CES", es = 0.8, alpha = 1, beta = c(0.6, 0.4),
"u2.1", "u2.2"
)
node_set(dst.consumer1, "u2.1",
type = "CES", es = 1, alpha = 1, beta = c(0.8, 0.2),
"x2", "x3"
)
node_set(dst.consumer1, "u2.2",
type = "CES", es = 1, alpha = 1, beta = c(0.8, 0.2),
"x4", "x5"
)
dst.consumer2 <- node_new("util",
type = "CES", es = 0.5, alpha = 1, beta = c(0.5, 0.5),
"x1", "u2"
)
node_set(dst.consumer2, "u2",
type = "CES", es = 0.8, alpha = 1, beta = c(0.6, 0.4),
"u2.1", "u2.2"
)
node_set(dst.consumer2, "u2.1",
type = "CES", es = 1, alpha = 1, beta = c(0.2, 0.8),
"x2", "x3"
)
node_set(dst.consumer2, "u2.2",
type = "CES", es = 1, alpha = 1, beta = c(0.2, 0.8),
"x4", "x5"
)
uf1 <- function(x) {
names(x) <- paste0("x", seq_along(x))
output(dst.consumer1, x)
}
uf2 <- function(x) {
names(x) <- paste0("x", seq_along(x))
output(dst.consumer2, x)
}
ge <- gemSecurityPricing(
S = matrix(c(
3, 3,
1, 0,
0, 2
), 3, 2, TRUE),
UP = UP,
uf = list(uf1, uf2)
)
ge$p
ge$z
# }
Run the code above in your browser using DataLab