# \donttest{
# a function to find the optimal saving rate given the expected gross rates of return.
osr <- function(Ra, Rb, es = 0.5, beta = c(0.5, 0.25, 0.25)) {
sigma <- 1 - 1 / es
((beta[2] * Ra^sigma / beta[1] + beta[3] * Rb^sigma / beta[1])^-es + 1)^-1
}
dst.firm <- node_new(
"prod",
type = "Leontief", a = 0.2,
"lab"
)
dst.age1 <-
node_new("util",
type = "FIN", rate = c(1, 1),
"prod", "secy",
last.price = c(1, 1, 1),
last.output = 10,
Raa = 1, Rbb = 1, Rab = 1, Rba = 1,
REbb = 1, REba = 1, REab = 1, REaa = 1,
sr.ts.1 = vector(),
sr.ts.2 = vector()
)
dst.age2 <-
node_new("util",
type = "Leontief", a = 1,
"prod"
)
policyStochasticTechnology <- function(time, A) {
A[[1]]$a <- sample(c(0.1, 0.2), 1)
}
policySaving <- function(time, A, state) {
output <- state$S[1, 1]
lambda <- 0.9
if (output < 8) {
A[[2]]$REba <- lambda * tail(A[[2]]$Rba, 1) + (1 - lambda) * A[[2]]$REba
A[[2]]$REbb <- lambda * tail(A[[2]]$Rbb, 1) + (1 - lambda) * A[[2]]$REbb
saving.rate <- osr(A[[2]]$REba, A[[2]]$REbb)
A[[2]]$sr.ts.1 <- c(A[[2]]$sr.ts.1, saving.rate)
}
if (output >= 8) {
A[[2]]$REaa <- lambda * tail(A[[2]]$Raa, 1) + (1 - lambda) * A[[2]]$REaa
A[[2]]$REab <- lambda * tail(A[[2]]$Rab, 1) + (1 - lambda) * A[[2]]$REab
saving.rate <- osr(A[[2]]$REaa, A[[2]]$REab)
A[[2]]$sr.ts.2 <- c(A[[2]]$sr.ts.2, saving.rate)
}
A[[2]]$rate <- c(1, saving.rate / (1 - saving.rate))
}
policyRecord <- function(time, A, state) {
last.p <- A[[2]]$last.price
p <- state$p / state$p[1]
last.output <- A[[2]]$last.output
output <- A[[2]]$last.output <- state$S[1, 1]
if ((last.output < 8) && (output < 8)) A[[2]]$Rbb <- c(A[[2]]$Rbb, p[3] / last.p[3])
if ((last.output < 8) && (output >= 8)) A[[2]]$Rba <- c(A[[2]]$Rba, p[3] / last.p[3])
if ((last.output >= 8) && (output < 8)) A[[2]]$Rab <- c(A[[2]]$Rab, p[3] / last.p[3])
if ((last.output >= 8) && (output >= 8)) A[[2]]$Raa <- c(A[[2]]$Raa, p[3] / last.p[3])
A[[2]]$last.price <- p
}
dstl <- list(dst.firm, dst.age1, dst.age2)
B <- matrix(c(
1, 0, 0,
0, 0, 0,
0, 0, 0
), 3, 3, TRUE)
S0Exg <- matrix(c(
NA, NA, NA,
NA, 1, NA,
NA, NA, 1
), 3, 3, TRUE)
## a spot equilibrium path.
set.seed(1)
ge <- sdm2(
A = dstl, B = B, S0Exg = S0Exg,
names.commodity = c("prod", "lab", "secy"),
names.agent = c("firm", "age1", "age2"),
numeraire = "prod",
policy = list(
policyStochasticTechnology,
policySaving,
policyMarketClearingPrice,
policyRecord
),
z0 = c(5, 1, 1),
maxIteration = 1,
numberOfPeriods = 40,
ts = TRUE
)
matplot(ge$ts.z, type = "o", pch = 20)
matplot(ge$ts.p, type = "o", pch = 20)
## a disequilibrium path.
set.seed(1)
de <- sdm2(
A = dstl, B = B, S0Exg = S0Exg,
names.commodity = c("prod", "lab", "secy"),
names.agent = c("firm", "age1", "age2"),
numeraire = "prod",
policy = list(
policyStochasticTechnology,
policySaving,
policyRecord
),
maxIteration = 1,
numberOfPeriods = 400,
ts = TRUE
)
matplot(de$ts.z, type = "o", pch = 20)
matplot(de$ts.p, type = "o", pch = 20)
## an equilibrium model for solving the optimal saving
# rate based on the expected gross rates of return.
Ra <- 1
Rb <- 0.4
ge <- sdm2(
A = function(state) {
a.bank <- c(1, 0, 0)
a.consumer <- CES_A(
sigma = (1 - 1 / 0.5), alpha = 1,
Beta = c(0.5, 0.25, 0.25), p = state$p
)
cbind(a.bank, a.consumer)
},
B = matrix(c(
0, 0,
Ra, 0,
Rb, 0
), 3, 2, TRUE),
S0Exg = matrix(c(
NA, 1,
NA, 0,
NA, 0
), 3, 2, TRUE),
names.commodity = c("payoff1", "payoff2", "payoff3"),
names.agent = c("bank", "consumer"),
numeraire = "payoff1",
)
ge$p
addmargins(ge$D, 2)
addmargins(ge$S, 2)
ge$z[1]
osr(Ra, Rb)
## a pure exchange model.
dst.age1 <- node_new("util",
type = "FIN", rate = c(1, 1),
"payoff", "secy",
last.price = c(1, 1),
last.payoff = 1,
Rbb = 1, Rba = 1, Rab = 1, Raa = 1,
REbb = 1, REba = 1, REab = 1, REaa = 1,
sr.ts.1 = vector(),
sr.ts.2 = vector()
)
dst.age2 <- node_new("util",
type = "Leontief", a = 1,
"payoff"
)
policyStochasticSupply <- function(state) {
state$S[1, 1] <- sample(c(5, 10), 1)
state
}
policySaving <- function(time, A, state) {
payoff <- state$S[1, 1]
lambda <- 0.9
if (time >= 5) {
if (payoff == 5) {
A[[1]]$REba <- lambda * tail(A[[1]]$Rba, 1) + (1 - lambda) * A[[1]]$REba
A[[1]]$REbb <- lambda * tail(A[[1]]$Rbb, 1) + (1 - lambda) * A[[1]]$REbb
saving.rate <- osr(A[[1]]$REba, A[[1]]$REbb)
A[[1]]$sr.ts.1 <- c(A[[1]]$sr.ts.1, saving.rate)
}
if (payoff == 10) {
A[[1]]$REaa <- lambda * tail(A[[1]]$Raa, 1) + (1 - lambda) * A[[1]]$REaa
A[[1]]$REab <- lambda * tail(A[[1]]$Rab, 1) + (1 - lambda) * A[[1]]$REab
saving.rate <- osr(A[[1]]$REaa, A[[1]]$REab)
A[[1]]$sr.ts.2 <- c(A[[1]]$sr.ts.2, saving.rate)
}
A[[1]]$rate <- c(1, saving.rate / (1 - saving.rate))
}
}
policyRecord <- function(time, A, state) {
last.p <- A[[1]]$last.price
p <- state$p / state$p[1]
last.payoff <- A[[1]]$last.payoff
payoff <- state$S[1, 1]
if ((last.payoff == 5) && (payoff == 5)) A[[1]]$Rbb <- c(A[[1]]$Rbb, p[2] / last.p[2])
if ((last.payoff == 5) && (payoff == 10)) A[[1]]$Rba <- c(A[[1]]$Rba, p[2] / last.p[2])
if ((last.payoff == 10) && (payoff == 5)) A[[1]]$Rab <- c(A[[1]]$Rab, p[2] / last.p[2])
if ((last.payoff == 10) && (payoff == 10)) A[[1]]$Raa <- c(A[[1]]$Raa, p[2] / last.p[2])
A[[1]]$last.price <- p
A[[1]]$last.payoff <- state$S[1, 1]
}
set.seed(1)
ge <- sdm2(
A = list(dst.age1, dst.age2),
B = matrix(0, 2, 2),
S0Exg = matrix(c(
1, NA,
NA, 1
), 2, 2, TRUE),
names.commodity = c("payoff", "secy"),
names.agent = c("age1", "age2"),
numeraire = "payoff",
policy = list(
policyStochasticSupply,
policySaving,
policyMarketClearingPrice,
policyRecord
),
maxIteration = 1,
numberOfPeriods = 40,
ts = TRUE
)
matplot(ge$ts.z, type = "o", pch = 20)
matplot(ge$ts.p, type = "o", pch = 20)
dst.age1$last.payoff
dst.age1$last.price
dst.age1$Rbb
# }
Run the code above in your browser using DataLab