Consensus Project Results

Statistical results from consensus dynamics simulations.

The description of the project is at Consensus Dynamics Project, and the source code is at Consensus Code.

Below is results from the "Composite process" described at Consensus_Experiments#Composite_process.

Source code

First the source files that invoke the simulation program and collect the output - makefile and .R script:

stats.mk

batch-stats.R

Results: July 2011

The output of the R program:

batch-stats.Rout[log]

> # Input: "/usr/local/workingwiki/working-directories/persistent/pe-ww/lalashan.mcmaster.ca/theobio/worden/Consensus_Results/batch-0/outcomes.csv"
> 
> # Scripts: batch-stats.R
> 
> # read in the csv file generated by the batch script
> outcomes <- read.csv(input_files[1])
> 
> # what is in the csv file?
> summary(outcomes)
   replicate        nBits       nBlocks      weightingForSharedLandscape
 Min.   : 1.0   Min.   : 4   Min.   :1.000   Min.   :0.0                
 1st Qu.: 3.0   1st Qu.: 4   1st Qu.:1.000   1st Qu.:0.2                
 Median : 5.5   Median :16   Median :2.000   Median :0.5                
 Mean   : 5.5   Mean   :28   Mean   :2.333   Mean   :0.5                
 3rd Qu.: 8.0   3rd Qu.:64   3rd Qu.:4.000   3rd Qu.:0.8                
 Max.   :10.0   Max.   :64   Max.   :4.000   Max.   :1.0                
   groupSize        facilitationStrategy   individualProposalStrategy
 Min.   : 4   anyone proposes :9720      any improvement:6480        
 1st Qu.: 4   blockers propose:9720      best           :6480        
 Median :12                              best neighbor  :6480        
 Mean   :12                                                          
 3rd Qu.:20                                                          
 Max.   :20                                                          
                     blockStrategy  n.individuals   min.value       
 if worse                   :9720   Min.   : 4    Min.   :-0.49989  
 if worse and not acceptable:9720   1st Qu.: 4    1st Qu.:-0.16184  
                                    Median :12    Median : 0.03307  
                                    Mean   :12    Mean   : 0.01506  
                                    3rd Qu.:20    3rd Qu.: 0.18428  
                                    Max.   :20    Max.   : 0.49989  
   mean.value         max.value         n.satisfied    
 Min.   :-0.22880   Min.   :-0.08517   Min.   : 0.000  
 1st Qu.: 0.06272   1st Qu.: 0.23287   1st Qu.: 4.000  
 Median : 0.14640   Median : 0.29858   Median :10.000  
 Mean   : 0.16394   Mean   : 0.31112   Mean   : 9.818  
 3rd Qu.: 0.24879   3rd Qu.: 0.40442   3rd Qu.:12.000  
 Max.   : 0.49989   Max.   : 0.50000   Max.   :20.000  
> 
> # set up the 4-square plots
> layout(matrix(1:4,2,2))
> 
> # make a derived variable: success is only when all are satisfied
> outcomes$success <- (outcomes$n.satisfied == outcomes$n.individuals)
> 
> # do linear regression to see what contributes to fraction satisfied
> lm.s <- with(outcomes, lm(success ~ nBits + nBlocks + weightingForSharedLandscape + n.individuals + facilitationStrategy + individualProposalStrategy + blockStrategy))
> # print out the result
> summary(lm.s)
 
Call:
lm(formula = success ~ nBits + nBlocks + weightingForSharedLandscape + 
    n.individuals + facilitationStrategy + individualProposalStrategy + 
    blockStrategy)
 
Residuals:
     Min       1Q   Median       3Q      Max 
-0.93060 -0.22140 -0.02062  0.20981  0.99708 
 
Coefficients:
                                           Estimate Std. Error t value Pr(>|t|)
(Intercept)                               9.261e-02  8.533e-03  10.854  < 2e-16
nBits                                     1.265e-03  8.447e-05  14.974  < 2e-16
nBlocks                                   2.974e-02  1.756e-03  16.939  < 2e-16
weightingForSharedLandscape               1.065e+00  6.411e-03 166.082  < 2e-16
n.individuals                            -1.528e-02  3.352e-04 -45.574  < 2e-16
facilitationStrategyblockers propose     -2.510e-02  4.379e-03  -5.732 1.01e-08
individualProposalStrategybest           -2.485e-02  5.364e-03  -4.632 3.64e-06
individualProposalStrategybest neighbor  -3.827e-02  5.364e-03  -7.135 1.00e-12
blockStrategyif worse and not acceptable  1.399e-01  4.379e-03  31.949  < 2e-16
 
