Load dependencies for this report.

source("../R/read_network.R")
source("../R/experiment_utils.R")
## Loading required package: ggplot2
library(data.table)
library(reshape2)
library(reshape)
## 
## Attaching package: 'reshape'
## 
## The following object is masked from 'package:reshape2':
## 
##     colsplit, melt, recast
library(tables)
## Loading required package: Hmisc
## Loading required package: grid
## Loading required package: lattice
## Loading required package: survival
## Loading required package: splines
## Loading required package: Formula
## 
## Attaching package: 'Hmisc'
## 
## The following object is masked from 'package:base':
## 
##     format.pval, round.POSIXt, trunc.POSIXt, units
library(ggplot2)
#to display ggplot2 plots in a grid layout
library(gridExtra)

Context Permeability Convergence Results

In this analysis, we analyse the context permeability model in terms of convergence. This is, the percentage of times a simulation has converged to total consensus and how many agent encounters were needed for this to happen.

Convergence for K-Regular Networks

In this analysis we look at the convergence to consensus for simulations that use regular networks only. We will analyse two things: the percentage of convergence to total consensus and the number of encounters necessary to achieve concensus.

We first load the data related to convergence to consensus. In this first dataset, we can find a single boolean variable {1,0} that tells us wheather or not consensus was achieved.

#Read the Parameters for this experiment
params <- read.exp.parameters(param_file_name="../data/context_permeability/regular_networks/param-space_2014-07-23_11:40:44experiment:0_.csv")

#read the adata related to consensus was achieved before 

convergence_data <- fread("../data/context_permeability/regular_networks/consensus_achieved.csv")
convergence_data <- as.data.frame(convergence_data)[,-ncol(convergence_data)]
convergence_data <- merge(convergence_data, params, by="cfg.id")

We can now create a table to display the percentage of convergences to total consensus for each value of k and number of networks.

#filter some columns that are not needed
fcdata <- melt(convergence_data,id.vars=c("cfg.id","run","num.networks","network.0.k"), measure.vars=c("consensus-achieved"))

fcdata_table <- aggregate(data=fcdata, fcdata$value~fcdata$num.networks + fcdata$network.0.k, FUN=sum)
colnames(fcdata_table) <- c("num.networks", "k", "value")

#create a table for latex
table <- cast(fcdata, num.networks~network.0.k, sum)
latex_table <- tabular.cast_df(table)

Display the latex table and export it to a file.

html(latex_table)
  network.0.k
num.networks 1 2 3 4 5 10 20 30 40 50
1 0 0 1 1 2 11 63 95 100 100
2 7 62 73 85 95 98 100 100 100 100
3 64 94 97 100 100 100 100 100 100 100
4 85 100 99 100 100 100 100 100 100 100
5 98 100 100 100 100 100 100 100 100 100 
#save this table to a file for later reference
Hmisc::latex(latex_table, file="tex/regular_convergence.tex",booktabs=T)

This table shows the percentage of simulation runs that converged to total consensus over 100 independent runs.

Number of Encounters for K-Regular Networks

Now we analise the number of encouters necessary to achieve consensus. Or the total number of encounters that were performed if consensus was not achieved. The maximum number of simulation cycles is 2000. The maximum number of encounters is thus limited by the maximum number of simulation cycles (and in consequense steps). The data for the encounters contains the following variables.

encounter_data <- fread("../data/context_permeability/regular_networks/num_encounters.csv")
encounter_data <- as.data.frame(encounter_data)[,-ncol(encounter_data)]
head(encounter_data)
##   step run cfg.id total-encounters
## 1 2000   6      1           200000
## 2 2000   4      1           200000
## 3 2000   3      1           200000
## 4 2000   8      1           200000
## 5 2000   7      1           200000
## 6 2000   5      1           200000

To get the information for how many networks were in the simulation and what was the k value we can merge the data like we have done previously.

encounter_data <- merge(encounter_data, params, by="cfg.id")

We now filter some of the variables out.

#filter some columns that are not needed and convert to melted format
fedata <- melt(encounter_data,id.vars=c("cfg.id","run","num.networks","network.0.k"), measure.vars=c("total-encounters"))
head(fedata)
##   cfg.id run num.networks network.0.k         variable  value
## 1      1   6            1           1 total-encounters 200000
## 2      1   4            1           1 total-encounters 200000
## 3      1   3            1           1 total-encounters 200000
## 4      1   8            1           1 total-encounters 200000
## 5      1   7            1           1 total-encounters 200000
## 6      1   5            1           1 total-encounters 200000
#divide data in two partitions k<=5 and k>5
fedata_net1 <- fedata[fedata$num.networks>2 & fedata$network.0.k <= 5,]
fedata_net10 <- fedata[fedata$num.networks>2 & fedata$network.0.k > 5,]

#create a table with avg and stdev
cast_fedata_table <- cast(data=fedata, formula=network.0.k~num.networks, c(mean, sd))
fedata_table_full <- tabular.cast_df(cast_fedata_table)

Display the table in HTML for the knitr report and save it to a file.

#to print the table created with tabular
html(fedata_table_full)
  num.networks
  1 2 3 4 5
  result_variable result_variable result_variable result_variable result_variable
