Context Switching

In this set of experiments we analyse a new multi-context model with a binary opinion dynamics game. In this case, the difference between the context switching model and the context permeability one is that agents no longer interact in the multiple networks at the same time (being able to select any neighbour at a given simulation step) but rather become active in one network at a time. Agents are also able to switch to a different network at the end of each interaction with a partner. The agent switches based on a probability associated with the current network in which it is currently active.

First, we look at the influece of the new parameter in the convergence to consensus. We span the switching probability parameter between the values 0 and 1 with intervals of 0.05. We do this for 2 networks with k-regular and scale-free topologies.

We then freeze the switching probabilities and vary the number of networks. We compare the results with the context permeability in terms of average number of encounters to achieve consensus.

We will start by loading the dependencies for this report.

source("../R/experiment_utils.R")

## Loading required package: ggplot2

library(data.table)
library(reshape2)
library(ggplot2)

Switching Probability Span

We set the number of networks for 2 and span the switching probabilities for each network between 0 and 1 in intervals of 0.05.

We will use the following procedures to construct the contour plots and perspective “3D” plots.

analyse_contour <- function(paramfile, encountersfile, net1label, net2label){
  #Read the Parameters for this experiment
  params <- read.exp.parameters(param_file_name=paramfile)

  #read data for number of encounters
  encounter_data <- fread(encountersfile)
  encounter_data <- as.data.frame(encounter_data)[,-ncol(encounter_data)]

  #merge with configuration context switching values
  encounter_data <- merge(encounter_data, params[,c("cfg.id","network.0.cs","network.1.cs")], by="cfg.id")

  #melt data to use cast
  melted_encounters <- melt(encounter_data,id.vars=c("cfg.id","run","network.0.cs","network.1.cs"), measure.vars=c("total-encounters"))

  #aggregate encounter data 
  agg_encounters <- aggregate(melted_encounters$value,by=list(melted_encounters$network.0.cs,melted_encounters$network.1.cs),mean)
  colnames(agg_encounters) <- c("cs0","cs1","value")

  #create a contour plot to visualize the data

  #breaks in the contour
  brks <- c(0,5000,10000, seq(20000,200000, by=50000),max(agg_encounters$"value"))
  guide_title <- "Average Encounters"

  encouters_contour <- create_contour_span(span = agg_encounters, brks = brks, guide_title = guide_title,xlab=net1label, ylab=net2label)
  pdf(paste("./pdf/",output_prefix,"_switching_contour.pdf"), width=7, height=5)
  par(mfrow=c(1,1))
  print(encouters_contour)

  dev.off() 
  print(encouters_contour)
  gc()
}

