Context Segregation

In this set of experiments, we analyse the impact of a new parameter called context tolerance in the convergence to consensus. In the previous experiments agents switched between networks using a switching probability. In the model of context segregation, agents switchich using a segregation criteria first–based on a tolerance threshold–and the same switching probability as follows.

At the end of each interaction an agent computes the ratio of agents with an opposing opinion values in its current neighbourhood. If this ratio is greater than the threshold defined for the current network, the agent switches to a different network immediately; if not, the agent switches using the switching probability.

Load the dependencies for this report.

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

## Loading required package: ggplot2

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

Exploring the Tolerance Threshold Span

To explore the effect of adding the context threshold to the previous model of context switching, we fixed the switching probability values in the values {0.25, 0.5, 0.75} and varied the context threshold from 0 to 1 in intervals of 0.05.

Tolerance Threshold Span for Regular Networks

In these experiments we wanted to observe the effect of the context tolerance parameter with scale-free networks. We used 2 networks. We tested configurations with switching probability set to 0.25 and 0.75 and 2 k-regular networks with k=5,10,30. We adjusted the connectivity to observe the effect of the different in the clustering coefficient (and average path length although the difference in clustering coefficient for two networks is more prominent–see network properties experiment).

contour_analysis <- function(prop_name,prop_value,cs_values,encounter_data,brks){
  for(cs in cs_values){
    col <- paste("network.0.",prop_name, sep = "")
    current_data <- encounter_data[encounter_data[col] == prop_value & encounter_data$"network.0.cs" == cs,]
    melted_encounters <- melt(current_data,id.vars=c("cfg.id","run","network.0.ct","network.1.ct","network.0.cs",col), measure.vars=c("total-encounters"))
  
    #aggregate encounter data
    agg_encounters <- aggregate(melted_encounters$value,by=list(melted_encounters$network.0.ct,melted_encounters$network.1.ct),mean)
    colnames(agg_encounters) <- c("ct0","ct1","value")
    
    #breaks in the contour
    guide_title <- "Average Encounters"
    net1label <- paste("\n\nTolerance for Network 1 \n Regular Network, ",prop_name,"=",prop_value,sep="") 
    net2label <- paste("\n\nTolerance for Network 2 \n Regular Network, ",prop_name,"=",prop_value,sep="") 
  
    
    encouters_contour <- create_tolerance_contour_span(span = agg_encounters, brks = brks, guide_title = guide_title,xlab=net1label, ylab=net2label)

    print(encouters_contour)
  }
}

Opinion Segregation

#Read the Parameters for this experiment
params <- read.exp.parameters(param_file_name="../data/context_segregation/regular_networks/param-space_2014-07-25_19:46:42experiment:20_.csv")

#read data for number of encounters
encounter_data <- fread("../data/context_segregation/regular_networks/num_encounters.csv")
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.ct","network.1.ct","network.0.cs","network.0.k")], by="cfg.id")
head(encounter_data)

##   cfg.id step run total-encounters network.0.ct network.1.ct network.0.cs
## 1      1   21   6             2099            0            0         0.25
## 2      1   29   8             2894            0            0         0.25
## 3      1   46   5             4589            0            0         0.25
## 4      1 2000  10           199506            0            0         0.25
## 5      1 2000   2           198971            0            0         0.25
## 6      1 2000   1           198570            0            0         0.25
##   network.0.k
## 1           5
## 2           5
## 3           5
## 4           5
## 5           5
## 6           5

Regular Network with K = 5

csvalues <- c(0.25,0.5,0.75)
contour_analysis(prop_name = "k",prop_value = 5, cs_values = csvalues, encounter_data = encounter_data, brks=c(30000,50000,70000,100000,120000,180000))

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

plot of chunk unnamed-chunk-4

csvalues <- c(0.25,0.5,0.75)
contour_analysis(prop_name = "k",prop_value = 10, cs_values = csvalues, encounter_data = encounter_data, brks=c(10000,20000,40000,120000))

plot of chunk unnamed-chunk-5

csvalues <- c(0.25,0.5,0.75)
contour_analysis(prop_name = "k",prop_value = 30, cs_values = csvalues, encounter_data = encounter_data, brks=c(2000,4000,10000,70000))

plot of chunk unnamed-chunk-6

#we don't need the persp plots here for now
#reshape the data to display average number of encounters
#encounter_table <- dcast(data=melted_encounters, network.0.ct~network.1.ct, 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"
#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)

Scale-Free Networks

#Read the Parameters for this experiment
params <- read.exp.parameters(param_file_name="../data/context_segregation/scale-free_networks/param-space_2014-06-30_01:40:06experiment:20_.csv")

