Source codes for K. Growiec, J. Growiec, B. Kamiński: Social Network Structure and The Trade-Off Between Social Utility and Economic Performance, Social Networks, forthcoming

design.r

# K. Growiec, J. Growiec, B. Kamiński
# Social Network Structure and The Trade-Off Between Social Utility and Economic Performance

# Simulation experiment design generation file

library(randtoolbox)

size <- 65536
s_design <- sobol(size, 9, TRUE, 3, 4711, FALSE)
colnames(s_design) <- c("r", "p", "lambda", "sigma", "rho",
                        "g_nc", "g_cn", "g_nn", "epsilon")
design <- data.frame(id = 1:size, N = 2048)
design <- cbind(design, s_design)
design$r <- ceiling(15 * design$r)
design$lambda <- 0.5 * design$lambda
design$g_nc <- 1.25 + 0.75 * design$g_nc
design$g_cn <- -0.5 * design$g_cn
design$g_nn <- 0.25 + 0.5 * design$g_nn
design$epsilon <- 0.5 + 0.5 * design$epsilon

write.csv(design, "design.txt", row.names=FALSE)

model.r

# K. Growiec, J. Growiec, B. Kamiński
# Social Network Structure and The Trade-Off Between Social Utility and Economic Performance

# Part 1: Simulation model implementation

library(igraph)

run <- function(seed, id,
                N, r, p,
                lambda, sigma, rho,
                g_nc, g_cn, g_nn, epsilon) {
    set.seed(1299827 * seed + 71 * id)
    graph <- watts.strogatz.game(1, N, r, p,
                                 FALSE, FALSE)
    graph$layout <- layout.circle
    
    D_i <- degree(graph)
    C_i <- eigen_centrality(graph, scale = TRUE)$vector
    ecdf_C_i <- ecdf(C_i)
    Q_i <- (ecdf_C_i(C_i-1e-10) + ecdf_C_i(C_i+1e-10)) / 2
    
    tilde_f_i <- (1:N)/N + runif(N, -lambda, lambda)
    f_i <- tilde_f_i - floor(tilde_f_i)

    q_i <- rank(C_i, ties.method = "random")
    u_i <- rnorm(N, 0, sigma)
    tilde_u_i <- u_i[order(abs(u_i))]
    v_i <- tilde_u_i[q_i] + rnorm(N, 0, sqrt(1-sigma^2))

    Bo_i <- rep(NA_real_, N)
    SU_i <- rep(NA_real_, N)
    for (i in 1:N) {
        if (length(graph[[i]][[1]]) > 0) {
            sf_i <- abs(f_i[graph[[i]][[1]]] - f_i[i])
            sf_i <- 1 - pmin(sf_i, 1 - sf_i)
            Bo_i[i] <- mean(sf_i)
            SU_i[i] <- mean((sf_i^rho) *
                            (Q_i[graph[[i]][[1]]]^(1-rho)))
        } else {
            Bo_i[i] <- 0
            SU_i[i] <- 0
        }
    }
    
    dv_ij <- 1-exp(-as.matrix(dist(v_i, "max", TRUE, TRUE)))
    Br_i <- rep(NA_real_, N)
    for (i in 1:N) {
        if (length(graph[[i]][[1]]) > 0) {
            Br_i[i] <- mean(dv_ij[i, graph[[i]][[1]]])
        } else {
            Br_i[i] <- 0
        }
    }
    
    L_ij <- distances(graph)
    L_ij[L_ij==Inf] <- N
    apl <- rowSums(L_ij) / (N - 1)
    P_ij <- sqrt((1-Bo_i) %o% (1-Bo_i)) / L_ij
    diag(P_ij) <- NA
    Tr_i <- rowMeans(P_ij, na.rm = TRUE)
    W_ij <- Br_i / L_ij
    diag(W_ij) <- NA
    Coop <- (W_ij * t(W_ij))
    Coop1 <- Coop * epsilon
    Coop2 <- Coop * epsilon^2
    Payoff_ij <- (Coop2 +
                  (Coop1 - Coop2) * (g_nc + g_cn) +
                  (1 + Coop2 - 2 * Coop1) * g_nn)
    EU_i <- rowSums(P_ij * Payoff_ij * dv_ij, na.rm = TRUE)
    Co_i <- rowMeans(W_ij, na.rm= TRUE)
    cors <- cor(cbind(D_i, C_i, Br_i, Bo_i, v_i, f_i,
                            Tr_i, Co_i, EU_i, SU_i, apl))
    stats <- c(mEU=mean(EU_i),
               mSU=mean(SU_i),
               mTr=mean(Tr_i),
               mCo=mean(Co_i),
               mBr=mean(Br_i),
               mBo=mean(Bo_i),
               sEU=sd(EU_i),
               sSU=sd(SU_i),
               sTr=sd(Tr_i),
               sCo=sd(Co_i),
               sBr=sd(Br_i),
               sBo=sd(Bo_i))

    names <- rownames(cors)
    for (i in 1:(length(names)-1)) {
        for (j in (i+1):length(names)) {
            stats[paste(names[i], names[j], sep="_")] = cors[i, j]
        }
    }
    c(seed=seed, id=id,
      N=N, r=r, p=p,
      lambda=lambda, sigma=sigma, rho=rho,
      g_nc=g_nc, g_cn=g_cn, g_nn=g_nn, epsilon=epsilon,
      stats)
}

# Part 2: Simulation experiment execution
# Takes one command line argument that is used to set the
# seed of the random number generator

args <- as.numeric(commandArgs(trailingOnly = TRUE))
aseed <- args[1]

design <- read.csv("design.txt")
filename <- "results.txt"

cat(names(res), "\n", file=filename, append=FALSE)

for (idx in 1:65536) {
    cat(idx, "\n")
    res <- run(aseed, design$id[idx],
               design$N[idx],
               design$r[idx],
               design$p[idx],
               design$lambda[idx],
               design$sigma[idx],
               design$rho[idx],
               design$g_nc[idx],
               design$g_cn[idx],
               design$g_nn[idx],
               design$epsilon[idx])
    cat(res, "\n", file=filename, append=TRUE)
}