analyse_persp <- function(paramfile, encountersfile,output_prefix,net1label,net2label){
  #Read the Parameters for this experiment
  params <- read.exp.parameters(param_file_name=paramfile)

  #read data for number of encounters
  encounter_data <- fread(encountersfile)
  encounter_data <- as.data.frame(encounter_data)[,-ncol(encounter_data)]


  #merge with configuration context switching values 
  encounter_data <- merge(encounter_data, params[,c("cfg.id","network.0.cs","network.1.cs")], by="cfg.id")
 
  #melt data to use cast
  melted_encounters <- melt(encounter_data,id.vars=c("cfg.id","run","network.0.cs","network.1.cs"), measure.vars=c("total-encounters"))
 
  #reshape the data to display average number of encounters
  encounter_table <- dcast(data=melted_encounters, network.0.cs~network.1.cs, mean)
  
  #average encounters as a matrix
  encounter_matrix <- as.matrix(encounter_table[,-1])
  colnames(encounter_matrix) <- c()
  
  xlab<- net1label
  ylab<- net2label
  zlab<-"\n\n\n Avg. Encounters"
  
  pdf(paste("./pdf/",output_prefix,"_switching_persp.pdf"), width=15, height=5)
  par(mfrow=c(1,3))
  plot_persp_span(x = seq(0,1,0.05), y = seq(0,1,0.05),data_matrix = encounter_matrix, breaks=log(c(1:10)),xlab=xlab,ylab=ylab,zlab = zlab)
  
  plot_persp_span(x = seq(0.2,1,0.05), y = seq(0.2,1,0.05),data_matrix = encounter_matrix[-c(1:4),-c(1:4)], breaks=log(c(1:10)),xlab=xlab,ylab=ylab,zlab = zlab)
  
  plot_persp_span(x = seq(0.4,1,0.05), y = seq(0.4,1,0.05),data_matrix = encounter_matrix[-c(1:8),-c(1:8)], breaks=log(c(1:10)),xlab=xlab,ylab=ylab,zlab = zlab)
  
  dev.off() 
  par(mfrow=c(1,3))
  plot_persp_span(x = seq(0,1,0.05), y = seq(0,1,0.05),data_matrix = encounter_matrix, breaks=log(c(1:10)),xlab=xlab,ylab=ylab,zlab = zlab)
  
  plot_persp_span(x = seq(0.2,1,0.05), y = seq(0.2,1,0.05),data_matrix = encounter_matrix[-c(1:4),-c(1:4)], breaks=log(c(1:10)),xlab=xlab,ylab=ylab,zlab = zlab)
  
  plot_persp_span(x = seq(0.4,1,0.05), y = seq(0.4,1,0.05),data_matrix = encounter_matrix[-c(1:8),-c(1:8)], breaks=log(c(1:10)),xlab=xlab,ylab=ylab,zlab = zlab)
  
  zlab<-"\n\n\n Log(Avg. Encounters)"
  pdf(paste("./pdf/",output_prefix,"_switching_log_persp.pdf"), width=5, height=5)
  plot_persp_span(x = seq(0,1,0.05), y = seq(0,1,0.05),data_matrix = log(encounter_matrix), breaks=log(c(1:10)),xlab=xlab,ylab=ylab,zlab=zlab,pallete="PRGn")
  dev.off()
  plot_persp_span(x = seq(0,1,0.05), y = seq(0,1,0.05),data_matrix = log(encounter_matrix), breaks=log(c(1:10)),xlab=xlab,ylab=ylab,zlab=zlab,pallete="PRGn")
}

2 10-Regular Networks

params <- "../data/context_switching/switching_span/2 10-regular networks/param-space_2014-06-17_15:44:50experiment:10_.csv"
encounters <- "../data/context_switching/switching_span/2 10-regular networks/num_encounters.csv"

output_prefix <- "context_switching_2_10_regular"

net1label <- "\n\nSwitching for Network 1 \n regular network, k=10"
net2label <- "\n\nSwitching for Network 2 \n regular network, k=10"

analyse_contour(params, encounters,net1label,net2label)

## Loading required package: RColorBrewer
## Loading required package: directlabels
## Loading required package: grid
## Loading required package: quadprog
## Loading required package: proto

##           used (Mb) gc trigger (Mb) max used (Mb)
## Ncells  555351 29.7     984024 52.6   984024 52.6
## Vcells 1293164  9.9    2582572 19.8  2582571 19.8

analyse_persp(params, encounters,output_prefix,net1label,net2label)

##            [,1]    [,2]    [,3]    [,4]
## [1,] -1.414e+00 -1.0000  1.0000 -1.0000
## [2,]  1.414e+00 -1.0000  1.0000 -1.0000
## [3,] -2.036e-17  0.3326  0.3326 -0.3326
## [4,]  1.110e-16 -2.3522 -7.0843  8.0843

Note I don’t need custom breaks for some persp plots, its simpler to apply a logarithm to a set of n numbers, normalize them inside the plotting function, and multiply this by the maximum value in the dataset, this gets me the effect I’m looking for both the filling and contour lines.

2 30-Regular Networks

params <- "../data/context_switching/switching_span/2 30-regular networks/param-space_2014-06-20_20:25:18experiment:10_.csv"
encounters <- "../data/context_switching/switching_span/2 30-regular networks/num_encounters.csv"
output_prefix <- "context_switching_2_30_regular"

net1label <- "\n\nSwitching for Network 1 \n regular network, k=30"
net2label <- "\n\nSwitching for Network 2 \n regular network, k=30"

