test-rpanet.R
In wdnet: Weighted and Directed Networks

test_that("rpanet with default preference functions", {
  # sample PA networks
  set.seed(1234)
  nstep <- 1e3
  my_weight_sampler <- function(n) {
    rgamma(n, shape = 5, scale = 0.2)
  }
  for (method in c("linear", "binary", "bag", "bagx")) {
    if (method == "linear" | method == "binary") {
      control <- rpa_control_preference(
        ftype = "default",
        sparams = runif(5, 1, 3),
        tparams = runif(5, 1, 3),
        params = runif(2, 1, 3)
      ) +
        rpa_control_scenario(
          alpha = 0.2, beta = 0.4, gamma = 0.2, xi = 0.1, rho = 0.1
        ) +
        rpa_control_edgeweight(sampler = my_weight_sampler)
    } else if (method == "bag") {
      control <- rpa_control_preference(
        ftype = "default",
        sparams = c(1, 1, 0, 0, 0.3),
        tparams = c(0, 0, 1, 1, 0.3),
        params = c(1, 0.3)
      ) +
        rpa_control_scenario(
          alpha = 0.2, beta = 0.4, gamma = 0.2, xi = 0.1, rho = 0.1
        )
    } else {
      control <- rpa_control_preference(
        ftype = "default",
        sparams = c(1, 1, 0, 0, 0.2),
        tparams = c(0, 0, 1, 1, 0.2),
        params = c(1, 0.2)
      ) +
        rpa_control_scenario(
          alpha = 0.2, beta = 0.4, gamma = 0.2, xi = 0.1, rho = 0.1
        ) +
        rpa_control_edgeweight(sampler = my_weight_sampler)
    }
    initial.network1 <- rpanet(1e3,
      initial.network = list(
        edgelist = matrix(1:2, nrow = 1),
        directed = TRUE
      ),
      control = control
    )
    initial.network2 <- rpanet(1e3,
      initial.network = list(
        edgelist = matrix(1:2, nrow = 1),
        directed = FALSE
      ),
      control = control
    )
    net1 <- rpanet(
      control = control, nstep = nstep, initial.network = initial.network1,
      method = method
    )
    net2 <- rpanet(
      control = control, nstep = nstep, initial.network = initial.network2,
      method = method
    )

    # check node preference
    sparams <- control$preference$sparams
    tparams <- control$preference$tparams
    params <- control$preference$params
    ret1.1 <- range(net1$node.attr$spref -
      (sparams[1] * net1$node.attr$outs^sparams[2] +
        sparams[3] * net1$node.attr$ins^sparams[4] +
        sparams[5]))
    ret1.2 <- range(net1$node.attr$tpref -
      (tparams[1] * net1$node.attr$outs^tparams[2] +
        tparams[3] * net1$node.attr$ins^tparams[4] +
        tparams[5]))
    ret2 <- range(
      net2$node.attr$pref - (net2$node.attr$s^params[1] + params[2])
    )
    ret <- max(abs(c(ret1.1, ret1.2, ret2)))
    # cat("\n", "default, diff preference", ret, "\n")
    expect_lt(ret, 1e-5)

    # check node strength
    temp1 <- node_strength_cpp(
      net1$edgelist[, 1],
      net1$edgelist[, 2],
      net1$edge.attr$weight,
      max(net1$edgelist),
      TRUE
    )
    temp2 <- node_strength_cpp(
      net2$edgelist[, 1],
      net2$edgelist[, 2],
      net2$edge.attr$weight,
      max(net2$edgelist),
      TRUE
    )
    ret1.1 <- range(net1$node.attr$outs - temp1$outs)
    ret1.2 <- range(net1$node.attr$ins - temp1$ins)
    ret2 <- range(net2$node.attr$s - (temp2$outs + temp2$ins))
    ret <- max(abs(c(ret1.1, ret1.2, ret2)))
    # cat("\n", "default, diff strength", ret, "\n")
    expect_lt(ret, 1e-5)
  }
})

test_that("rpanet with customized preference functions", {
  # sample PA networks
  set.seed(12345)
  nstep <- 1e4
  for (method in c("linear", "binary")) {
    control <- rpa_control_preference(
      ftype = "customized",
      spref = "outs + pow(ins, 0.5) + 1",
      tpref = "pow(outs, 0.5) + ins + 1",
      pref = "pow(s, 1.5) + 1"
    ) +
      rpa_control_scenario(
        alpha = 0.2, beta = 0.4, gamma = 0.2, xi = 0.1, rho = 0.1
      ) +
      rpa_control_edgeweight(
        sampler = function(n) rgamma(n, shape = 5, scale = 0.2)
      )
    initial.network1 <- rpanet(1e3,
      initial.network = list(
        edgelist = matrix(1:2, nrow = 1),
        directed = TRUE
      ),
      control = control
    )
    initial.network2 <- rpanet(1e3,
      initial.network = list(
        edgelist = matrix(1:2, nrow = 1),
        directed = FALSE
      ),
      control = control
    )
    net1 <- rpanet(
      control = control, nstep = nstep, initial.network = initial.network1,
      method = method
    )
    net2 <- rpanet(
      control = control, nstep = nstep, initial.network = initial.network2,
      method = method
    )

    # check node preference
    ret1.1 <- range(net1$node.attr$spref -
      (net1$node.attr$outs + net1$node.attr$ins^0.5 + 1))
    ret1.2 <- range(net1$node.attr$tpref -
      (net1$node.attr$outs^0.5 + net1$node.attr$ins + 1))
    ret2 <- range(net2$node.attr$pref - (net2$node.attr$s^1.5 + 1))
    ret <- max(abs(c(ret1.1, ret1.2, ret2)))
    # cat("\n", "customized, diff preference", ret, "\n")
    expect_lt(ret, 1e-5)

    # check node strength
    temp1 <- node_strength_cpp(
      net1$edgelist[, 1],
      net1$edgelist[, 2],
      net1$edge.attr$weight,
      max(net1$edgelist),
      TRUE
    )
    temp2 <- node_strength_cpp(
      net2$edgelist[, 1],
      net2$edgelist[, 2],
      net2$edge.attr$weight,
      max(net2$edgelist),
      TRUE
    )
    ret1.1 <- range(net1$node.attr$outs - temp1$outs)
    ret1.2 <- range(net1$node.attr$ins - temp1$ins)
    ret2 <- range(net2$node.attr$s - (temp2$outs + temp2$ins))
    ret <- max(abs(c(ret1.1, ret1.2, ret2)))
    # cat("\n", "customized, diff strength", ret, "\n")
    expect_lt(ret, 1e-5)
  }
})