(Intercept)                              ***
nBits                                    ***
nBlocks                                  ***
weightingForSharedLandscape              ***
n.individuals                            ***
facilitationStrategyblockers propose     ***
individualProposalStrategybest           ***
individualProposalStrategybest neighbor  ***
blockStrategyif worse and not acceptable ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 
 
Residual standard error: 0.3053 on 19431 degrees of freedom
Multiple R-squared: 0.6168,	Adjusted R-squared: 0.6167 
F-statistic:  3910 on 8 and 19431 DF,  p-value: < 2.2e-16 
 
> # plot the diagnostics
> plot(lm.s)
> 
> # another derived variable, fraction satisfied
> outcomes$fraction.satisfied <- outcomes$n.satisfied / outcomes$n.individuals
> 
> lm.fs <- with(outcomes, lm(fraction.satisfied ~ nBits + nBlocks + weightingForSharedLandscape + n.individuals + facilitationStrategy + individualProposalStrategy + blockStrategy))
> summary(lm.fs)
 
Call:
lm(formula = fraction.satisfied ~ nBits + nBlocks + weightingForSharedLandscape + 
    n.individuals + facilitationStrategy + individualProposalStrategy + 
    blockStrategy)
 
Residuals:
     Min       1Q   Median       3Q      Max 
-0.84152 -0.08565  0.00726  0.10162  0.42253 
 
Coefficients:
                                           Estimate Std. Error t value Pr(>|t|)
(Intercept)                               6.017e-01  4.098e-03 146.825  < 2e-16
nBits                                     4.556e-04  4.057e-05  11.230  < 2e-16
nBlocks                                   1.841e-02  8.432e-04  21.838  < 2e-16
weightingForSharedLandscape               4.734e-01  3.079e-03 153.748  < 2e-16
n.individuals                            -5.608e-03  1.610e-04 -34.834  < 2e-16
facilitationStrategyblockers propose     -4.763e-03  2.103e-03  -2.265   0.0235
individualProposalStrategybest           -1.263e-02  2.576e-03  -4.902 9.59e-07
individualProposalStrategybest neighbor  -1.724e-02  2.576e-03  -6.692 2.26e-11
blockStrategyif worse and not acceptable  4.737e-02  2.103e-03  22.522  < 2e-16
 
(Intercept)                              ***
nBits                                    ***
nBlocks                                  ***
weightingForSharedLandscape              ***
n.individuals                            ***
facilitationStrategyblockers propose     *  
individualProposalStrategybest           ***
individualProposalStrategybest neighbor  ***
blockStrategyif worse and not acceptable ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 
 
Residual standard error: 0.1466 on 19431 degrees of freedom
Multiple R-squared: 0.5724,	Adjusted R-squared: 0.5723 
F-statistic:  3252 on 8 and 19431 DF,  p-value: < 2.2e-16 
 
> plot(lm.fs)
> 
> # do linear regression for min value
> lm.min <- with(outcomes, lm(min.value ~ nBits + nBlocks + weightingForSharedLandscape + n.individuals + facilitationStrategy + individualProposalStrategy + blockStrategy))
> summary(lm.min)
 
Call:
lm(formula = min.value ~ nBits + nBlocks + weightingForSharedLandscape + 
    n.individuals + facilitationStrategy + individualProposalStrategy + 
    blockStrategy)
 
Residuals:
     Min       1Q   Median       3Q      Max 
-0.45586 -0.07440 -0.00784  0.06734  0.69207 
 
Coefficients:
                                           Estimate Std. Error t value Pr(>|t|)