analyse_contour(params, encounters,net1label,net2label)

##           used (Mb) gc trigger (Mb) max used (Mb)
## Ncells  565057 30.2     984024 52.6   984024 52.6
## Vcells 1388198 10.6    2791700 21.3  2791700 21.3

As we can see, increasing the connectivity of the agents makes so that the switching probability values are no longer as important to the speed of convergence to total concensus. The clustering coefficient for the merged networks is significantly higher for k = 30 than for k = 10. This is especially true for a number of networks = 2 (see network properties). The average path length is also lower for k=30 although this difference is not as drastic (for 2 networks) as in the clustering coefficient.

analyse_persp(params, encounters,output_prefix,net1label,net2label)

##            [,1]    [,2]    [,3]    [,4]
## [1,] -1.414e+00 -1.0000  1.0000 -1.0000
## [2,]  1.414e+00 -1.0000  1.0000 -1.0000
## [3,] -2.048e-17  0.3345  0.3345 -0.3345
## [4,]  0.000e+00 -2.1790 -6.9110  7.9110

2 Scale-Free Networks with D=1

params <- "../data/context_switching/switching_span/2 scale-free networks d=1/param-space_2014-06-17_15:58:29experiment:11_.csv"
encounters <- "../data/context_switching/switching_span/2 scale-free networks d=1/num_encounters.csv"
output_prefix <- "context_switching_2_sf_d1"

net1label <- "\n\nSwitching for Network 1 \n scale-free network, d=1"
net2label <- "\n\nSwitching for Network 2 \n scale-free network, d=1"

analyse_contour(params, encounters,net1label,net2label)

##           used (Mb) gc trigger (Mb) max used (Mb)
## Ncells  565258 30.2     984024 52.6   984024 52.6
## Vcells 1487238 11.4    3011285 23.0  3011283 23.0

analyse_persp(params, encounters,output_prefix,net1label,net2label)

##            [,1]    [,2]    [,3]   [,4]
## [1,] -1.414e+00  -1.000   1.000 -1.000
## [2,]  1.414e+00  -1.000   1.000 -1.000
## [3,] -1.031e-16   1.684   1.684 -1.684
## [4,]  1.110e-15 -18.853 -23.585 24.585

2 Scale-Free Networks with D=5

params <- "../data/context_switching/switching_span/2 scale-free networks d=5/param-space_2014-06-25_11:38:56experiment:11_.csv"
encounters <- "../data/context_switching/switching_span/2 scale-free networks d=5/num_encounters.csv"
output_prefix <- "context_switching_2_sf_d5"

net1label <- "\n\nSwitching for Network 1 \n scale-free network, d=5"
net2label <- "\n\nSwitching for Network 2 \n scale-free network, d=5"

analyse_contour(params, encounters,net1label,net2label)

##           used (Mb) gc trigger (Mb) max used (Mb)
## Ncells  565176 30.2     984024 52.6   984024 52.6
## Vcells 1600282 12.3    3483941 26.6  3483941 26.6

With 2 scale-free networks with d=5, similarly to the 2 k-regular networks, switching is less important to achieve faster consensus. The main difference is that the number of edges is nowhere near the number of edges of 30-regular networks for 100 agents. With the 30-regular networks we generate 30 edges per agent (a total of 3000 edges since we have 100 agents). With the scale-free, with each agent we add 5 edges, which gives us a total of 500 edges. So this effect is not related to the connectivity of the agents but rather to the properties of the underlying structure. The clustering coefficient for d=1 for instance is 0–the network is basically a forest (a set of tree graphs)–, with d=5 this is no longer the case. For d=1 the average path length of scale-frees is already lower than a regular network with k within the values [1,5].

analyse_persp(params, encounters,output_prefix,net1label,net2label)

##            [,1]    [,2]    [,3]    [,4]
## [1,] -1.414e+00 -1.0000  1.0000 -1.0000
## [2,]  1.414e+00 -1.0000  1.0000 -1.0000
## [3,] -1.963e-17  0.3206  0.3206 -0.3206
## [4,]  0.000e+00 -2.1863 -6.9183  7.9183