test_that("rpanet initial network", {
  set.seed(12345)
  ctr1 <- rpa_control_preference(
    ftype = "customized",
    spref = "outs + pow(ins, 0.5) + 1",
    tpref = "pow(outs, 0.5) + ins + 1",
    pref = "pow(s, 1.5) + 1"
  ) + rpa_control_scenario(
    alpha = 0.2, beta = 0.4, gamma = 0.2, xi = 0.1, rho = 0.1
  ) + rpa_control_edgeweight(
    sampler = function(n) rgamma(n, shape = 5, scale = 0.2)
  ) + rpa_control_newedge(
    sampler = function(n) rpois(n, lambda = 2) + 1
  ) + rpa_control_reciprocal(
    group.prob = c(0.2, 0.4, 0.4),
    recip.prob = matrix(rep(0.5, 9), nrow = 3)
  )

  netwk1 <- rpanet(1e3,
    initial.network = list(
      edgelist = matrix(1:2, nrow = 1),
      directed = TRUE
    ),
    control = ctr1
  )
  netwk2 <- rpanet(1e3,
    initial.network = netwk1,
    control = netwk1$control
  )
  netwk3 <- rpanet(1e3,
    initial.network = list(
      edgelist = matrix(1:2, nrow = 1),
      directed = FALSE
    ),
    control = ctr1
  )
  netwk4 <- rpanet(1e3,
    initial.network = netwk3,
    control = netwk1$control
  )

  # check initial netwk
  check_initial_network <- function(netwk1, netwk2) {
    nedge <- nrow(netwk1$edgelist)
    nnode <- nrow(netwk1$node.attr)
    netwk1$edge.attr$scenario <- 0
    expect_equal(netwk1$edgelist, netwk2$edgelist[1:nedge, ])
    expect_true(all(netwk2$edge.attr$scenario[1:nedge] == 0))
    expect_equal(netwk1$edge.attr$weight, netwk2$edge.attr$weight[1:nedge])
    expect_equal(netwk1$directed, netwk2$directed)
    expect_equal(netwk1$weighted, netwk2$weighted)
    expect_equal(netwk1$control, netwk2$control)
    expect_equal(netwk1$node.attr$group, netwk2$node.attr$group[1:nnode])
    NULL
  }
  check_initial_network(netwk1, netwk2)
  check_initial_network(netwk3, netwk4)
})


test_that("rpanet scenarios", {
  set.seed(12345)
  ctr <- rpa_control_scenario(
    alpha = 0.1, beta = 0.8, gamma = 0.1, beta.loop = FALSE
  )
  netwk1 <- rpanet(1e4,
    control = ctr,
    initial.network = list(
      edgelist = matrix(1:2, nrow = 1),
      directed = TRUE
    )
  )
  netwk2 <- rpanet(1e4,
    control = ctr,
    initial.network = list(
      edgelist = matrix(1:2, nrow = 1),
      directed = FALSE
    )
  )

  check_scenarios <- function(netwk) {
    alpha <- which(netwk$edge.attr$scenario == 1)
    beta <- which(netwk$edge.attr$scenario == 2)
    gamma <- which(netwk$edge.attr$scenario == 3)
    expect_true(all(netwk$edgelist[alpha, 1] > netwk$edgelist[alpha, 2]))
    expect_true(all(netwk$edgelist[beta, 1] != netwk$edgelist[beta, 2]))
    expect_true(all(netwk$edgelist[gamma, 1] < netwk$edgelist[gamma, 2]))
  }

  check_scenarios(netwk1)
  check_scenarios(netwk2)
})

test_that("rpanet node id", {
  set.seed(12345)
  ctr <- rpa_control_scenario(
    alpha = 0.1, beta = 0.8, gamma = 0.1, beta.loop = FALSE
  )
  initial.network <- list(
    edgelist = matrix(c(1010:1050, 3010:3050), ncol = 2), directed = TRUE
  )
  netwk1 <- rpanet(1e4,
    control = ctr,
    initial.network = initial.network
  )
  expect_equal(
    netwk1$edgelist[seq_len(nrow(initial.network$edgelist)), ],
    initial.network$edgelist
  )
})