(Intercept)                              -2.444e-01  3.100e-03 -78.838   <2e-16
nBits                                     9.147e-04  3.069e-05  29.809   <2e-16
nBlocks                                   2.135e-02  6.378e-04  33.471   <2e-16
weightingForSharedLandscape               5.877e-01  2.329e-03 252.371   <2e-16
n.individuals                            -7.580e-03  1.218e-04 -62.241   <2e-16
facilitationStrategyblockers propose     -6.785e-02  1.591e-03 -42.649   <2e-16
individualProposalStrategybest            3.027e-03  1.949e-03   1.553    0.120
individualProposalStrategybest neighbor  -2.888e-03  1.949e-03  -1.482    0.138
blockStrategyif worse and not acceptable  2.995e-02  1.591e-03  18.824   <2e-16
 
(Intercept)                              ***
nBits                                    ***
nBlocks                                  ***
weightingForSharedLandscape              ***
n.individuals                            ***
facilitationStrategyblockers propose     ***
individualProposalStrategybest              
individualProposalStrategybest neighbor     
blockStrategyif worse and not acceptable ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 
 
Residual standard error: 0.1109 on 19431 degrees of freedom
Multiple R-squared: 0.7869,	Adjusted R-squared: 0.7868 
F-statistic:  8970 on 8 and 19431 DF,  p-value: < 2.2e-16 
 
> plot(lm.min)
> 
> # do linear regression for mean value
> lm.mean <- with(outcomes, lm(mean.value ~ nBits + nBlocks + weightingForSharedLandscape + n.individuals + facilitationStrategy + individualProposalStrategy + blockStrategy))
> summary(lm.mean)
 
Call:
lm(formula = mean.value ~ nBits + nBlocks + weightingForSharedLandscape + 
    n.individuals + facilitationStrategy + individualProposalStrategy + 
    blockStrategy)
 
Residuals:
     Min       1Q   Median       3Q      Max 
-0.41514 -0.05674 -0.00164  0.05686  0.43022 
 
Coefficients:
                                           Estimate Std. Error t value Pr(>|t|)
(Intercept)                               6.403e-02  2.434e-03  26.302  < 2e-16
nBits                                     9.101e-04  2.410e-05  37.764  < 2e-16
nBlocks                                  -7.775e-03  5.009e-04 -15.522  < 2e-16
weightingForSharedLandscape               2.938e-01  1.829e-03 160.639  < 2e-16
n.individuals                            -2.954e-03  9.564e-05 -30.883  < 2e-16
facilitationStrategyblockers propose     -6.953e-02  1.249e-03 -55.650  < 2e-16
individualProposalStrategybest            9.583e-03  1.530e-03   6.262 3.87e-10
individualProposalStrategybest neighbor   2.407e-03  1.530e-03   1.573    0.116
blockStrategyif worse and not acceptable  2.376e-02  1.249e-03  19.017  < 2e-16
 
(Intercept)                              ***
nBits                                    ***
nBlocks                                  ***
weightingForSharedLandscape              ***
n.individuals                            ***
facilitationStrategyblockers propose     ***
individualProposalStrategybest           ***
individualProposalStrategybest neighbor     
blockStrategyif worse and not acceptable ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 
 
Residual standard error: 0.0871 on 19431 degrees of freedom
Multiple R-squared: 0.6217,	Adjusted R-squared: 0.6215 
F-statistic:  3991 on 8 and 19431 DF,  p-value: < 2.2e-16 
 
> plot(lm.mean)
> 
> # do linear regression for max value
> lm.max <- with(outcomes, lm(max.value ~ nBits + nBlocks + weightingForSharedLandscape + n.individuals + facilitationStrategy + individualProposalStrategy + blockStrategy))
> summary(lm.max)
 
Call:
lm(formula = max.value ~ nBits + nBlocks + weightingForSharedLandscape + 
    n.individuals + facilitationStrategy + individualProposalStrategy + 
    blockStrategy)
 
Residuals:
     Min       1Q   Median       3Q      Max 
-0.44969 -0.05702  0.00742  0.06490  0.23053 
 
Coefficients:
                                           Estimate Std. Error t value Pr(>|t|)
