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.