Scale-Free Network with D=5 and Scale-free Network with D=1

params <- "../data/context_switching/switching_span/scale-free d=1 scale-free d=5/param-space_2014-07-22_20:33:49experiment:12_.csv"
encounters <- "../data/context_switching/switching_span/scale-free d=1 scale-free d=5/num_encounters.csv"
output_prefix <- "context_switching_sf_d5_d1"

net1label <- "\n\nSwitching for Network 1 \n scale-free network, d=5"
net2label <- "\n\nSwitching for Network 2 \n scale-free network, d=1"

analyse_contour(params, encounters,net1label,net2label)

##           used (Mb) gc trigger (Mb) max used (Mb)
## Ncells  565352 30.2     984024 52.6   984024 52.6
## Vcells 1704502 13.1    3483941 26.6  3483941 26.6

analyse_persp(params, encounters,output_prefix,net1label,net2label)

##            [,1]    [,2]    [,3]    [,4]
## [1,] -1.414e+00 -1.0000  1.0000 -1.0000
## [2,]  1.414e+00 -1.0000  1.0000 -1.0000
## [3,] -2.146e-17  0.3504  0.3504 -0.3504
## [4,]  1.110e-16 -2.5698 -7.3018  8.3018

1 10-Regular + 1 Scale-Free with D=1

In this experiment, network 1 has a 10-Regular Topology while network 2 has a scale-free topology with d=1.

params <- "../data/context_switching/switching_span/scale-free d=1 k-regular k=10/param-space_2014-06-17_16:06:26experiment:12_.csv"
encounters <- "../data/context_switching/switching_span/scale-free d=1 k-regular k=10/num_encounters.csv"

output_prefix <- "context_switching_1_10regular_1_scale-free_d1"

net1label <- "\n\nSwitching for Network 1 \n regular network, k=10"
net2label <- "\n\nSwitching for Network 2 \n scale-free network, d=1"

analyse_contour(params,encounters,net1label,net2label)

##           used (Mb) gc trigger (Mb) max used (Mb)
## Ncells  565430 30.2     984024 52.6   984024 52.6
## Vcells 1793518 13.7    3738138 28.6  3738075 28.6

analyse_persp(params, encounters,output_prefix,net1label,net2label)

##            [,1]    [,2]    [,3]    [,4]
## [1,] -1.414e+00 -1.0000  1.0000 -1.0000
## [2,]  1.414e+00 -1.0000  1.0000 -1.0000
## [3,] -3.308e-17  0.5402  0.5402 -0.5402
## [4,]  3.331e-16 -4.8866 -9.6186 10.6186

2 10-Regular Networks with 300 Agents

In the previous experiments we use 100 agents. This time, we use 300 agents to see the effect of context switching with slightly diferent network properties. The scale should not be important here but rather the conectivity pattern. I hypothesise that what influences the results the most with k-regular networks is the proportion of connections (given by 2k) versus the number of agents in the network.

params <- "../data/context_switching/switching_span/2 10-regular networks 300 agents/param-space_2014-06-23_23:48:11experiment:10_.csv"
encounters <- "../data/context_switching/switching_span/2 10-regular networks 300 agents/num_encounters.csv"

output_prefix <- "context_switching_2_10regular_300agents"

net1label <- "\n\nSwitching for Network 1 \n regular network, k=10, 300 agents"
net2label <- "\n\nSwitching for Network 1 \n regular network, k=10, 300 agents"

analyse_contour(params, encounters,net1label,net2label)

##           used (Mb) gc trigger (Mb) max used (Mb)
## Ncells  565437 30.2     984024 52.6   984024 52.6
## Vcells 1895887 14.5    3738138 28.6  3738138 28.6

We can observe that lower connectivity also means that the lower the switching probability the more important simetry is–if the network topologies are the same for both networks. It is the same for scale-free networks with d = 1.

analyse_persp(params, encounters,output_prefix,net1label,net2label)

