examples.rel.spe = function() {
e = e.seq = seq(0,1, by=0.01); xL=0; xH=1;
g = rel_game("Vulnerability Paradox") %>%
rel_param(delta=0.2, rho=0, c=0.5, xL=xL,xH=xH) %>%
# Initial State
rel_state("xL", A1=list(move=c("stay","vul")),A2=list(e=e.seq)) %>%
rel_payoff("xL",pi1=~e, pi2=~ -c*e*e*(e>=0)) %>%
#rel_transition("xL","xH",move="vul") %>%
# High vulnerability
rel_state("xH", A1=NULL,A2=list(e=unique(c(-xH,e.seq)))) %>%
rel_payoff("xH",pi1=~e, pi2=~ -c*e*e*(e>=0)) %>%
rel_compile()
g = rel_spe(g)
(spe = g$eq)
plot_eq_payoff_set(g,x=c("xH","xL"), alpha=0.8)
plot_eq_payoff_set(g,x=c("xL"), alpha=0.8)
g = rel_game("Two-State PD") %>%
rel_param(delta=0.99, rho=0) %>%
# Initial State
rel_state("x1", A1=c("C1","D1"),A2=c("D2","C2"),
pi1=~0.8*((a1=="C1")+(a2=="C2"))-(a1=="C1"),
pi2=~0.8*((a1=="C1")+(a2=="C2"))-(a2=="C2")
) %>%
rel_transition("x1","x2",a1="C1", a2="C2") %>%
# High vulnerability
rel_state("x2", A1=c("C1","D1"),A2=c("D2","C2"),
pi1=~0.6*((a1=="C1")+(a2=="C2"))-(a1=="C1"),
pi2=~0.6*((a1=="C1")+(a2=="C2"))-(a2=="C2")
) %>%
rel_compile()
g = rel_spe(g)
(spe = g$eq)
plot_eq_payoff_set(g,x=c("x1","x2"))
g = rel_rne(g)
(rne = g$eq)
# solve game with transfers
}
# Solve for the set of SPE payoffs in every state and for optimal simple equilibria using the dyngame package.
#
# This function is just an interface to the dyngame package.
rel_spe_classic = function(g, delta=g$param$delta,new.dyngame=FALSE, verbose=FALSE, plots=FALSE) {
restore.point("rel_spe_classic")
g$param$delta = delta
if (!g$is_compiled) g = rel_compile(g)
# We only have repeated games
if (all(g$sdf$is_terminal)) {
for (row in seq_len(NROW(g$sdf))) {
if (is.null(g$sdf$rep[[row]])) {
g$sdf$rep[[row]] = solve.x.repgame(g,row=row)
}
}
g$eq = rep.games.to.rne.df(g)
return(g)
}
if (is.null(g[["dyngame"]]) | new.dyngame)
g$dyngame = make.rel.dyngame(g)
g$dyngame.sol = solve.game(g$dyngame,delta=delta, plots = plots, verbose = verbose)
g$eq = dyngame.sol.to.rel.sol(g)
cat("\n")
g
}
rep.games.to.rne.df = function(g, delta=g$param$delta, rho=g$param$rho, rows=which(g$sdf$is_terminal)) {
restore.point("rep.games.to.rne.df")
adj_delta = delta*(1-rho)
sdf = g$sdf
li = lapply(rows, function(row) {
rep = sdf$rep[[row]] %>%
filter(round(adj_delta,15) >= round(delta_min,15), round(adj_delta,15) < round(delta_max,15)) %>%
#filter(adj_delta >= delta_min, adj_delta < delta_max) %>%
select(r1,r2,U,v1=v1_rep,v2=v2_rep,ae,a1,a2)
})
res = bind_rows(li)
res = cbind(quick_df(x = g$sdf$x[rows]), res)
if (rho >0) {
w = ((1-delta) / (1-adj_delta))
res$v1 = w*res$v1 + (1-w)*res$r1
res$v2 = w*res$v2 + (1-w)*res$r2
}
res = add.rne.action.labels(g,res)
res
}
dyngame.sol.to.rel.sol = function(g,sol=g$dyngame.sol, m=g$dyngame, add.labels=TRUE) {
restore.point("dyngame.sol.to.rel.sol")
res = as_tibble(sol$sol.mat)
ax.to.rel.a = function(m,ax) {
xa = v.ind.to.rowcol(m$ind.ax.by.x, ax)[,2]
}
res$ae = ax.to.rel.a(m,res$ae)
res$a1 = ax.to.rel.a(m,res$a1)
res$a2 = ax.to.rel.a(m,res$a2)
res$x = g$sdf$x[res$x]
res$r1 = res$v1 + g$param$beta1*(res$U-res$v1-res$v2)
res$r2 = res$U - res$r1
res = res[, c("x","r1","r2","U","v1","v2","ae","a1","a2")]
if (add.labels) {
for (row in seq_len(NROW(res))) {
res$ae.lab = left_join(select(res,x,a=ae), g$a.labs.df, by=c("x","a"))$lab
res$a1.lab = left_join(select(res,x,a=a1), g$a.labs.df, by=c("x","a"))$lab
res$a2.lab = left_join(select(res,x,a=a2), g$a.labs.df, by=c("x","a"))$lab
}
}
res
}
make.rel.dyngame = function(g, symmetric=FALSE) {
restore.point("make.rel.dyngame")
library(dyngame)
if (!g$is_compiled) stop("Please first compile g by calling rel_compile.")
sdf = g$sdf
g$pi.df = bind_rows(lapply(1:NROW(sdf), function(row) {
cbind(
quick_df(xv=row, a=1:NROW(sdf$pi1[[row]])),
expand.grid(av2=1:sdf$na2[[row]],av1=1:sdf$na1[[row]]),
pi1=sdf$pi1[[row]], pi2=sdf$pi2[[row]]
)
}))
# xv will be the row number of the state
act.fun = function(xv,...) {
restore.point("act.fun")
#cat("\n xv=",xv)
na1 = sdf$na1[xv]; na2 =sdf$na2[xv]
list(
val = list(a1=1:na1, a2=1:na2),
lab = 1:(na1*na2),
i = 1:2
)
}
# Payoff function. Must be vectorized over avm, xvm
g.fun = function(avm,xvm,...) {
restore.point("g.fun");
df = quick_df(xv=xvm[,1], av1=avm[,1],av2=avm[,2])
rows = match.by.cols(df, g$pi.df, cols=c("xv","av1","av2"))
cbind(g$pi.df[rows,"pi1"],g$pi.df[rows,"pi2"])
}
xd.cols = 1:NROW(sdf)
names(xd.cols) = as.character(sdf$x)
# State transitions
# For a matrix of action profiles and states specifies
# the matrix of state transitions
# Will be called separetly for each x.group
tau.fun = function(avm,xvm,m=NULL) {
restore.point("tau.fun")
rownames(avm)=rownames(xvm)=NULL
row = xvm[1]
trans.mat = sdf$trans.mat[[ row ]]
tau = matrix(0,NROW(avm),NROW(g$sdf))
if (NROW(trans.mat)==0) {
tau[,row] = 1
} else {
dest = xd.cols[colnames(trans.mat)]
tau[,dest] = trans.mat
}
tau
}
# States can be grouped into sets of states with same
# action sets to speed up computation.
# In our game each state has a different action set
x.group = function(xvm,...) {
1:NROW(xvm)
}
# return required information for the dynamic game
game = list(
n=2,
delta=g$param$delta,
xv.val = list(1:NROW(sdf)), # states
act.fun=act.fun,
g.fun=g.fun,
tau.fun=tau.fun,
x.group=x.group
)
m = dyngame::init.game(game, no.labels = TRUE,symmetric = symmetric)
m
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.