(Intercept)                               3.555e-01  2.485e-03 143.054  < 2e-16
nBits                                     9.209e-04  2.460e-05  37.438  < 2e-16
nBlocks                                  -3.277e-02  5.113e-04 -64.097  < 2e-16
weightingForSharedLandscape               1.208e-03  1.867e-03   0.647  0.51743
n.individuals                             1.887e-03  9.762e-05  19.326  < 2e-16
facilitationStrategyblockers propose     -7.041e-02  1.275e-03 -55.208  < 2e-16
individualProposalStrategybest            1.915e-02  1.562e-03  12.261  < 2e-16
individualProposalStrategybest neighbor   6.010e-03  1.562e-03   3.848  0.00012
blockStrategyif worse and not acceptable  1.983e-02  1.275e-03  15.551  < 2e-16
 
(Intercept)                              ***
nBits                                    ***
nBlocks                                  ***
weightingForSharedLandscape                 
n.individuals                            ***
facilitationStrategyblockers propose     ***
individualProposalStrategybest           ***
individualProposalStrategybest neighbor  ***
blockStrategyif worse and not acceptable ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 
 
Residual standard error: 0.08891 on 19431 degrees of freedom
Multiple R-squared: 0.3244,	Adjusted R-squared: 0.3241 
F-statistic:  1166 on 8 and 19431 DF,  p-value: < 2.2e-16 
 
> plot(lm.max)
> 
> # another derived variable: spread of values
> outcomes$spread.value <- outcomes$max.value - outcomes$min.value
> 
> # do linear regression for spread
> lm.spread <- with(outcomes, lm(spread.value ~ nBits + nBlocks + weightingForSharedLandscape + n.individuals + facilitationStrategy + individualProposalStrategy + blockStrategy))
> summary(lm.spread)
 
Call:
lm(formula = spread.value ~ nBits + nBlocks + weightingForSharedLandscape + 
    n.individuals + facilitationStrategy + individualProposalStrategy + 
    blockStrategy)
 
Residuals:
     Min       1Q   Median       3Q      Max 
-0.53365 -0.06297  0.00035  0.06584  0.38055 
 
Coefficients:
                                           Estimate Std. Error  t value
(Intercept)                               5.998e-01  2.935e-03  204.351
nBits                                     6.188e-06  2.906e-05    0.213
nBlocks                                  -5.412e-02  6.040e-04  -89.604
weightingForSharedLandscape              -5.865e-01  2.205e-03 -265.959
n.individuals                             9.466e-03  1.153e-04   82.086
facilitationStrategyblockers propose     -2.556e-03  1.507e-03   -1.697
individualProposalStrategybest            1.612e-02  1.845e-03    8.739
individualProposalStrategybest neighbor   8.898e-03  1.845e-03    4.822
blockStrategyif worse and not acceptable -1.012e-02  1.507e-03   -6.714
                                         Pr(>|t|)    
(Intercept)                               < 2e-16 ***
nBits                                      0.8314    
nBlocks                                   < 2e-16 ***
weightingForSharedLandscape               < 2e-16 ***
n.individuals                             < 2e-16 ***
facilitationStrategyblockers propose       0.0898 .  
individualProposalStrategybest            < 2e-16 ***
individualProposalStrategybest neighbor  1.43e-06 ***
blockStrategyif worse and not acceptable 1.95e-11 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 
 
Residual standard error: 0.105 on 19431 degrees of freedom
Multiple R-squared: 0.815,	Adjusted R-squared: 0.815 
F-statistic: 1.07e+04 on 8 and 19431 DF,  p-value: < 2.2e-16 
 