##            [,1]    [,2]    [,3]    [,4]
## [1,] -1.414e+00 -1.0000  1.0000 -1.0000
## [2,]  1.414e+00 -1.0000  1.0000 -1.0000
## [3,] -2.954e-17  0.4824  0.4824 -0.4824
## [4,]  2.220e-16 -4.7108 -9.4429 10.4429

2 30-Regular Networks 300 Agents

We can see that the results for k = 30 and 300 agents are qualitatively similar to the results for k=10 and 100 agents.

params <- "../data/context_switching/switching_span/2 30-regular networks 300 agents/param-space_2014-06-24_01:00:58experiment:10_.csv"
encounters <- "../data/context_switching/switching_span/2 30-regular networks 300 agents/num_encounters.csv"

output_prefix <- "context_switching_2_30regular_300agents"

net1label <- "\n\nSwitching for Network 1 \n regular network, k=30, 300 agents"
net2label <- "\n\nSwitching for Network 1 \n regular network, k=30, 300 agents"

analyse_contour(params, encounters,net1label,net2label)

##           used (Mb) gc trigger (Mb) max used (Mb)
## Ncells  565433 30.2     984024 52.6   984024 52.6
## Vcells 2005790 15.4    4005044 30.6  4005043 30.6

analyse_persp(params, encounters,output_prefix,net1label,net2label)

##            [,1]    [,2]    [,3]    [,4]
## [1,] -1.414e+00 -1.0000  1.0000 -1.0000
## [2,]  1.414e+00 -1.0000  1.0000 -1.0000
## [3,] -2.043e-17  0.3336  0.3336 -0.3336
## [4,]  1.110e-16 -2.7244 -7.4565  8.4565

Results for Multiple-Networks and Comparison with Context Permeability

Comparison for K-Regular Networks

#**************************************************************************
#   read encounter results for context permeability (for comparison)
#**************************************************************************
params <- "../data/context_permeability/regular_networks/param-space_2014-07-23_11:40:44experiment:0_.csv"
encounters <- "../data/context_permeability/regular_networks/num_encounters.csv"

params <- read.exp.parameters(param_file_name=params)



encounter_data <- fread(encounters)
encounter_data <- as.data.frame(encounter_data)[,-ncol(encounter_data)]
#merge with configuration context switching values
encounter_data <- merge(encounter_data, params[,c("cfg.id","network.0.k","num.networks")], by="cfg.id")
head(encounter_data)

##   cfg.id step run total-encounters network.0.k num.networks
## 1      1 2000   6           200000           1            1
## 2      1 2000   4           200000           1            1
## 3      1 2000   3           200000           1            1
## 4      1 2000   8           200000           1            1
## 5      1 2000   7           200000           1            1
## 6      1 2000   5           200000           1            1

#melt data to use cast
melted_encounters <- melt(encounter_data,id.vars=c("cfg.id","run","network.0.k","num.networks"), measure.vars=c("total-encounters"))
head(melted_encounters)

##   cfg.id run network.0.k num.networks         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

permeability_encounters <- melted_encounters


#***************************************************************
#   read encounter results for context switching
#***************************************************************
params <- "../data/context_switching/multiple_networks/regular_networks/param-space_2014-06-22_00:33:19experiment:10_.csv"

encounters <- "../data/context_switching/multiple_networks/regular_networks/num_encounters.csv"

params <- read.exp.parameters(param_file_name=params)

encounter_data <- fread(encounters)
encounter_data <- as.data.frame(encounter_data)[,-ncol(encounter_data)]
head(encounter_data)

##   step run cfg.id total-encounters
## 1 2000   1      1           149930
## 2 2000   2      1           149907
## 3 2000   3      1           150297
## 4 2000   4      1           149696
## 5 2000   5      1           149517
## 6 2000   7      1           150143

#merge with configuration context switching values
encounter_data <- merge(encounter_data, params[,c("cfg.id","network.0.cs","network.0.k","num.networks")], by="cfg.id")
head(encounter_data)

##   cfg.id step run total-encounters network.0.cs network.0.k num.networks
## 1      1 2000   1           149930         0.25           1            2
## 2      1 2000   2           149907         0.25           1            2
## 3      1 2000   3           150297         0.25           1            2
## 4      1 2000   4           149696         0.25           1            2
## 5      1 2000   5           149517         0.25           1            2
## 6      1 2000   7           150143         0.25           1            2

