# The code inside can be used to explore the behavior of strategies for the research agreement game
examples.research.agreement.game = function() {
#Load package
library(StratTourn)
# Generate a game object
game = make.research.agreement.game(lower.bound=1, upper.bound=5, multiplier=1.3, delta=0.9)
# Pick a pair of strategies
strat = nlist(most.of.it,give.generously)
# Let the strategies play against each other
run.rep.game(game=game, strat = strat)
getwd()
# Set working directory in which data is stored
#setwd("D:/libraries/StratTourn/studies")
setwd("E:/!Data/!Daten/Work/Promotion/L - Lectures/Kooperation Spieltheorie/WS 2015-16/StratTourn/studies")
# Init and run a tournament of several strategies against each other
strat = nlist(most.of.it,give.generously.1, give.generously)
tourn = init.tournament(game=game, strat=strat)
set.storing(FALSE) # uncoment to make code run faster
tourn = run.tournament(tourn=tourn, R = 1000)
set.storing(TRUE)
tourn
save.tournament(tourn)
# Analyse tournament in web browser
show.tournament(tourn)
}
#'Example strategy: most.of.it
#'
#' An example strategy that always shares n-1 of its know-how in the research agreement game
#'
#' @param obs Observations of current know how and share of previous round as specified in the function make.bargaining.game
#' @param i Number of current player
#' @param t Current period
most.of.it = function(obs,i,t,...) {
# Extract variables from obs
know.how = obs$know.how #How much know-how have I recieved this period?
j = 3-i #Whats the number of the other player?
obs.sj = obs$s[j] #How much has the other player shared last round?
obs.si = obs$s[i] #How much have I shared last round?
share = max(0,know.how-1)
return(list(s=share))
}
#'Example strategy: give.generously (more=2)
#'
#' Strategy which shares (in the research agreement game) as much as the other firm + more, if possible; in the first period everything
#'
#' @param obs Observations of current know how and share of previous round as specified in the function make.bargaining.game
#' @param i Number of current player
#' @param t Current period
#' @param more How much know how should be given in addition to the shared know how of the other firm in the last period?
give.generously = function(obs,i,t,more=2,...) {
# Extract variables from obs
know.how = obs$know.how #How much know-how have I recieved this period?
j = 3-i #Whats the number of the other player?
obs.sj = obs$s[j] #How much has the other player shared last round?
obs.si = obs$s[i] #How much have I shared last round?
if(t==1){
share = know.how
} else {
share = min(obs.sj+more,know.how)
}
return(list(s=share, more=more))
}
#'Example strategy: give.generously.1 (more=1)
#'
#' Strategy which shares (in the research agreement game) as much as the other firm + more, if possible; in the first period everything
#'
#' @param obs Observations of current know how and share of previous round as specified in the function make.bargaining.game
#' @param i Number of current player
#' @param t Current period
#' @param more How much know how should be given in addition to the shared know how of the other firm in the last period?
give.generously.1 = function(obs,i,t,more=1,...) {
# Extract variables from obs
know.how = obs$know.how #How much know-how have I recieved this period?
j = 3-i #Whats the number of the other player?
obs.sj = obs$s[j] #How much has the other player shared last round?
obs.si = obs$s[i] #How much have I shared last round?
if(t==1){
share = know.how
} else {
share = min(obs.sj+more,know.how)
}
return(list(s=share, more=more))
}
#' Waits for Input of Human Player in Research Agreement Game
#'
#'
human.player.ra = function(obs,i,t,...){
restore.point("human.player.ra")
# Extract variables from obs
know.how = obs$know.how #How much know-how have I recieved this period?
j = 3-i #Whats the number of the other player?
obs.sj = obs$s[j] #How much has the other player shared last round?
obs.si = obs$s[i] #How much have I shared last round?
if(t==1){
cat(paste0("Your know.how: ", know.how,"\n",collapse=""))
cat("What share do you want to demand in your first round? Write a number or \"Stop\"")
} else {
cat(paste0("Your know-how: ",know.how,"\nYour share last round: ",obs.si,"\n","Share of other Strategy: ",obs.sj,"\n",collapse=" "))
cat("What do you want to do?")
}
ok <- FALSE
while(!ok){
line <- readline()
if(line[1]=="Stop"){
stop("Player stopped")
} else if(!is.na(as.numeric(line[1]))){
my.action = as.numeric(line[1])
ok <- TRUE
} else {
cat("Not a valid number. Please retry.")
}
}
return(list(s=my.action))
}
#' Generate a research agreement game
#'
#' We consider two firms which generate a random amount of know how each period. Each firm knows how much know how has been generated by itself, but does not know how much know how has been generated by the other firm. In each period they can decide to share a part of their know how with the other firm.
#'
#' @param lower.bound At least this much know how is generated from each firm in each period; Non-negative integer value expected
#' @param upper.bound At most this much know how is generated from each firm in each period; positive integer value expected
#' @param multiplier Non-shared know how is multiplied by this value
#' @param delta Probability of playing another round
make.research.agreement.game = function(lower.bound=1, upper.bound=5, multiplier=1.5, delta=0.9, ...) {
run.stage.game = function(a,t,t.obs,game.states,...) {
restore.point("research.agreement.run.stage.game")
know.hows = game.states$know.hows
#Take and transform shares to allowed values
s = unlist(a, use.names=FALSE)
s <- sapply(1:2,FUN=function(x){
if(s[x]<0){
return(0)
} else if (s[x]>know.hows[x]){
return(know.hows[x])
} else {
return(round(s[x]))
}
})
#Calculation of payoff
payoff <- sapply(1:2,FUN=function(i){
j = 3-i
res <- (know.hows[i]-s[i])*multiplier + s[i] + s[j]
return(res)
})
#Draw new know.how for next round
know.hows <- sample(lower.bound:upper.bound, 2, replace=TRUE)
# private signals: each player sees her cost type
obs = list(list(know.how=know.hows[1], s=s),
list(know.how=know.hows[2], s=s))
round.stats = quick.df(t=c(t,t),i=1:2,know.how=game.states$know.hows,s=s,u=payoff)
return(list(payoff=payoff,obs=obs, round.stats=round.stats, game.states=nlist(know.hows)))
}
check.action = function(ai,i,t,...) {
s = ai$s
if (is.finite(s) & length(s)==1) {
return()
}
stop(paste0("player ",i, "'s strategy in period ",t, " returned an infeasible action: ", ai))
}
example.action = function(i=1,t=1,...) {
list(s=0)
}
example.obs = function(i=1,t=1,game.states,...) {
list(know.how=game.states$know.hows[i], s=c(0,0))
}
initial.game.states = function() {
know.hows <- sample(lower.bound:upper.bound, 2, replace=TRUE)
nlist(know.hows)
}
nlist(run.stage.game, initial.game.states, check.action,example.action,example.obs, n=2, private.signals=TRUE, params = nlist(lower.bound, upper.bound, multiplier), sym=TRUE, delta=delta, name="research.agreement")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.