network.0.k mean sd mean sd mean sd mean sd mean sd
1 200000 0.0 191237 35780.6 97770 86648.0 44827 71714.8 14210 31633.6
2 200000 0.0 99744 89096.9 22690 50813.5 7514 21352.6 4602 6116.7
3 198033 19670.0 68555 82808.5 10217 33963.1 6539 22227.3 2828 2283.6
4 198093 19070.0 38359 69305.4 5028 10680.0 3710 4618.7 2678 2127.4
5 196042 27845.6 21287 48141.1 3444 5144.0 2834 4334.5 2278 1921.5
10 178207 62301.7 8066 28298.4 2894 6424.5 1800 1148.2 2180 2078.3
20 75541 95871.3 2338 2739.9 2178 1588.3 1936 989.4 1802 823.6
30 11703 43425.0 1952 1087.9 1726 936.6 1930 1096.3 1956 1273.5
40 1694 954.5 1646 821.9 1862 872.3 1806 884.6 1686 647.1
50 1788 786.9 1724 744.7 1776 827.7 1842 896.8 1896 911.4 
#print this to a file to use in the paper
Hmisc::latex(fedata_table_full, file="tex/regular_encounters_full.tex",booktabs=T)

Now to observe the distribution of the number of encounters, necessary to achieve consensus, we look at the box plots for k = {1,2,3,4,5} and k = {10,20,30,40,50} respectively. We look at configurations with a number of networks > 3 since less networks

plot <- plot.exp.box(data=fedata_net1,x_factor=as.factor(fedata_net1$num.networks), data_y=fedata_net1$value, fill_factor=as.factor(fedata_net1$network.0.k),fill_label="K", x_label="Number of Networks", y_label="Number of Encounters")

plot

plot of chunk unnamed-chunk-9

#print to pdf
pdf(paste("./pdf/","context_permeability_encounters_kregular_12345.pdf"), width=7, height=5)
plot
dev.off()
## pdf 
##   2
plot <- plot.exp.box(data=fedata_net10,x_factor=as.factor(fedata_net10$num.networks), data_y=fedata_net10$value, fill_factor=as.factor(fedata_net10$network.0.k),fill_label="K", x_label="Number of Networks", y_label="Number of Encounters")

plot

plot of chunk unnamed-chunk-9

pdf(paste("./pdf/","context_permeability_encounters_kregular_1020304050.pdf"), width=7, height=5)
plot
dev.off()
## pdf 
##   2

To try to answer the question “why do some outliers show up in the data” (simulation runs that took more time than the typical run), I look at the outlier from the configuration (networks=3, k = 10). What I’m trying to find is weather the network structure is the same from the other runs.

network_data <- fread("../data/context_permeability/regular_networks/networks.csv")
## 
Read 63.2% of 24675000 rows
Read 24675000 rows and 7 (of 7) columns from 0.405 GB file in 00:00:03
#get outlier
outlier <- fedata_net10[fedata_net10$value > 30000 & fedata_net10$network.0.k == 10,]
normal <- fedata_net10[fedata_net10$value < 3000 & fedata_net10$network.0.k == 10,]

#get outlier network
network_outlier_data <- network_data[network_data$"cfg.id" == outlier$"cfg.id" & network_data$"run" == outlier$"run", ]
outlier_net <- read.composite.network(network_data=network_outlier_data)

fdata <- fedata_net10[fedata_net10$"network.0.k" == 10 & fedata_net10$"num.networks" == 3 & fedata_net10$value < 5000,]#filter the data
plot <- plot.exp.box(data=fdata,x_factor=as.factor(fdata$num.networks), data_y=fdata$value, fill_factor=as.factor(fdata$network.0.k),fill_label="K", x_label="Number of Networks", y_label="Number of Encounters")

plot

plot of chunk unnamed-chunk-10

#print to pdf
pdf(paste("./pdf/","context_permeability_encounters_kregular_k10_outlier.pdf"), width=7, height=5)
plot
dev.off()
## pdf 
##   2
normal <- normal[2,] #choose one possible configuration (not an outlier)
normal
##      cfg.id run num.networks network.0.k         variable value
## 2502     26   3            3          10 total-encounters  1100
network_normal_data <- network_data[network_data$"cfg.id" == normal$"cfg.id" & network_data$"run" == normal$"run", ]
normal_net <- read.composite.network(network_data=network_normal_data)

#outlier network properties
outlier_net_props <- read.composite.properties(outlier_net)
normal_net_props <- read.composite.properties(normal_net)
outlier_net_props
##   nodes edges     cc   apl
## 1   100  2422 0.5426 1.511
normal_net_props
##   nodes edges     cc   apl
## 1   100  2434 0.5436 1.508

There is no significant differences between the network from the outlier simulation run and one case from a normal run. This suggests that this can be a property of the game itself (see plots bellow) and some “event” leads the convergence to be slower than those of the rest of the runs. My hypothesis is that the agents reach a state from which converging towards consensus is significantly harder. This needs further analysis. One idea is to look at difference between the observations (agent memory) for both opinions throughout the simulation.