#melt data to use cast
melted_encounters <- melt(encounter_data,id.vars=c("cfg.id","run","network.0.cs","network.0.k","num.networks"), measure.vars=c("total-encounters"))
head(melted_encounters)

##   cfg.id run network.0.cs network.0.k num.networks         variable  value
## 1      1   1         0.25           1            2 total-encounters 149930
## 2      1   2         0.25           1            2 total-encounters 149907
## 3      1   3         0.25           1            2 total-encounters 150297
## 4      1   4         0.25           1            2 total-encounters 149696
## 5      1   5         0.25           1            2 total-encounters 149517
## 6      1   7         0.25           1            2 total-encounters 150143

for(n in 2:5){
  #plot for 2 networks
  current_encounters<-melted_encounters[melted_encounters$"num.networks" == n,]
  perm_encounters<-permeability_encounters[permeability_encounters$"num.networks" == n,]

  plot_data <- dcast(current_encounters, network.0.k + network.0.cs ~ variable, mean)
  colnames(plot_data) <- c("k","cs","avg-encounters")
  
  perm_data <- dcast(perm_encounters, network.0.k ~ variable, mean)
  colnames(perm_data) <- c("k","avg-encounters")

  
  plot <- NULL
  
  plot <- ggplot(plot_data, aes(x=as.factor(plot_data$k), y=plot_data$"avg-encounters")) 
  plot <- plot +  geom_point(aes(shape=as.factor(plot_data$cs), color=as.factor(plot_data$cs)),size = 3.5)
  plot <- plot +  geom_line(aes(color=as.factor(plot_data$cs), group=as.factor(plot_data$cs), linetype=as.factor(plot_data$cs)),size=1)   
  #add line for permeability baseline
  plot <- plot + geom_point(data=perm_data, aes(x=as.factor(perm_data$k), y=perm_data$"avg-encounters", shape="permeability", color="permeability"),size = 3.5)
  plot <- plot + geom_line(data=perm_data, aes(x=as.factor(perm_data$k), y=perm_data$"avg-encounters", group="Permeability", linetype="permeability", color="permeability"),size=1)   
  
  plot <- plot + labs(color="CS", shape="CS", linetype="CS", y="Average Encounters", x="K",
                       title=paste("K-Regular Networks With Number of Networks =",n))
  
  print(plot)
  
}

gc()

##           used (Mb) gc trigger (Mb) max used (Mb)
## Ncells  601549 32.2     984024 52.6   984024 52.6
## Vcells 1916608 14.7    4005044 30.6  4005043 30.6

for(cs in c(0.25,0.5,0.75)){
  #plot for 2 networks
  current_encounters<-melted_encounters[melted_encounters$"network.0.cs" == cs,]
  #perm_encounters<-permeability_encounters[permeability_encounters$"num.networks" > 1,]
  
  plot_data <- dcast(current_encounters, network.0.k + num.networks ~ variable, mean)
  colnames(plot_data) <- c("k","num-networks","avg-encounters")

  plot <- ggplot(plot_data, aes(x=as.factor(plot_data$k), y=plot_data$"avg-encounters")) 
  plot <- plot +  geom_point(aes(shape=as.factor(plot_data$"num-networks"), color=as.factor(plot_data$"num-networks")),size = 3.5)
  plot <- plot +  geom_line(aes(color=as.factor(plot_data$"num-networks"), group=as.factor(plot_data$"num-networks"), linetype=as.factor(plot_data$"num-networks")),size=1)   
  
  plot <- plot + labs(color="Num. Networks", shape="Num. Networks", linetype="Num. Networks", y="Average Encounters", x="K",
                      title=paste("K-Regular Networks With CS =",cs))
  
  
   print(plot)
}

gc()

##           used (Mb) gc trigger (Mb) max used (Mb)
## Ncells  609254 32.6     984024 52.6   984024 52.6
## Vcells 1948258 14.9    4005044 30.6  4005043 30.6