> plot(lm.spread)
> 
> # no more 4-square plots
> layout(matrix(1,1,1))
> 
> # scatter plots to visualize the relationships between variables
> # this is intractably big
> #pairs(~success + fraction.satisfied + n.satisfied + min.value + mean.value + max.value + spread.value + nBits + nBlocks + weightingForSharedLandscape + n.individuals + facilitationStrategy + individualProposalStrategy + blockStrategy, data=outcomes)
> 
> success.freqs <- with(outcomes,as.data.frame(table(n.individuals, success)))
> p.success <- success.freqs[success.freqs$success == TRUE,]
> p.success$sample <- success.freqs$Freq[success.freqs$success == TRUE] + success.freqs$Freq[success.freqs$success == FALSE]
> plot(p.success$n.individuals, p.success$Freq/p.success$sample,
+        main = 'Success vs. Group Size', xlab = 'n.individuals',
+        ylab = 'probability of success', ylim=c(0,1))
> 
> success.freqs <- with(outcomes,as.data.frame(table(weightingForSharedLandscape, success)))
> p.success <- success.freqs[success.freqs$success == TRUE,]
> p.success$sample <- success.freqs$Freq[success.freqs$success == TRUE] + success.freqs$Freq[success.freqs$success == FALSE]
> plot(p.success$weightingForSharedLandscape, p.success$Freq/p.success$sample,
+        main = 'Success vs. Commonality', xlab = 'weightingForSharedLandscape',
+        ylab = 'probability of success', ylim=c(0,1))
> 
> success.freqs <- with(outcomes,as.data.frame(table(nBits, success)))
> p.success <- success.freqs[success.freqs$success == TRUE,]
> p.success$sample <- success.freqs$Freq[success.freqs$success == TRUE] + success.freqs$Freq[success.freqs$success == FALSE]
> plot(p.success$nBits, p.success$Freq/p.success$sample,
+        main = 'Success vs. Size of Search Landscape', xlab = 'nBits',
+        ylab = 'probability of success', ylim=c(0,1))
> 
> success.freqs <- with(outcomes,as.data.frame(table(nBlocks, success)))
> p.success <- success.freqs[success.freqs$success == TRUE,]
> p.success$sample <- success.freqs$Freq[success.freqs$success == TRUE] + success.freqs$Freq[success.freqs$success == FALSE]
> plot(p.success$nBlocks, p.success$Freq/p.success$sample,
+        main = 'Success vs. Smoothness of Search Landscape', xlab = 'nBlocks',
+        ylab = 'probability of success', ylim=c(0,1))
> 
> success.freqs <- with(outcomes,as.data.frame(table(individualProposalStrategy, success)))
> p.success <- success.freqs[success.freqs$success == TRUE,]
> p.success$sample <- success.freqs$Freq[success.freqs$success == TRUE] + success.freqs$Freq[success.freqs$success == FALSE]
> plot(p.success$individualProposalStrategy, p.success$Freq/p.success$sample,
+        main = 'Success vs. Proposal Strategy', xlab = 'strategy',
+        ylab = 'probability of success', ylim=c(0,1))
> 
> success.freqs <- with(outcomes,as.data.frame(table(blockStrategy, success)))
> p.success <- success.freqs[success.freqs$success == TRUE,]
> p.success$sample <- success.freqs$Freq[success.freqs$success == TRUE] + success.freqs$Freq[success.freqs$success == FALSE]
> plot(p.success$blockStrategy, p.success$Freq/p.success$sample,
+        main = 'Success vs. Blocking Strategy', xlab = 'strategy',
+        ylab = 'probability of success', ylim=c(0,1))
> 
> success.freqs <- with(outcomes,as.data.frame(table(facilitationStrategy, success)))
> p.success <- success.freqs[success.freqs$success == TRUE,]
> p.success$sample <- success.freqs$Freq[success.freqs$success == TRUE] + success.freqs$Freq[success.freqs$success == FALSE]
> plot(p.success$facilitationStrategy, p.success$Freq/p.success$sample,
+        main = 'Success vs. Facilitation Strategy', xlab = 'strategy',
+        ylab = 'probability of success', ylim=c(0,1))
> 
>

Discussion

In the R output above, we see that:

even with only 10 replicates a lot of things are significant!
success:
- is influenced positively by number of bits, i.e. size of the search space and number of degrees of freedom
- is influenced negatively by number of individuals
- is facilitated by correlation between and within landscapes, especially between
- is not influenced much by the facilitation strategy, which is a surprise to me.
- "any improvement" is a lot better than the other proposal strategies, which is not a surprise
- "if worse and not acceptable" is a big improvement over the alternative, which is what I expected
fraction satisfied responds in the same ways as success, not surprisingly
- but responds even less to facilitation strategy
mean value
- rises with number of bits, falls with intra-landscape correlation in fitness (why?)
- falls with number of individuals
- rises with inter-individual correlation
- responds to success differently from strategies
  - but in an earlier run this answer was different, so maybe it's not meaningful
spread in value
- drops with correlation in values - curious that it responds to this and not to number of bits
- drops with commonality between players - because they succeed more?
- rises with group size
- is less with "any improvement"
- is less with "if worse and not acceptable"