# Simulator

Below is the main function of the simulator. The parameters relate to the discussions in the paper as follows:

Parameter Meaning
initDifficulty default difficulty
initReward default reward
numCompetitions number of competitions/blocks for the simulation
idealBlockTime the target blocktime $$\tilde{t}_b$$
idealNetworkPower the target network power $$\tilde{w}$$
priceList a list of length numCompetitions containing the prices $$x$$ of the token.
nodePowers a list of powers $$w_i$$ of each node $$i = 1\ldots n$$
nodeCFs a list of cost factors $$c_i$$ of each node $$i = 1\ldots n$$
difficultyAdaptationRate adaptation rate $$\alpha_d$$
rewardAdaptationRate adaptation rate $$\alpha_r$$
adaptationStrategy “adaptive” if the controller is adaptive as per the paper, “fixed” if there is no adaptation.
 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119  simulateNetworkBasic <- function( initDifficulty, initReward, numCompetitions, idealBlockTime, idealNetworkPower, priceList = NULL, nodePowers = NULL, nodeCFs = NULL, difficultyAdaptationRate = 0.1, rewardAdaptationRate = 0.1, adaptationStrategy = "adaptive"){ numNodes = length(nodePowers) # # Results List # difficultyList = NULL rewardList = NULL blockTimeList = NULL powerList = NULL participationList = NULL # play is as long as the number of nodes and flags which node will play the next round play = numeric() reward = initReward difficulty = initDifficulty networkPower = sum(nodePowers) print(paste0("Running ", numCompetitions, " competitions for ", numNodes)) pb <- txtProgressBar(1, numCompetitions, style=3) for (i in 1:numCompetitions){ # # Each node decides whether to participate. # for (j in 1:numNodes){ bkEvenR = getBreakEvenReward (d = difficulty, x = priceList[i], c = nodeCFs[j], N = (networkPower-nodePowers[j])/nodePowers[j] ) if (reward > bkEvenR){ play[j] = 1 } else { play[j] = -1 } } numParticipants = sum(play[play==1]) networkPower = sum(nodePowers[play==1]) # Full observability # # If the network power is zero then the network has simply collapsed. # [we choose to end simulation for that] # if (numParticipants == 0) { print("Network Collapsed.") return(data.frame(Difficulty = difficultyList, BlockTime = blockTimeList, Reward = rewardList, Price = priceList[1:length(difficultyList)], NetPower = powerList, Participation = participationList )) } blockTime = difficulty/networkPower # Capture Statistics difficultyList = c(difficultyList,difficulty) rewardList = c(rewardList,reward) powerList = c(powerList,networkPower) blockTimeList = c(blockTimeList,blockTime) participationList = c(participationList,numParticipants) # # Netowrk Adapts Reward and Difficulty. # # Adjust d if (adaptationStrategy == "fixed"){ # Do nothing } else { newDiff = idealBlockTime * networkPower difficulty = difficulty + (newDiff - difficulty)*difficultyAdaptationRate } # Adjust r if (adaptationStrategy == "fixed"){ # Do nothing } else { newR = getOptimalReward(difficulty = difficulty, price = priceList[i], nodePowers = nodePowers, nodeCFs = nodeCFs, networkPower = networkPower, idealPower = idealNetworkPower) reward = reward + (newR - reward)*rewardAdaptationRate } setTxtProgressBar(pb,i) } return(data.frame(Difficulty = difficultyList, BlockTime = blockTimeList, Reward = rewardList, Price = priceList, NetPower = powerList, Participation = participationList )) }

Adaptation in the code is taking place in lines 84-107 according to formulae $d_{next} = d_{current} + (d_{target} - d_{current})\cdot \alpha_d$ and $e_{r_{next}} = e_{r_{current}} + (e_{r_{target}} - e_{r_{current}})\cdot \alpha_{e_r}$

Please also node that the controller does not make any estimations but has somehow full awareness of the nodes, their powers ($$w_i$$, nodePowers) and cost factors ($$c_i$$, nodeCfs) and who participates captured in the play list (lines 47-52) following a transparent cost-benefit analysis (lines 40-45).

For the cost benefit analysis the following routine is used:

getBreakEvenReward <- function(d,x,c,N){
return ( (c*d/x)*(d/(d-1))^N )
}

which is a solution of equation (1) in the paper for $$e_r$$, assuming $$e_f = 0$$.

$(e_r + e_f) \cdot x = c \cdot d \cdot \left(\frac{d}{d-1}\right)^N$

$\overset{e_f = 0}{\Longrightarrow}$

$e_r = \frac{c \cdot d}{x} \cdot \left(\frac{d}{d-1}\right)^N$

# Runs

## Parameters

The paper mentions 4 runs: 1 with fixed strategy and three (3) with the proposed adaptive one. The corresponding parameters are:

Parameter Value
initDifficulty 3e+06
initReward 12.5
numCompetitions 500
idealBlockTime 600
idealNetworkPower 6000
priceList [see below]
nodePowers [see below]
nodeCFs [see below]
difficultyAdaptationRate 0.01, 0.1 and 0.5 (for fixed case is irrelevant)
rewardAdaptationRate always same as difficultyAdaptationRate
adaptationStrategy “fixed” for the first simulation, “adaptive” for the next three.

For nodePowers and nodeCFs a normally distributed list of 100 nodes is generated with average 100 (trials/sec) and 0.001 (USD/sec) and standard deviations equal to the 20% of the averages.

N = 100
pAvg = 100
pSD = 0.2*pAvg
cAvg = 0.001
cSD = 0.2*cAvg
powers = round(rnorm(n = N,mean = pAvg, sd = pSD),0)
cFs = rnorm(n = N,mean = cAvg, sd = cSD)

The priceList is generated as follows (reps = 500):

initPrice = 168
t =seq(0,10,10/reps)
t = t[1:(length(t)-1)]
priceList = initPrice + 0.3*initPrice*sin(t)

The initial price is found empirically such that a majority of nodes are close to their break-even point. 500 samples of a sinusoidal disturbance with width up to 30% of that price is added.

## Results

The following data sets are produced:

Run Data
Fixed Fixed.csv
Adaptive ($$\alpha = 0.01$$) Alpha001.csv
Adaptive ($$\alpha = 0.1$$) Alpha01.csv
Adaptive ($$\alpha = 0.5$$) Alpha05.csv

To produce the visuals the following can be tried:

r1 <- read.csv(url("https://www.yorku.ca/liaskos/Papers/SEAMS2019/Alpha001.csv"))
r2 <- read.csv(url("https://www.yorku.ca/liaskos/Papers/SEAMS2019/Alpha01.csv"))
r3 <- read.csv(url("https://www.yorku.ca/liaskos/Papers/SEAMS2019/Alpha05.csv"))
f <- read.csv(url("https://www.yorku.ca/liaskos/Papers/SEAMS2019/Fixed.csv"))

offset = 50

result = r1
result = result[offset:nrow(result),]
dd <- data.frame(Time = (1:nrow(result)), Value = result$Price, Variable = "Price", Rate = "0.01") dd = rbind(dd,data.frame(Time = (1:nrow(result)), Value = result$Reward, Variable = "Reward",Rate = "0.01"))
dd = rbind(dd,data.frame(Time = (1:nrow(result)), Value = result$Difficulty, Variable = "Difficulty",Rate = "0.01")) dd = rbind(dd,data.frame(Time = (1:nrow(result)), Value = result$BlockTime, Variable = "BlockTime", Rate = "0.01"))
dd = rbind(dd,data.frame(Time = (1:nrow(result)), Value = result$NetPower, Variable = "Network Power", Rate = "0.01")) result = r2 result = result[offset:nrow(result),] dd = rbind(dd,data.frame(Time = (1:nrow(result)), Value = result$Price, Variable = "Price", Rate = "0.1"))
dd = rbind(dd,data.frame(Time = (1:nrow(result)), Value = result$Reward, Variable = "Reward", Rate = "0.1")) dd = rbind(dd,data.frame(Time = (1:nrow(result)), Value = result$Difficulty, Variable = "Difficulty",Rate = "0.1"))
dd = rbind(dd,data.frame(Time = (1:nrow(result)), Value = result$BlockTime, Variable = "BlockTime", Rate = "0.1")) dd = rbind(dd,data.frame(Time = (1:nrow(result)), Value = result$NetPower, Variable = "Network Power", Rate = "0.1"))

result = r3
result = result[offset:nrow(result),]
dd = rbind(dd,data.frame(Time = (1:nrow(result)), Value = result$Price, Variable = "Price", Rate = "0.5")) dd = rbind(dd,data.frame(Time = (1:nrow(result)), Value = result$Reward, Variable = "Reward", Rate = "0.5"))
dd = rbind(dd,data.frame(Time = (1:nrow(result)), Value = result$Difficulty, Variable = "Difficulty",Rate = "0.5")) dd = rbind(dd,data.frame(Time = (1:nrow(result)), Value = result$BlockTime, Variable = "BlockTime", Rate = "0.5"))
dd = rbind(dd,data.frame(Time = (1:nrow(result)), Value = result$NetPower, Variable = "Network Power", Rate = "0.5")) dd$Variable = as.factor(dd$Variable) dd$Rate = as.factor(dd\$Rate)
cbPalette <- c("#999999", "#E69F00", "#56B4E9", "#009E73", "#F0E442", "#0072B2", "#D55E00", "#CC79A7")
p1 <- ggplot(dd, aes(x = Time, y = Value, color = Rate)) +
geom_line(size = 0.7) +
facet_grid(rows = vars(Variable), scales = "free") +
theme(text = element_text(size=13),legend.position = "bottom") +
scale_colour_manual(values=cbPalette)

Noting that the first 50 stabilization cycles have been trimmed. The graph for the fixed non-adaptive policy can be produced likewise.