#read data for number of encounters
encounter_data <- fread("../data/context_segregation/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   1      1            96481
## 2 2000   4      1           102032
## 3 2000   2      1           104505
## 4 2000   3      1           102746
## 5 2000   6      1            98972
## 6 2000   5      1            98191

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

##   cfg.id step run total-encounters network.0.ct network.1.ct network.0.cs
## 1      1 2000   1            96481            0            0         0.25
## 2      1 2000   4           102032            0            0         0.25
## 3      1 2000   2           104505            0            0         0.25
## 4      1 2000   3           102746            0            0         0.25
## 5      1 2000   6            98972            0            0         0.25
## 6      1 2000   5            98191            0            0         0.25
##   network.0.d
## 1           1
## 2           1
## 3           1
## 4           1
## 5           1
## 6           1

D = 1

csvalues <- c(0.25,0.75)
contour_analysis(prop_name = "d",prop_value = 1, cs_values = csvalues, encounter_data = encounter_data, brks=c(104000,110000,120000))

plot of chunk unnamed-chunk-9

D = 5

csvalues <- c(0.25,0.75)
contour_analysis(prop_name = "d",prop_value = 5, cs_values = csvalues, encounter_data = encounter_data, brks=c(3000,5000,10000,20000))

plot of chunk unnamed-chunk-10

Conformism Segregation

In this model we did the opposite of segregation from opposite opinions, the agents switch to avoid conformism. If the number of agents with the same opinion rises above the tolerance threshold the agents switch to another context.

K-Regular Networks

#Read the Parameters for this experiment
params <- read.exp.parameters(param_file_name="../data/context_segregation_conformism/regular_networks/param-space_2014-07-23_20:20:09experiment:50_.csv")

#read data for number of encounters
encounter_data <- fread("../data/context_segregation_conformism/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    7   5      1              700
## 2   11   4      1             1099
## 3   34   8      1             3397
## 4   31   7      1             3097
## 5   29   3      1             2898
## 6   63   6      1             6294

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

##   cfg.id step run total-encounters network.0.ct network.1.ct network.0.cs
## 1      1    7   5              700            0            0         0.25
## 2      1   11   4             1099            0            0         0.25
## 3      1   34   8             3397            0            0         0.25
## 4      1   31   7             3097            0            0         0.25
## 5      1   29   3             2898            0            0         0.25
## 6      1   63   6             6294            0            0         0.25
##   network.0.k
## 1           5
## 2           5
## 3           5
## 4           5
## 5           5
## 6           5

K = 5

csvalues <- c(0.25,0.5,0.75)
contour_analysis(prop_name = "k",prop_value = 5, cs_values = csvalues, encounter_data = encounter_data, brks=c(5000,10000,15000))

plot of chunk unnamed-chunk-12

K = 10

csvalues <- c(0.25,0.5,0.75)
contour_analysis(prop_name = "k",prop_value = 10, cs_values = csvalues, encounter_data = encounter_data, brks=c(5000,10000,15000))

plot of chunk unnamed-chunk-13

K = 30

csvalues <- c(0.25,0.5,0.75)
contour_analysis(prop_name = "k",prop_value = 30, cs_values = csvalues, encounter_data = encounter_data, brks=c(1500,1800,2000))

plot of chunk unnamed-chunk-14

Scale-Free Networks

#Read the Parameters for this experiment
params <- read.exp.parameters(param_file_name="../data/context_segregation_conformism/scale-free_networks/param-space_2014-07-24_14:56:15experiment:51_.csv")

#read data for number of encounters
encounter_data <- fread("../data/context_segregation_conformism/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   34   2      1             1653
## 2   86   6      1             4046
## 3   86   3      1             4069
## 4  149   8      1             6735
## 5   19  11      1              967
## 6   79  12      1             3826

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

##   cfg.id step run total-encounters network.0.ct network.1.ct network.0.cs
## 1      1   34   2             1653            0            0         0.25
## 2      1   86   6             4046            0            0         0.25
## 3      1   86   3             4069            0            0         0.25
## 4      1  149   8             6735            0            0         0.25
## 5      1   19  11              967            0            0         0.25
## 6      1   79  12             3826            0            0         0.25
##   network.0.d
## 1           1
## 2           1
## 3           1
## 4           1
## 5           1
## 6           1

D = 1

csvalues <- c(0.25,0.5,0.75)
contour_analysis(prop_name = "d",prop_value = 1, cs_values = csvalues, encounter_data = encounter_data, brks=c(20000,40000,50000,70000))

plot of chunk unnamed-chunk-16

D = 5

csvalues <- c(0.25,0.5,0.75)
contour_analysis(prop_name = "d",prop_value = 5, cs_values = csvalues, encounter_data = encounter_data, brks=c(2000,3000))

plot of chunk unnamed-chunk-17

Analysis with Multiple Networks

We now look at the influence of multiple network by “freezing” the value of tolerance in an optimal configuration –in terms of speed of convergence. We compare the effects of having multiple networks for switching values of 0.25, 0.5 and 0.75.

params <- "../data/context_segregation/multiple-networks/regular-networks/param-space_2014-07-27_18:49:08experiment:20_.csv"

encounters <- "../data/context_segregation/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   40   2      1             3990
## 2 2000   4      1           199338
## 3   11   6      1             1098
## 4 2000   3      1           199437
## 5   88   8      1             8778
## 6 2000   1      1           199435

#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   40   2             3990         0.25           5            2
## 2      1 2000   4           199338         0.25           5            2
## 3      1   11   6             1098         0.25           5            2
## 4      1 2000   3           199437         0.25           5            2
## 5      1   88   8             8778         0.25           5            2
## 6      1 2000   1           199435         0.25           5            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   2         0.25           5            2 total-encounters   3990
## 2      1   4         0.25           5            2 total-encounters 199338
## 3      1   6         0.25           5            2 total-encounters   1098
## 4      1   3         0.25           5            2 total-encounters 199437
## 5      1   8         0.25           5            2 total-encounters   8778
## 6      1   1         0.25           5            2 total-encounters 199435

K-regular networks with k = 5

for(cs in c(0.25,0.75)){
  #plot for 2 networks
  current_encounters<-melted_encounters[melted_encounters$"network.0.cs" == cs,]

  
  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)
}

plot of chunk unnamed-chunk-19

Context Switching with Conformism Segregation

params <- "../data/context_segregation_conformism/multiple-networks/regular-networks/param-space_2014-07-27_18:51:59experiment:20_.csv"

encounters <- "../data/context_segregation_conformism/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   15   4      1             1499
## 2   21   2      1             2098
## 3   25   3      1             2499
## 4   21   1      1             2098
## 5   23   5      1             2299
## 6   15   6      1             1500

#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   15   4             1499         0.25           5            2
## 2      1   21   2             2098         0.25           5            2
## 3      1   25   3             2499         0.25           5            2
## 4      1   21   1             2098         0.25           5            2
## 5      1   23   5             2299         0.25           5            2
## 6      1   15   6             1500         0.25           5            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   4         0.25           5            2 total-encounters  1499
## 2      1   2         0.25           5            2 total-encounters  2098
## 3      1   3         0.25           5            2 total-encounters  2499
## 4      1   1         0.25           5            2 total-encounters  2098
## 5      1   5         0.25           5            2 total-encounters  2299
## 6      1   6         0.25           5            2 total-encounters  1500

for(cs in c(0.25,0.5,0.75)){
  #plot for 2 networks
  current_encounters<-melted_encounters[melted_encounters$"network.0.cs" == cs,]

  
  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)
}

plot of chunk unnamed-chunk-21

Context Switching with Segregation and Selective Switching

In this model, agents keep a record of how many times they have switched from each network. The switch to a particular network based with a probability inversely proportional to the number of times they have switched from that network using segregation.

params <- "../data/context_segregation_selective/multiple-networks/regular-networks/param-space_2014-07-27_18:58:16experiment:20_.csv"

encounters <- "../data/context_segregation_selective/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   14   2      1             1397
## 2   15   3      1             1496
## 3   36   5      1             3595
## 4   96   1      1             9575
## 5  118   7      1            11772
## 6   22   9      1             2197

#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   14   2             1397         0.25           5            2
## 2      1   15   3             1496         0.25           5            2
## 3      1   36   5             3595         0.25           5            2
## 4      1   96   1             9575         0.25           5            2
## 5      1  118   7            11772         0.25           5            2
## 6      1   22   9             2197         0.25           5            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   2         0.25           5            2 total-encounters  1397
## 2      1   3         0.25           5            2 total-encounters  1496
## 3      1   5         0.25           5            2 total-encounters  3595
## 4      1   1         0.25           5            2 total-encounters  9575
## 5      1   7         0.25           5            2 total-encounters 11772
## 6      1   9         0.25           5            2 total-encounters  2197

for(cs in c(0.25,0.5,0.75)){
  #plot for 2 networks
  current_encounters<-melted_encounters[melted_encounters$"network.0.cs" == cs,]

  
  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)
}

plot of chunk unnamed-chunk-23