How does the degree distribution of a FCD network differ from the "true" network of interest?

fixed_choice_design_sim.R

# Fixed Choice Design Lunchtime Simulation
# 2019-02-06

library(igraph)
library(dplyr)
library(ggplot2)

#Experimental Conditions
conds <- expand.grid(
  c(150),
  c(0.50),
  c(NA,5),
  stringsAsFactors = F) %>% 
  data.frame

#Single Function
fcd <- function(n_people,p_edge,top_n){
  
  graph_dat <- erdos.renyi.game(
    n = n_people,
    p.or.m = p_edge,
    directed = F) %>% 
    as_edgelist %>% 
    as.data.frame %>% 
    arrange(V1) %>% 
    mutate(
      n_connections = sequence(rle(.[,1])$lengths)) %>%
    group_by(V1)
  
  if(missing(top_n) | is.na(top_n)){
    graph_dat %>%
      .[,c(1,2)] %>%
      graph_from_data_frame(.,directed = F) %>%
      degree_distribution %>%
      matrix(nrow=1) %>%
      as.data.frame
  } else if(!missing(top_n)){
    graph_dat %>%
      top_n(-top_n) %>%
      .[,c(1,2)] %>%
      graph_from_data_frame(.,directed = F) %>%
      degree_distribution %>%
      matrix(nrow=1) %>%
      as.data.frame
  }
}

#Experimental Function
fcd_sim <- function(n_sims = 100, x, y, top_n){
  replicate(n = n_sims, expr = fcd(x,y,top_n))
}

#Storing Results
sim_results <- mapply(fcd_sim, x = conds$Var1,  y = conds$Var2, top_n = conds$Var3) %>% 
  apply(X = ., MARGIN = 2, FUN = function(x){t(do.call(bind_rows,x))})

#Plotting over all results
lapply(sim_results[1], 
       FUN = function(x){
         matplot(rowMeans(x,na.rm = T),
                 type='l',
                 col = rainbow(
                   n = ncol(x),
                   s = 0.5)[15],
                 lty='solid',
                 lwd=5,
                 ylab = "",
                 xlab = "",
                 xlim = c(0,max(conds$Var1)),
                 ylim = c(0,max(conds$Var2,na.rm = T)),main = 'Avg. Degree Distribution for 100 random graphs\nP(Edge) = 0.5, Fixed Choice @ 5\n|V| = 150')})
par(new = TRUE) 
lapply(sim_results[2], 
       FUN = function(x) matplot(rowMeans(x,na.rm = T),
                                 type='l',
                                 col = rainbow(
                                   n = ncol(x),
                                   s = 0.5)[1],
                                 lty='solid',
                                 lwd=5,
                                 ylab = "",
                                 xlab = "",
                                 xlim = c(0,max(conds$Var1)),
                                 ylim = c(0,max(conds$Var2,na.rm = T))))

nn <- ncol(conds[,-1])

legend("right", 
       legend = c("FCD - Top 5 Connections","Full Network"),
       col=c(
         rainbow(
           n = 100,
           s = 0.5)[1],
         rainbow(
           n = 100,
           s = 0.5)[15]
       ),
       cex=0.8,
       fill=c(
         rainbow(
           n = 100,
           s = 0.5)[1],
         rainbow(
           n = 100,
           s = 0.5)[15]
       )
)

nn <- ncol(conds[,-1])

legend("right", 
       legend = c("FCD - Top 5 Connections","'True' Network"),
       col=c(
         rainbow(
           n = 100,
           s = 0.5)[1],
         rainbow(
           n = 100,
           s = 0.5)[15]
       ),
       cex=0.8,
       fill=c(
         rainbow(
           n = 100,
           s = 0.5)[1],
         rainbow(
           n = 100,
           s = 0.5)[15]
       )
)