R/simulation.R

In wulingyun/BlockSim: Blockchain simulation and research tools

#' Simulate a blockchain
#'
#'
#' @param n the size of blockchain, i.e. the total number of blocks in the blockchain
#' @param attack_power the percentage of attacker's computing power
#' @param t1 the first time point of attack
#' @param t2 the second time point of attack
#' @param n_miners the number of miners
#' @param block_rate the block genration rate (blocks per sec)
#' @param block_size the block size (MB)
#' @param burn_in the burn in time points, in which period all blocks are generated by the genesis miner
#'
#' @return This function will return a list with the following components:
#'   \item{adj_mat}{The adjacent matrix of generated blockchain.}
#'   \item{block_info}{A list that contains information of blockchain and blocks.}
#'
#' @import Matrix
#'
#' @export
simulate_blockchain <- function(n, attack_power = 0, t1 = ceiling(1/3*n), t2 = ceiling(2/3*n), 
                                n_miners = 10000, block_rate = 1/600, block_size = 1,
                                n_genesis_blocks = 1, burn_in = n_genesis_blocks,
                                fixed_block_interval = TRUE)
{
  if (n_genesis_blocks <= 1) n_genesis_blocks <- 1
  if (burn_in <= 1) burn_in <- 1
  
  block_info <- list()
  block_info$n_blocks <- n
  block_info$n_miners <- n_miners
  block_info$block_rate <- block_rate
  block_info$block_size <- block_size
  block_info$n_genesis_blocks <- n_genesis_blocks
  block_info$burn_in <- burn_in
  block_info$fixed_block_interval <- fixed_block_interval
  
  block_info$attack <- list()
  block_info$attack$power <- attack_power
  block_info$attack$t1 <- t1
  block_info$attack$t2 <- t2
  
  # miner label, F - normal miner, T - attacker
  block_info$miners <- runif(n_miners) < attack_power
  block_info$miners[1] <- 0

  block_info$labels <- matrix(0, nrow = n, ncol = 4)
  colnames(block_info$labels) <- c("Miner_ID", "Group_ID", "Public_Time", "Interval")

  # block miners
  block_info$labels[, 1] <- sample.int(n_miners, n, replace = TRUE)
  block_info$labels[1:burn_in, 1] <- sample(which(block_info$miners == 0), burn_in, replace = TRUE)
  block_info$labels[1:n_genesis_blocks, 1] <- 1  # all genesis blocks are generated by the first miner
  
  # block groups: 0 - normal blocks, 1 - attacker blocks
  block_info$labels[, 2] <- block_info$miners[block_info$labels[, 1]]

  # block public time: 0 - hidden blocks, >0 - publish time
  block_info$labels[, 3] <- 1:n
  block_info$labels[1:t2, 3][block_info$labels[1:t2, 2] == 1] <- t2

  # block interval (in seconds) to last block
  block_info$labels[, 4] <- if(fixed_block_interval) 1/block_rate else rexp(n, block_rate)
  
  block_info$visible_probs <- block_visible_probs((1:n)/block_rate, block_rate, block_size) 

  A <- Matrix(0, nrow = n, ncol = n)
  for (i in 2:n)
  {
    if (block_info$labels[i, 2] == 0)
    {
      A[i, link_block_normal(i, A, block_info)] <- 1
    }
    else
    {
      A[i, link_block_attack(i, A, block_info)] <- 1
    }
  }
# return adjacent matrix of blockchain
  list(adj_mat = A, block_info = block_info)
}


link_block_normal <- function(i, A, block_info)
{
  v <- block_visible(i, block_info)
  v <- block_visible_adjust(i, v, A)
  block_tips(v, A)
}


link_block_attack <- function(i, A, block_info)
{
  links <- numeric()
  if (i < block_info$attack$t1)
  {
    links <- link_block_normal(i, A, block_info)
  }
  j <- which(block_info$labels[1:(i-1), 2] == 1)
  if (length(j) > 0)
  {
    links <- union(links, max(j))
  }
  links
}


block_visible_probs <- function(t, block_rate = 1/600, block_size = 1, band_width = 512)
{
  shape <- 2
  delay <- block_size * 1024 * 8 / band_width
  scale <- delay/(shape-1)
  pgamma(t, shape=shape, scale=scale, lower.tail = TRUE, log.p = FALSE)
}


# i: block id of new block
block_visible <- function(i, block_info)
{
  t <- i - block_info$labels[1:(i-1), 3]
  p <- numeric(i-1)
  p[t <= 0] <- 0
  if (block_info$fixed_block_interval)
  {
    p[t > 0] <- block_info$visible_probs[t[t > 0]]
  }
  else
  {
    interval <- rev(cumsum(block_info$labels[i:2, 4]))
    p[t > 0] <- block_visible_probs(interval[t > 0])
  }
  p[1] <- 1
  p[block_info$labels[1:(i-1), 1] == block_info$labels[i, 1]] <- 1
  which(runif(i-1) < p)
}


# v: the visibility status of block 1:(i-1) for block i
# A: the current adjacent matrix before block i is added
block_visible_adjust <- function(i, v, A)
{
  v0 <- v
  v1 <- complement(i-1, v)
  while (length(v0) > 0 && length(v1) > 0) {
    x <- colSums(A[v0, v1, drop = FALSE]) > 0
    v0 <- v1[x]
    v1 <- v1[!x]
    v <- c(v, v0)
  }
# return the adjusted visible status of block 1:(i-1)
  v
}


block_tips <- function(v, A)
{
  v[colSums(A[v, v, drop = FALSE]) == 0]
}