Another idea is to look at the sate of the agents and their location in the underlying networks. If networks contain some sort of self-reinforcing structures, this can cause the convergence to be slowed. Daniel Villatoro found these structures in models such as scale-free networks (see http://dl.acm.org/citation.cfm?id=2451250). Self-reinforcing structures are subgraphs that converge to consensus, and due to its structure (and the nature of the consensus game), lead the agents in that subgroup to reinforce one another. Breaking these consensus groups can be particularly difficult even if the whole society has converged to a different opinion value.

opinion_data <- read.opinion.progress("../data/context_permeability/regular_networks/opinion_progress.csv")

#filter opinion to outlier run and normal run
outlier_run <- opinion_data[opinion_data$"cfg.id" == outlier$"cfg.id" & opinion_data$"run" == outlier$"run",]
normal_run <- opinion_data[opinion_data$"cfg.id" == normal$"cfg.id" & opinion_data$"run" == normal$"run",]
plot_run_outlier <- plot_opinion(opinion_data=outlier_run)
plot_run_normal <- plot_opinion(opinion_data=normal_run)


plot_run_normal + labs(title = "Normal Run")

plot of chunk unnamed-chunk-13

plot_run_outlier + labs(title = "Outlier Run")

plot of chunk unnamed-chunk-13

#print to pdf
pdf(paste("./pdf/","context_permeability_simrun_kregular_k10_normal.pdf"), width=7, height=5)
plot_run_normal + labs(title = "Normal Run")
dev.off()
## pdf 
##   2
pdf(paste("./pdf/","context_permeability_simrun_kregular_k10_outlier.pdf"), width=7, height=5)
plot_run_outlier + labs(title = "Outlier Run")
dev.off()
## pdf 
##   2

We now look at the average difference between the memory of opinions seen. This is abs(number of opinion 1 seen - number of opinion 2 seen). We also look at the variance of this difference between the 100 agents.

#check the opinion memory difference for the outlier and the normal run
plot.op.diff <- function(current_run){
 
  
  
  average_data <- melt(current_run, id=(c("step")), measure.vars=(c("avg-op-diff")))
  
  .e <- environment()
  
  average_plot <- ggplot(data = average_data, aes(x = average_data$step, y = average_data$value), environment=.e)
  average_plot <- average_plot + geom_line() + geom_point(size=0)
  average_plot <- average_plot + labs(x = "Simulation Step", y = "Average Memory Difference")
  
  #average_plot <- average_plot + labs(title = "Average Opinion Memory Difference")
  average_plot <- average_plot + theme_bw()
  average_plot <- average_plot + theme(legend.title=element_blank())
  
  
  #plot variance

  variance_data <- melt(current_run, id=(c("step")), measure.vars=(c("variance-op-diff")))
  
  
  variance_plot <- ggplot(data = variance_data, aes(x = variance_data$step, y = variance_data$value), environment=.e)
  variance_plot <- variance_plot + geom_line() + geom_point(size=0)
  variance_plot <- variance_plot + labs(x = "Simulation Step", y = "Variance of Opinion Memory Difference")
  
  #variance_plot <- variance_plot + labs(title = "Variance of Opinion Memory Difference")
  variance_plot <- variance_plot + theme_bw()
  variance_plot <- variance_plot + theme(legend.title=element_blank())

  
 

  grid.arrange(average_plot, variance_plot, ncol=2)
}

Bellow we can see the average difference between opinion memory in the first ten steps (which was when the simulation converged for the “normal” run).

current_run <- normal_run
current_run <- current_run[current_run$"step" <= 10,]

plot.op.diff(current_run)

plot of chunk unnamed-chunk-15

pdf(paste("./pdf/","cp-regular-normal-run-memory-diff.pdf"), width=15, height=5)
plot.op.diff(current_run)
dev.off()
## pdf 
##   2

For the outlier run we get the following results. We can see that the average difference in the opinion memory rises more quickly for the normal run than it does in the outlier run. The values of opinion memory and the position of the agents in the network is such that the convergence is slower but steady towards total consensus.

current_run <- outlier_run
current_run <- current_run[current_run$"step" <= 10,]
plot.op.diff(current_run)

plot of chunk unnamed-chunk-16

pdf(paste("./pdf/","cp-regular-outlier-run-memory-diff.pdf"), width=15, height=5)
plot.op.diff(current_run)
dev.off()
## pdf 
##   2

In the outlier run the variance for the opinion difference is also quite low from step 0 to 25, this indicates that while opinion memory difference is increasing on average, there is no significant difference between agents in terms of their counters. There is no particular group of agents that is more strongly inclined to one particular opinion. From this point on, the memory difference variance grows exponentialy –this corresponds to the point where one opinion won over the other and convergence towards consensus begins.

current_run <- outlier_run
current_run <- current_run[current_run$"step" <= 100,]
plot.op.diff(current_run)

plot of chunk unnamed-chunk-17

pdf(paste("./pdf/","cp-regular-outlier-0-100-memory-diff.pdf"), width=15, height=5)
plot.op.diff(current_run)
dev.off()
## pdf 
##   2
current_run <- outlier_run
plot.op.diff(current_run)

plot of chunk unnamed-chunk-18

pdf(paste("./pdf/","cp-regular-outlier-fullrun-memory-diff.pdf"), width=15, height=5)
plot.op.diff(current_run)
dev.off()
## pdf 
##   2

Convergence for Scale-Free Networks

We now perform the same analysis for an homogenous scale-free configuration (scale-free networks in all the layers). To create the scale-free networks, we used the Barabasi-Albert model in which the networks are expanded by preferential attachment. The networks have an additional parameter d which dictates how many connections are added each time a new node is added to the network. We varied this parameter and considered the values ** d = {1,2,3,4,5} **.

We first look at the number of convergences to total consensus in 100 simulation runs.

#Read the Parameters for this experiment
params <- read.exp.parameters(param_file_name="../data/context_permeability/scale-free_networks/param-space_2014-05-30_18:38:14experiment:1_.csv")

#read the adata related to consensus was achieved before 
library(data.table)
convergence_data <- fread("../data/context_permeability/scale-free_networks/consensus_achieved.csv")
convergence_data <- as.data.frame(convergence_data)[,-ncol(convergence_data)]
convergence_data <- merge(convergence_data, params, by="cfg.id")

We can now create a table to display the percentage of convergences to total consensus for each value of d and number of networks.

#filter some things out
fcdata <- melt.data.frame(convergence_data,id.vars=c("cfg.id","run","num.networks","network.0.d"), measure.vars=c("consensus-achieved"))

#I can also cast to obtain multiple values like summary 
#this will be useful later for the table with the number of encounters
#convergence_table <- cast(fcdata, num.networks~network.0.k~value, sum)

#convergence_table

fcdata_table <- aggregate(data=fcdata, fcdata$value~num.networks + fcdata$network.0.d, FUN=sum)
colnames(fcdata_table) <- c("num.networks", "d", "value")

 #create a pretty table for latex
latex_table <- tabular(cast(fcdata_table, num.networks~d, value="value"))
html(latex_table)
  d
num.networks 1 2 3 4 5
1 0 30 88 99 100
2 35 98 97 100 100
3 76 99 99 100 100
4 96 100 100 100 100
5 97 100 100 100 100 
#I can also save this table to a file for later reference
latex(latex_table,file="tex/scale-free_convergence.tex", booktabs=T, )

Number of Encounters for Scale-Free Networks

Now we analise the number of encouters necessary to achieve consensus. Or the total number of encounters that were performed if consensus was not achieved. The data for the encounters contains the following variables.

encounter_data <- fread("../data/context_permeability/scale-free_networks/num_encounters.csv")
encounter_data <- as.data.frame(encounter_data)[,-ncol(encounter_data)]
head(encounter_data)
##   step run cfg.id total-encounters
## 1 2000   3      1           200000
## 2 2000   7      1           200000
## 3 2000   8      1           200000
## 4 2000   1      1           200000
## 5 2000   5      1           200000
## 6 2000   2      1           200000

To get the information for how many networks were in the simulation and what was the d value, we can merge the data like we have done previously.

encounter_data <- merge(encounter_data, params, by="cfg.id")

We now filter some of the variables out.

#filter some things out
fedata <- melt.data.frame(encounter_data,id.vars=c("cfg.id","run","num.networks","network.0.d"), measure.vars=c("total-encounters"))
head(fedata)
##   cfg.id run num.networks network.0.d         variable  value
## 1      1   3            1           1 total-encounters 200000
## 2      1   7            1           1 total-encounters 200000
## 3      1   8            1           1 total-encounters 200000
## 4      1   1            1           1 total-encounters 200000
## 5      1   5            1           1 total-encounters 200000
## 6      1   2            1           1 total-encounters 200000
#create a table with avg and sd
cast_fedata_table <- cast(data=fedata, formula=network.0.d~num.networks, c(mean, sd))

fedata_table_full <- tabular(cast_fedata_table)

Create the tables

#to print the table created with tabular

html(fedata_table_full)
  num.networks
  1 2 3 4 5
  result_variable result_variable result_variable result_variable result_variable
network.0.d mean sd mean sd mean sd mean sd mean sd
1 200000 0 141085 83720 66020 82601 17712 42444 14917 38343.6
2 150632 78710 21654 41341 7555 21407 5890 10889 3638 5127.0
3 37824 64073 12309 36441 5299 20035 2804 3791 2618 2445.4
4 13751 33295 4846 7921 2852 2766 2370 1441 2200 1433.4
5 8802 18754 2536 1880 3204 11008 2166 1269 1958 971.6 
#print this to a file to use in the paper

Hmisc::latex(fedata_table_full, file="tex/scale-free_encounters_full.tex",booktabs=T)

Now to observe the distribution of the number of encounters, necessary to achieve consensus, we look at the box plots for d = {1,2,3,4,5}. We look at configurations with a number of networks > 3 since less networks more connectivity to allow consensus to be reached 100% of the time.

plot <- plot.exp.box(data=fedata,x_factor=as.factor(fedata$num.networks), data_y=fedata$value, fill_factor=as.factor(fedata$network.0.d),fill_label="d", x_label="Number of Networks", y_label="Number of Encounters")

plot

plot of chunk unnamed-chunk-26

#print to pdf
pdf(paste("./pdf/","context_permeability_encounters_sf.pdf"), width=7, height=5)
plot
dev.off()
## pdf 
##   2

Focusing on the runs where the number of encounters was < 2000 (some outliers are not present, see previous plots for that)

fedata <- fedata[fedata$"num.networks" >= 3 & fedata$"network.0.d" > 1 & fedata$"value" < 10000, ]
plot <- plot.exp.box(data=fedata,x_factor=as.factor(fedata$num.networks), data_y=fedata$value, fill_factor=as.factor(fedata$network.0.d),fill_label="d", x_label="Number of Networks", y_label="Number of Encounters")

plot

plot of chunk unnamed-chunk-27

Convergence for Heterogeneous Configuration (K-Regular Network + Scale-free Network)

Now we analyse what happens when we use an heterogenous configuration, this is, each layer in the model uses different network models. In a first experiment, we use a K-Regular network for one layer and a Scale-free network for the other.

#Read the Parameters for this experiment
params <- read.exp.parameters(param_file_name="../data/context_permeability/scale-free_regular/param-space_2014-05-30_18:40:41experiment:2_.csv")

#read the adata related to consensus was achieved before 

convergence_data <- fread("../data/context_permeability/scale-free_regular/consensus_achieved.csv")
convergence_data <- as.data.frame(convergence_data)[,-ncol(convergence_data)]
convergence_data <- merge(convergence_data, params, by="cfg.id")

We can now create a table to display the percentage of convergences to total consensus for each value of k and d. The number of networks in this experiment is allways 2.

#filter some things out
fcdata <- melt.data.frame(convergence_data,id.vars=c("cfg.id","run","network.0.k","network.1.d"), measure.vars=c("consensus-achieved"))

#convergence_table

fcdata_table <- aggregate(data=fcdata, fcdata$value~network.1.d + fcdata$network.0.k, FUN=sum)
colnames(fcdata_table) <- c("d", "k", "value")

 #create a pretty table for latex
latex_table <- tabular(cast(fcdata_table, d~k, value="value"))
html(latex_table)
  k
d 1 2 3 4 5 10 20 30 40 50
1 18 47 55 67 61 76 77 81 75 82
2 63 72 88 89 90 97 100 100 99 100
3 77 86 87 97 98 99 98 99 100 100
4 73 92 92 97 96 96 99 100 100 100
5 87 85 94 94 98 99 100 100 100 100 
#I can also save this table to a file for later reference
latex(latex_table,file="tex/regular_scale-free_convergence.tex", booktabs=T, )

This table shows the percentage of simulation runs that converged to total consensus over 100 independent runs.

Number of Encounters for Heterogeneous Configuration (K-Regular Network + Scale-free Network)

In this section, we analise the number of encouters necessary to achieve consensus with this heterogenous setup. The data for the encounters contains the following variables.

encounter_data <- fread("../data/context_permeability/scale-free_regular/num_encounters.csv")
encounter_data <- as.data.frame(encounter_data)[,-ncol(encounter_data)]
head(encounter_data)
##   step run cfg.id total-encounters
## 1 2000   4      1           200000
## 2 2000   1      1           200000
## 3 2000   2      1           200000
## 4 2000   6      1           200000
## 5 2000   5      1           200000
## 6 2000   3      1           200000

To get the information for the d and k values we can merge the data with the parameter space

encounter_data <- merge(encounter_data, params, by="cfg.id")

We now filter some of the variables out.

#filter some things out
fedata <- melt.data.frame(encounter_data,id.vars=c("cfg.id","run","network.0.k","network.1.d"), measure.vars=c("total-encounters"))
head(fedata)
##   cfg.id run network.0.k network.1.d         variable  value
## 1      1   4           1           1 total-encounters 200000
## 2      1   1           1           1 total-encounters 200000
## 3      1   2           1           1 total-encounters 200000
## 4      1   6           1           1 total-encounters 200000
## 5      1   5           1           1 total-encounters 200000
## 6      1   3           1           1 total-encounters 200000
#filter encounter data include only num networks > 3
fedata_net1 <- fedata[fedata$network.0.k <= 5,]

fedata_net10 <- fedata[fedata$network.0.k > 5,]



#create a table with avg and sd
cast_fedata_table <- cast(data=fedata, formula=network.0.k~network.1.d, c(mean, sd))

fedata_table_full <- tabular(cast_fedata_table)

Create the tables

#to print the table created with tabular

html(fedata_table_full)
  network.1.d
  1 2 3 4 5
  result_variable result_variable result_variable result_variable result_variable
network.0.k mean sd mean sd mean sd mean sd mean sd
1 173312 61519 100175 88406 63191 81071 73715 84549 51313 67704
2 118591 90107 72054 86077 43308 70318 31756 58760 43281 72182
3 109155 88722 38270 66714 34899 65533 26412 55589 23436 49978
4 80035 88719 33339 64075 21289 45725 15575 39516 24034 52407
5 89179 91823 31044 62485 13908 36791 14112 39490 9252 28404
10 62416 81036 11017 35071 9095 27266 12182 39798 5559 20448
20 61371 81409 6680 17900 6944 27826 4721 19832 2390 2313
30 51559 77468 4980 12740 5095 20028 2268 1355 2046 1225
40 58625 83049 5483 20169 2726 3735 2346 1503 2412 1874
50 48702 74718 6568 22611 2566 1716 2362 1619 1980 1081 
#print this to a file to use in the paper

Hmisc::latex(fedata_table_full, file="tex/regular_scale-free_encounters_full.tex",booktabs=T)

Now to observe the distribution of the number of encounters, necessary to achieve consensus, we look at the box plots for k = {1,2,3,4,5} and k = {10,20,30,40,50} respectively.

plot <- plot.exp.box(data=fedata_net1,x_factor=as.factor(fedata_net1$network.1.d), data_y=fedata_net1$value, fill_factor=as.factor(fedata_net1$network.0.k),fill_label="K", x_label="D", y_label="Number of Encounters")

plot

plot of chunk unnamed-chunk-35

#print to pdf
pdf(paste("./pdf/","context_permeability_encounters_sfreg_k12345.pdf"), width=7, height=5)
plot
dev.off()
## pdf 
##   2
plot <- plot.exp.box(data=fedata_net10,x_factor=as.factor(fedata_net10$network.1.d), data_y=fedata_net10$value, fill_factor=as.factor(fedata_net10$network.0.k),fill_label="K", x_label="D", y_label="Number of Encounters")

plot

plot of chunk unnamed-chunk-35

#print to pdf
pdf(paste("./pdf/","context_permeability_encounters_sfreg_k1020304050.pdf"), width=7, height=5)
plot
dev.off()
## pdf 
##   2

Focusing now on the best performing configurations and on the runs that produced a convergence in less than 50000 encounters, the distribution of the number of encounters is as follows.

fedata_net10 <- fedata_net10[fedata_net10$"network.1.d" > 1 & fedata_net10$value <= 10000,]

plot <- plot.exp.box(data=fedata_net10,x_factor=as.factor(fedata_net10$network.1.d), data_y=fedata_net10$value, fill_factor=as.factor(fedata_net10$network.0.k),fill_label="K", x_label="D", y_label="Number of Encounters")

plot

plot of chunk unnamed-chunk-36

#print to pdf
pdf(paste("./pdf/","context_permeability_encounters_sfreg_k1020304050_best.pdf"), width=7, height=5)
plot
dev.off()
## pdf 
##   2

Heterogeneous Network Properties

In this section we analyse the properties of this heterogenous setup. This is, what happens when you mix k-regular networks with a scale-free network.

network_data <- fread("../data/context_permeability/scale-free_regular/networks.csv")
#filter the data, we just need the data from one simulation run
network_data <- network_data[network_data$"cfg.id" == fedata_net10[1,]$"cfg.id" & network_data$"run" == fedata_net10[1,]$"run",]

k_regular_network <- read.single.network(data=network_data, layer=0)
scale_free_network <- read.single.network(data=network_data, layer=1)
combined_network <- k_regular_network + scale_free_network

We combine a 10-Regular and a Scale-free network from the previous experiment (D = 2) by merging the overllaping edges.

network1 <- k_regular_network
network2 <- scale_free_network


color1 <- "#7D9C9F"
color2 <- "#B1B1B1"
color_over <- "#FF003F"

E(network1)$color <- color1
E(network2)$color <- color2

el1 <- apply(get.edgelist(network1), 1, paste, collapse="-")
el2 <- apply(get.edgelist(network2), 1, paste, collapse="-")
elc <- apply(get.edgelist(combined_network), 1, paste, collapse="-")

E(combined_network)$color <- ifelse((elc %in% el1) & (elc %in% el2), color_over, ifelse((elc %in% el1), color1, color2))

par(mfrow=c(1,3))
plot(network1,vertex.size = 2, vertex.label=NA, layout =   layout.kamada.kawai, main="10-Regular Network")
plot(network2,vertex.size = 2, vertex.label=NA, layout =   layout.kamada.kawai, main="Scale-Free with D = 2")
plot(combined_network,vertex.size = 2, vertex.label=NA, layout =   layout.kamada.kawai, main="Combined Networks")

plot of chunk unnamed-chunk-38

#print to pdf
pdf(paste("./pdf/","network_properties_10regular_2scale-free.pdf"), width=15, height=5)
par(mfrow=c(1,3))
plot(network1,vertex.size = 2, vertex.label=NA, layout =   layout.kamada.kawai, main="10-Regular Network")
plot(network2,vertex.size = 2, vertex.label=NA, layout =   layout.kamada.kawai, main="Scale-Free with D = 2")
plot(combined_network,vertex.size = 2, vertex.label=NA, layout =   layout.kamada.kawai, main="Combined Networks")
dev.off()

pdf 2

We now plot the degree distribution using a log scale. We do this for the 10-Regular Network, the Scale-Free Network with d = 2, and the combined network.

par(mfrow=c(1,3))
plot.degree.distribution(network=k_regular_network, "10-Regular Network")
## $breaks
## [1] 2 4
## 
## $counts
## [1] 100
## 
## $density
## [1] 0.5
## 
## $mids
## [1] 3
## 
## $xname
## [1] "log(distribution + 1)"
## 
## $equidist
## [1] TRUE
## 
## attr(,"class")
## [1] "histogram"
plot.degree.distribution(network=scale_free_network, "Scale-Free Network with D = 2")
## $breaks
## [1] 1.0 1.5 2.0 2.5 3.0 3.5 4.0
## 
## $counts
## [1] 65 25  6  3  0  1
## 
## $density
## [1] 1.30 0.50 0.12 0.06 0.00 0.02
## 
## $mids
## [1] 1.25 1.75 2.25 2.75 3.25 3.75
## 
## $xname
## [1] "log(distribution + 1)"
## 
## $equidist
## [1] TRUE
## 
## attr(,"class")
## [1] "histogram"
plot.degree.distribution(network=combined_network, "Combined network")

plot of chunk unnamed-chunk-39

## $breaks
##  [1] 3.0 3.1 3.2 3.3 3.4 3.5 3.6 3.7 3.8 3.9
## 
## $counts
## [1] 21 57 15  2  3  0  1  0  1
## 
## $density
## [1] 2.1 5.7 1.5 0.2 0.3 0.0 0.1 0.0 0.1
## 
## $mids
## [1] 3.05 3.15 3.25 3.35 3.45 3.55 3.65 3.75 3.85
## 
## $xname
## [1] "log(distribution + 1)"
## 
## $equidist
## [1] TRUE
## 
## attr(,"class")
## [1] "histogram"
pdf(paste("./pdf/","network_properties_10regular_2scale-free_degree_dist.pdf"), width=15, height=5)
par(mfrow=c(1,3))
plot.degree.distribution(network=k_regular_network, "10-Regular Network")
## $breaks
## [1] 2 4
## 
## $counts
## [1] 100
## 
## $density
## [1] 0.5
## 
## $mids
## [1] 3
## 
## $xname
## [1] "log(distribution + 1)"
## 
## $equidist
## [1] TRUE
## 
## attr(,"class")
## [1] "histogram"
plot.degree.distribution(network=scale_free_network, "Scale-Free Network with D = 2")
## $breaks
## [1] 1.0 1.5 2.0 2.5 3.0 3.5 4.0
## 
## $counts
## [1] 65 25  6  3  0  1
## 
## $density
## [1] 1.30 0.50 0.12 0.06 0.00 0.02
## 
## $mids
## [1] 1.25 1.75 2.25 2.75 3.25 3.75
## 
## $xname
## [1] "log(distribution + 1)"
## 
## $equidist
## [1] TRUE
## 
## attr(,"class")
## [1] "histogram"
plot.degree.distribution(network=combined_network, "Combined network")
## $breaks
##  [1] 3.0 3.1 3.2 3.3 3.4 3.5 3.6 3.7 3.8 3.9
## 
## $counts
## [1] 21 57 15  2  3  0  1  0  1
## 
## $density
## [1] 2.1 5.7 1.5 0.2 0.3 0.0 0.1 0.0 0.1
## 
## $mids
## [1] 3.05 3.15 3.25 3.35 3.45 3.55 3.65 3.75 3.85
## 
## $xname
## [1] "log(distribution + 1)"
## 
## $equidist
## [1] TRUE
## 
## attr(,"class")
## [1] "histogram"
dev.off()
## pdf 
##   2

Regular / Scale-Free / Scale-Free Configuration

We look at a final heterogeneous configuration. In this experiment we used 1 K-Regular network and 2 Scale-Free Networks with varying k and d parameters. To analyse the convergence and number of encounters to achieve consensus, we consider homogenous parameter configurations for scale-free networks (the same value of d for both networks).

CONVERGENCE FOR REG/SF/SF

#Read the Parameters for this experiment
params <- read.exp.parameters(param_file_name="../data/context_permeability/scale-free_scale-free_regular/param-space_2014-05-30_18:43:13experiment:2_.csv")

#read the adata related to consensus was achieved before 
convergence_data <- fread("../data/context_permeability/scale-free_scale-free_regular/consensus_achieved.csv")
convergence_data <- as.data.frame(convergence_data)[,-ncol(convergence_data)]
convergence_data <- merge(convergence_data, params, by="cfg.id")

We can now create a table to display the percentage of convergences to total consensus for each value of k and d. The number of networks in this experiment is allways 2.

#filter some things out
fcdata <- melt.data.frame(convergence_data,id.vars=c("cfg.id","run","network.0.k","network.1.d", "network.2.d"), measure.vars=c("consensus-achieved"))

#filter the data and get the data for homogenous d configurations (network.1.d == network.2.d)
fcdata <- fcdata[fcdata$"network.1.d" == fcdata$"network.2.d",]

#convergence_table

fcdata_table <- aggregate(data=fcdata, fcdata$value~network.1.d + fcdata$network.0.k, FUN=sum)
colnames(fcdata_table) <- c("d", "k", "value")

 #create a table for latex
latex_table <- tabular(cast(fcdata_table, d~k, value="value"))

Display the table in html and print it to a file:

html(latex_table)
  k
d 1 2 3 4 5 10 20 30 40 50
1 74 85 85 92 93 94 94 91 91 96
2 94 97 99 100 99 99 100 100 99 100
3 97 99 99 100 99 100 100 100 100 100
4 99 100 100 100 100 100 100 100 100 100
5 100 100 98 100 100 100 100 100 100 100 
#I can also save this table to a file for later reference
latex(latex_table,file="tex/regular_scale-free_scale-free_convergence.tex", booktabs=T, )

This table shows the percentage of simulation runs that converged to total consensus over 100 independent runs.

Number of Encounters for REG/SF/SF

In this section, we analise the number of encouters necessary to achieve consensus with this heterogenous setup. The data for the encounters contains the following variables.

encounter_data <- fread("../data/context_permeability/scale-free_scale-free_regular/num_encounters.csv")
encounter_data <- as.data.frame(encounter_data)[,-ncol(encounter_data)]
head(encounter_data)
##   step run cfg.id total-encounters
## 1   39   4      1             3900
## 2   71   8      1             7100
## 3   91   2      1             9100
## 4  155   6      1            15500
## 5   67   9      1             6700
## 6  131  10      1            13100

To get the information for the d and k values we can merge the data with the parameter space

encounter_data <- merge(encounter_data, params, by="cfg.id")

We now filter some of the variables out.

#filter some things out
fedata <- melt.data.frame(encounter_data,id.vars=c("cfg.id","run","network.0.k","network.1.d","network.2.d"), measure.vars=c("total-encounters"))
head(fedata)
##   cfg.id run network.0.k network.1.d network.2.d         variable value
## 1      1   4           1           1           1 total-encounters  3900
## 2      1   8           1           1           1 total-encounters  7100
## 3      1   2           1           1           1 total-encounters  9100
## 4      1   6           1           1           1 total-encounters 15500
## 5      1   9           1           1           1 total-encounters  6700
## 6      1  10           1           1           1 total-encounters 13100
#filter the data and get the data for homogenous d configurations (network.1.d == network.2.d)
fedata <- fedata[fedata$"network.1.d" == fedata$"network.2.d",]

#split the data into two partitions k<=5 and k>5
fedata_net1 <- fedata[fedata$network.0.k <= 5,]
fedata_net10 <- fedata[fedata$network.0.k > 5,]

#create a table with avg and sd
cast_fedata_table <- cast(data=fedata, formula=network.0.k~network.1.d, c(mean, sd))
fedata_table_full <- tabular(cast_fedata_table)

Create the tables:

#to print the table created with tabular
html(fedata_table_full)
  network.1.d
  1 2 3 4 5
  result_variable result_variable result_variable result_variable result_variable
network.0.k mean sd mean sd mean sd mean sd mean sd
1 74046 83329 22728 49046 13533 37543 8019 21971 8236 22440
2 40581 69103 17555 41600 8733 23959 4794 8275 4436 8629
3 44017 71382 8623 23087 5875 20313 4652 15028 6954 27907
4 30690 57132 5222 10111 4376 8190 3496 4182 4226 11201
5 23171 50539 7609 22881 5103 19961 3552 4217 3190 5772
10 24208 50403 6701 21395 2770 2092 2816 2926 2254 1489
20 22522 48657 4996 9163 2880 2508 2420 2016 2278 2011
30 26393 58501 3328 6265 2356 1798 2204 1367 2114 1241
40 27021 56626 5277 19989 2348 1476 2262 1317 2160 1108
50 18120 41733 3484 3988 3566 5620 2172 1636 2162 1387 
#print this to a file to use in the paper
Hmisc::latex(fedata_table_full, file="tex/regular_scale-free_scale_free_encounters_full.tex",booktabs=T)

Now to observe the distribution of the number of encounters, necessary to achieve consensus, we look at the box plots for k = {1,2,3,4,5} and k = {10,20,30,40,50} respectively.

plot <- plot.exp.box(data=fedata_net1,x_factor=as.factor(fedata_net1$network.1.d), data_y=fedata_net1$value, fill_factor=as.factor(fedata_net1$network.0.k),fill_label="K", x_label="D", y_label="Number of Encounters")

plot

plot of chunk unnamed-chunk-47

#print to pdf
pdf(paste("./pdf/","context_permeability_encounters_reg_sf_sf_k12345.pdf"), width=7, height=5)
plot
dev.off()
## pdf 
##   2
plot <- plot.exp.box(data=fedata_net10,x_factor=as.factor(fedata_net10$network.1.d), data_y=fedata_net10$value, fill_factor=as.factor(fedata_net10$network.0.k),fill_label="K", x_label="D", y_label="Number of Encounters")

plot

plot of chunk unnamed-chunk-47

pdf(paste("./pdf/","context_permeability_encounters_reg_sf_sf_k1020304050.pdf"), width=7, height=5)
plot
dev.off()
## pdf 
##   2

Focusing now on the best performing configurations and on the runs that produced a convergence in less than 50000 encounters, the distribution of the number of encounters is as follows.

fedata_net10 <- fedata_net10[fedata_net10$"network.1.d" > 1 & fedata_net10$value <= 10000,]

plot <- plot.exp.box(data=fedata_net10,x_factor=as.factor(fedata_net10$network.1.d), data_y=fedata_net10$value, fill_factor=as.factor(fedata_net10$network.0.k),fill_label="K", x_label="D", y_label="Number of Encounters")

plot

plot of chunk unnamed-chunk-48

pdf(paste("./pdf/","context_permeability_encounters_reg_sf_sf_best.pdf"), width=7, height=5)
plot
dev.off()
## pdf 
##   2