Instantiate a population of 50 buyers and 50 sellers and run the trading process to equilibrium (i.e., no more trades are possible).Plot a histogram of the prices paid. Draw the actual supply and demand curves for the fixed population, either on graph paper or with software. Next, with exactly the same population (controlled with the random seed), make a different realization of trading process to equilibrium (i.e., different agent pairings). Compare and contrast the two realizations. Next, make 35 more runs with the fixed population you have used so far, permitting the agent pairings to vary from run to run. Summarize the variability in price and quantity statistics over these many runs. Discuss why there is run-to-run variation. Finally, alter the population from run to run and make many runs of the model. Determine how much of the overall variability in outcomes is due to the population changing versus ‘natural’ run-to-run variation.
Here we start by preparing some functions (based on the code given by Randy Casstevens). First we have generate_traders, which can generate a list of Buyers or Sellers.If seller is called with F or FALSE it will generate a buyer (T or TRUE to generate a seller). By default, samePop is F: succesive calls to this function will generate the same values for buyers and the same valuescosts for sellers:
#num: population of buyers/sellers to generate
#max: max value/cost of buyers/sellers
generate_traders <- function(num,seller,max=30,samePop=F) {
if (samePop)
set.seed(123)
if (seller) {#seller
traders=data.frame(cost=(runif(num) * max), # trader cost
traded = F, # trader flag if traded
price = rep(NA,num)) # price accepted by trader
} else { #buyer
traders=data.frame(value=(runif(num) * max),# trader value
traded = F, # trader flag if traded
price = rep(NA,num)) # price accepted by trader
#"traders" is "returned" by default
}
}
Then a couple of functions that will return select the indices of a buyer and a seller and their bid/ask proposed which will be used later to see if a transaction occurs:
# input buyers as a data frame
pickBuyer_AND_generateBidPrice = function(buyers) {
buyerIndex = sample.int(nrow(buyers), size = 1)
bidPrice = buyers$value[buyerIndex] * runif(1)
# Names in return will be used to access values
return(list(buyerIndex = buyerIndex, bidPrice = bidPrice))
}
# input sellers as a data frame
pickSeller_AND_generateAskPrice = function(maxSellerCost, sellers) {
sellerIndex = sample.int(nrow(sellers), size = 1)
askPrice = sellers$cost[sellerIndex] + runif(1) * (maxSellerCost - sellers$cost[sellerIndex])
# Names in return will be used to access values
return(list(sellerIndex = sellerIndex, askPrice = askPrice))
}
And this function doTransaction is in charge of computing the transaction price (paidPrice) and will help us update the lists that are recording the information of every transcaction:
#data frames Bs (buyers) and Ss (sellers) are input
doTransaction = function(B, S, Bs, Ss, # B and S have indices of Bs and Ss
pr, meanPr, dif){ #input lists to be updated
# pr (prices pais)
# meanPr (mean prices paid)
# dif (differences between last 2 prices)
paidPrice = S$askPrice + runif(1) * (B$bidPrice - S$askPrice)
Bs$traded[B$buyerIndex] = Ss$traded[S$sellerIndex] = TRUE
Bs$price[B$buyerIndex] = Ss$price[S$sellerIndex] = paidPrice
pr = c(pr, paidPrice)
transactionsMean = mean(pr)
lastD = 1
if (length(meanPr >= 2)) {
lastD = abs(tail(meanPr,1) - transactionsMean) # useful to exit iteration
dif = c(dif, lastD)
}
meanPr = c(meanPr, transactionsMean)
return(list(buyers = Bs, sellers = Ss, pr = pr, meanPr = meanPr, dif = dif, lastdiff = lastD))
}
Here is function that presents the logic of the problem and integrates the previous fucntions:
run_ZI_traders<- function(buyers, sellers, # input data frames
maxValueOrCost=30, # MaxValue or MaxCost for buyers and sellers
maxNumTrades=10000, # Max number of Trades
eval=F, # If T, iteration may break (see below)
breakParam=-1) { # This will be changed by the median of the minimum
# differences between prices
p = avgP = d = c() # to save prices,mean of prices and difference of last two means
for (counter in 1:maxNumTrades) # Loop for the maximum number of trades
{ B=pickBuyer_AND_generateBidPrice(buyers)
S=pickSeller_AND_generateAskPrice(maxValueOrCost,sellers)
# the buyer and seller meet conditions?
if (!buyers$traded[B$buyerIndex] &&
!sellers$traded[S$sellerIndex] && B$bidPrice > S$askPrice)
{ trading=doTransaction(B,S,buyers,sellers,p,avgP,d)
buyers=trading$buyers ; sellers=trading$sellers
p=trading$pr ; avgP=trading$meanPr ; d=trading$dif
if (eval && trading$lastdiff<breakParam){
break } # exit iteration!
}
}
# Return the results and the buyers and sellers
return(list(transactions=p,
avgTransactionPrice=avgP,
buyers=buyers,
sellers=sellers, diff=d))
}
Firts we will go 100 runs and explore the behavior of the minimum differences between consecutive prices to use its median later as the breakParam in the function run_ZI_traders (DEFAULTS values are being used in the functions (see each function above):
equilibriumHistory = c()
pop_Buyers = 50 #population
pop_Sellers = 50 #population
for (i in 1:100) {
Buyers = generate_traders(pop_Buyers, seller = F) # Creating buyers
Sellers = generate_traders(pop_Sellers, seller = T) # Creating Sellers
ziResults = run_ZI_traders(buyers = Buyers, sellers = Sellers)
equilibriumHistory[i] = min(ziResults$diff) # Saving every minimum difference
}
summary(equilibriumHistory) # basic stats
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.00005 0.00479 0.01170 0.01990 0.02320 0.15300
par(mfrow = c(1, 2)) # visualizing behavior of minimum values
plot(equilibriumHistory, main = "minimum differences among prices paid", type = "b",
col = "dark green", ylab = "minimum difference between prices", xlab = "run")
boxplot(equilibriumHistory, main = "distribution of minimum differences among prices paid",
col = "green", ylab = "minimum difference between prices")
Now we can generate a plot of the prices paid as requested:
bp = median(equilibriumHistory) # our breakParam computed from above
pop_Buyers = 50
pop_Sellers = 50
buyers = generate_traders(pop_Buyers, seller = F, samePop = F)
sellers = generate_traders(pop_Sellers, seller = T, samePop = F)
ziResults = run_ZI_traders(buyers, sellers, eval = T, breakParam = bp)
# VISUALIZING
title = "Supply-Demand, Prices & Averages of prices paid"
cost = sort(ziResults$sellers$cost)
value = sort(ziResults$buyers$value, decreasing = T)
averages = ziResults$avgTransactionPrice
prices = ziResults$transactions
par(mfrow = c(1, 2))
hist(ziResults$transactions, main = c("Distribution of Prices Paid"), col = "green",
xlab = "price paid")
plot(cost, col = c("red"), type = "l", main = title, xlab = "Quantity", ylab = "Price")
lines(value, col = c("blue"))
lines(averages)
lines(prices, col = c("green"), cex = 0.5)
legend(20, 30, c("Supply", "Demand"), lty = c(1, 1), lwd = c(2.5, 2.5), col = c("red",
"blue"))
legend(20, 7, c("Avg. Prices", "Prices"), lty = c(1, 1), lwd = c(2.5, 2.5),
col = c("black", "green"))
priceAvgHistory = c()
tradeCountHist = c() #saving prices and quantities
pop_Buyers = 50
pop_Sellers = 50
buyers = generate_traders(pop_Buyers, seller = F, samePop = T) #T to have the same values
sellers = generate_traders(pop_Sellers, seller = T, samePop = T) #T to have the same costs
constantPop = run_ZI_traders(buyers, sellers, eval = T, breakParam = bp)
tradeCountHist[1] = sum(constantPop$buyers$traded)
priceAvgHistory[1] = mean(constantPop$avgTransactionPrice)
# PLOTS
title = "Experiment with Constant Values and Costs (different pairings)"
cost = sort(constantPop$sellers$cost)
value = sort(constantPop$buyers$value, decreasing = T)
plot(cost, col = c("red"), type = "l", cex = 2, xlab = "Quantity", ylab = "Price",
main = title)
lines(value, col = c("blue"), cex = 2)
for (i in 2:35) {
constantPop$buyers$traded = constantPop$sellers$traded = FALSE #resetting traded field
buyers = constantPop$buyers
sellers = constantPop$sellers
constantPop = run_ZI_traders(buyers, sellers, eval = T, breakParam = bp)
lines(constantPop$avgTransactionPrice, cex = 0.5, col = "gray")
tradeCountHist[i] = sum(constantPop$buyers$traded)
priceAvgHistory[i] = mean(constantPop$avgTransactionPrice)
}
priceAvgHistory2 = c()
tradeCountHist2 = c() #saving prices and quantities
buyers = generate_traders(pop_Buyers, seller = F, samePop = F) #F to have different values
sellers = generate_traders(pop_Sellers, seller = T, samePop = F) #F to have different costs
varyingPop = run_ZI_traders(buyers, sellers, eval = T, breakParam = bp)
# PLOTS
title = "Experiment with Varying Values and Costs (different pairings)"
costs = sort(varyingPop$sellers$cost)
values = sort(varyingPop$buyers$value, decreasing = T)
avgPrice = varyingPop$avgTransactionPrice
plot(costs, type = "l", cex = 0.5, main = title, xlab = "Quantity", ylab = "Price")
lines(values, cex = 0.5)
lines(avgPrice, cex = 0.5)
tradeCountHist2[1] = sum(varyingPop$buyers$traded)
priceAvgHistory2[1] = mean(varyingPop$avgTransactionPrice)
for (i in 2:35) {
cols = rainbow(70)[i]
buyers = generate_traders(pop_Buyers, seller = F, samePop = F)
sellers = generate_traders(pop_Sellers, seller = T, samePop = F)
varyingPop = run_ZI_traders(buyers, sellers, eval = T, breakParam = bp)
costs = sort(varyingPop$sellers$cost)
values = sort(varyingPop$buyers$value, decreasing = T)
avgPrice = varyingPop$avgTransactionPrice
lines(costs, col = cols, type = "l", cex = 0.5)
lines(values, col = cols, cex = 0.5)
lines(avgPrice, cex = 1, col = cols)
tradeCountHist2[i] = sum(varyingPop$buyers$traded)
priceAvgHistory2[i] = mean(varyingPop$avgTransactionPrice)
}
We need to see if both experiments behave differently, for that we will explore the results first:
# Coefficient of variation function
coeVar <- function(x, na.rm = TRUE) round(100 * (sd(x, na.rm = na.rm)/mean(x,
na.rm = na.rm)), 2)
CVtrade1 = coeVar(tradeCountHist)
CVprice1 = coeVar(priceAvgHistory)
CVtrade2 = coeVar(tradeCountHist2)
CVprice2 = coeVar(priceAvgHistory2)
# IQR is the interquartile range
IQRtrade1 = round(IQR(tradeCountHist), 2)
IQRtrade2 = round(IQR(tradeCountHist2), 2)
IQRprice1 = round(IQR(priceAvgHistory), 2)
IQRprice2 = round(IQR(priceAvgHistory2), 2)
# PLOTS
titleTradesCons = "Trades:Constant costs and values"
titlePricesCons = "Prices:Constant costs and values"
titleTradesVar = "Trades:Varying costs and values"
titlePricesVar = "Prices:Varying costs and values"
labelxt = "Number of Trades"
labelxp = "Average Price paid"
par(mfrow = c(4, 2))
hist(tradeCountHist, main = titleTradesCons, col = "gray", xlab = )
text(12, 10, label = paste("CoeVar:", CVtrade1), cex = 1.5)
hist(tradeCountHist2, main = titleTradesVar, col = "gray")
text(12, 10, label = paste("CoeVar:", CVtrade2), cex = 1.5)
boxplot(tradeCountHist, horizontal = T, main = titleTradesCons, col = "gray")
text(25, 1.25, label = paste("IQR: ", IQRtrade1), cex = 1.5)
boxplot(tradeCountHist2, horizontal = T, main = titleTradesVar, col = "gray")
text(25, 1.25, label = paste("IQR: ", IQRtrade2), cex = 1.5)
hist(priceAvgHistory, main = titlePricesCons, col = "green")
text(13, 9, label = paste("CoeVar:", CVprice1), cex = 1.5)
hist(priceAvgHistory2, main = titlePricesVar, col = "green")
text(17, 10, label = paste("CoeVar:", CVprice2), cex = 1.5)
boxplot(priceAvgHistory, horizontal = T, main = titlePricesCons, col = "green")
text(15.5, 1.25, label = paste("IQR: ", IQRprice1), cex = 1.5)
boxplot(priceAvgHistory2, horizontal = T, main = titlePricesVar, col = "green")
text(15, 1.25, label = paste("IQR: ", IQRprice2), cex = 1.5)
From this exploration it may seem that both experiments are are giving different results. However, we need still need to conduct some tests to know if the average behaviors differ.
There are several steps we need to follow, which are described below
To know if two average behaviors differ, the tests to be applied depend on whether the vakues behave normally or not:
shapiro.test(tradeCountHist)$p.value > 0.05
[1] FALSE
shapiro.test(tradeCountHist2)$p.value > 0.05
[1] FALSE
shapiro.test(priceAvgHistory)$p.value > 0.05
[1] TRUE
shapiro.test(priceAvgHistory2)$p.value > 0.05
[1] FALSE
We see that Trades are too skewed, but prices may not. So different tests can be applied.
the data sets need to have a particular shape to apply the statistical tests:
outputTrade = data.frame(tradeCountHist, tradeCountHist2)
names(outputTrade) = c("experiment1", "experiment2")
outputTrade = stack(outputTrade)
outputTrade$run = rep(1:35, 2)
names(outputTrade) = c("trades", "experiment", "run")
outputPrice = data.frame(priceAvgHistory, priceAvgHistory2)
names(outputPrice) = c("experiment1", "experiment2")
outputPrice = stack(outputPrice)
outputPrice$run = rep(1:35, 2)
names(outputPrice) = c("prices", "experiment", "run")
These are the averages for the quantity of trades and the prices agreed for each experiment:
with(outputTrade, tapply(trades, experiment, mean))
experiment1 experiment2
22.06 21.71
with(outputPrice, tapply(prices, experiment, mean))
experiment1 experiment2
15.62 15.44
From above, the trade difference need the use of a non-parametric test, in this case the Friedman-test:
friedman.test(trades ~ experiment | run, data = outputTrade)
Friedman rank sum test
data: trades and experiment and run
Friedman chi-squared = 0.125, df = 1, p-value = 0.7237
So even the mean seem different, as they are a sample of a population, this test recommends, SO FAR, that we accept that the means come from the same populations, and particularly, that the experiments did not cause different mean behavior (More runs may have a different behavior)
In the same way, we test the difference in the average prices paid:
aov.out = aov(prices ~ experiment + Error(run/experiment), data = outputPrice)
summary(aov.out)
Error: run
Df Sum Sq Mean Sq F value Pr(>F)
Residuals 1 6.71 6.71
Error: run:experiment
Df Sum Sq Mean Sq
experiment 1 0.158 0.158
Error: Within
Df Sum Sq Mean Sq F value Pr(>F)
experiment 1 0.7 0.71 0.18 0.68
Residuals 66 264.8 4.01
Similarly, even the means seem different, as they are a sample of a population, this test recommends that we accept, SO FAR, that the means come from the same populations, and particularly, that the experiments did not cause different mean behavior (More runs may have a different behavior)
Here we can conclude that NONE of the processes (experiments) produces significant differences