rehab cycle model factoring in relationships

drug_attitude

library(igraph)
library(animation)

node_clr <- scales::brewer_pal()(6)

###===============================###
### initiate full graph influence ###
###===============================###

addSimAtt <- function(g){
  g %>%
  {
    set.seed(4321)
    V(.)$name = as.character(1:vcount(.));
    V(.)$stubborn = runif(vcount(.));
    V(.)$attitude = runif(vcount(.)) * .5;
    E(.)$like = runif(ecount(.)) %>% round() %>% as.logical();
    E(.)$color = ifelse(E(.)$like, 'forestgreen', 'red');
    
    V(.)$color = map_chr(V(.)$attitude, ~node_clr[round(.x * 10) + 1] );
    V(.)$label = map_chr(V(.),~paste0(.x$name, '\n', round(.x$attitude, 2)));
    V(.)$label.color = ifelse(round(V(.)$attitude * 10) + 1 <= 4, 'black', 'white');
    V(.)$label.cex = .5
    
    E(.)$head = head_of(., E(.))$name
    E(.)$head_att = head_of(., E(.))$attitude
    E(.)$tail = tail_of(., E(.))$name
    E(.)$tail_att = tail_of(., E(.))$attitude
    
    E(.)$id = map2_chr(tail_of(., E(.))$name, head_of(., E(.))$name, function(x,y){
      paste(min(c(x,y)), max(c(x,y)))
    })
    
    E(.)$inWorld = T
    V(.)$usingDrugs = F
    
    l <- layout_nicely(.)
    V(.)$x = l[,1]
    V(.)$y = l[,2]
    V(.)$size = 15
    E(.)$width = 2
    .
  }
}

g <- igraph::make_full_graph(6) %>%
  addSimAtt()

egoEffect <- function(g){
  g_temp <- incident_edges(g, V(g)) %>% 
    map_lgl(function(x){
      x$like %>%
        table %>% 
        sort(T) %>% 
        .[1] %>% 
        names %>%
        as.logical()
    }) %>%
    {V(g)$ego_att = .; g} 
  
  g_temp <- V(g_temp)$ego_att %>%
    map2(incident_edges(g_temp, V(g_temp)), function(x,y){
      y[[like == x]]
    }) %>%
    map(function(e){e %>% 
        length %>% 
        {
          x = e[1:.];
          tibble(
            node = c(x$head, x$tail),
            att = c(x$head_att, x$tail_att)
          )
        }}) %>%
    imap_dbl(function(x, n){
      x %>%
        filter(node != n) %>%
        .$att %>%
        mean()
    }) %>%
    {V(g_temp)$ego_att_mean = .; g_temp}%>%
    {V(.)$change = map_dbl(V(.), ~.x$attitude - .x$ego_att_mean)/5; .}%>%
    {V(.)$change = ifelse(V(.)$ego_att, V(.)$change * -1, V(.)$change); .} %>%
    {V(.)$attitude = map_dbl(V(.), function(v){
      a = v$attitude + v$change;
      if(a > .5) return(.5)
      if(a < 0) return(0)
      return(a)
    }); .} 
  
  g_temp <- g_temp %>% 
  {
    V(.)$color = map_chr(V(.)$attitude, ~node_clr[round(.x * 10) + 1] );
    V(.)$label = map_chr(V(.),~paste0(.x$name, '\n', round(.x$attitude, 2)));
    V(.)$label.color = ifelse(round(V(.)$attitude * 10) + 1 <= 4, 'black', 'white');
    
    E(.)$head = head_of(., E(.))$name
    E(.)$head_att = head_of(., E(.))$attitude
    E(.)$tail = tail_of(., E(.))$name
    E(.)$tail_att = tail_of(., E(.))$attitude;
    .
  } 
  
  g_temp
}

g_list <- list(g)

for(z in 1:20){
  #get ego info
  g_temp <- g_list[[length(g_list)]]
  g_temp <- egoEffect(g_temp)
  
  g_list[[length(g_list) + 1]] <- g_temp
    
}


saveGIF({
  imap(1:length(g_list), function(x, i){
    print(plot(g_list[[x]], main = paste('T =', i), vertex.size = 50, vertex.label.cex = 2))
  })
}, movie.name = "drug_attitude_influence_example_refa.gif",  
ani.width = 600)

###======================================###
### Initiate full community and rehab ===###
###======================================###

# g_reference serves as a dictionary
# for edge (like, dislike) and vertex info
g_reference <- make_full_graph(18) %>%
  addSimAtt()
  #igraph::sample_islands(3, 6, 1, 0) %>%
  # {
  #   set.seed(4321)
  #   V(.)$name = paste0('Node ', 1:vcount(.));
  #   V(.)$stubborn = runif(vcount(.));
  #   V(.)$attitude = runif(vcount(.)) * .49;
  #   E(.)$like = runif(ecount(.)) %>% round() %>% as.logical();
  #   E(.)$color = ifelse(E(.)$like, 'forestgreen', 'red');
  #   E(.)$id = map2_chr(tail_of(., E(.))$name, head_of(., E(.))$name, function(x,y){
  #     paste(min(c(x,y)), max(c(x,y)))
  #   }) 
  #   V(.)$color = map_chr(V(.)$attitude, ~node_clr[round(.x * 10) + 1] );
  #   # V(.)$label = map_chr(V(.),~paste0(.x$name, '\n', round(.x$attitude, 2)));
  #   V(.)$label.color = ifelse(round(V(.)$attitude * 10) + 1 <= 4, 'black', 'white');
  #   
  #   E(.)$head = head_of(., E(.))$name
  #   E(.)$head_att = head_of(., E(.))$attitude
  #   E(.)$tail = tail_of(., E(.))$name
  #   E(.)$tail_att = tail_of(., E(.))$attitude
  #   
  #   
  #   E(.)$inWorld = T
  #   V(.)$usingDrugs = F
  #   
  #   l <- layout_nicely(.)
  #   V(.)$x = l[,1]
  #   V(.)$y = l[,2]
  #   V(.)$size = 15
  #   V(.)$label.cex = .75
  #   E(.)$width = 2
  #   .
  # } 


plot(g_reference, vertex.label.cex = .5)

vAtt <- g_reference %>% 
  vertex.attributes() %>% 
  names %>%
  .[!. %in% c('x', 'y')]

pullFromGDict <- function(g, dict){
  g %>%
  {
    tempEgo <<-sample(V(dict)$name, vcount(.), F) %>%
      ego(dict, 0, .)
    
    V(.)$name <- map_chr(tempEgo, function(x){x$name})
    V(.)$stubborn <- map_dbl(tempEgo, function(x){x$stubborn})
    V(.)$attitude <- map_dbl(tempEgo, function(x){x$attitude})
    V(.)$color <- map_chr(tempEgo, function(x){x$color})
    V(.)$label.color <- map_chr(tempEgo, function(x){x$label.color})
    V(.)$usingDrugs <- map_lgl(tempEgo, function(x){x$usingDrugs})
    V(.)$size <- map_dbl(tempEgo, function(x){x$size})
    V(.)$label.cex <- map_dbl(tempEgo, function(x){x$label.cex})
    
    E(.)$id = map2_chr(tail_of(., E(.))$name, head_of(., E(.))$name, function(x,y){
      paste(min(c(x,y)), max(c(x,y)))
    })
    
    edgeList <- map(E(.)$id, function(e){ E(dict)[id == e]})
    E(.)$like <- map_lgl(edgeList, function(e){e$like})
    E(.)$color <- map_chr(edgeList, function(e){e$color}) 
    E(.)$head <- map_chr(edgeList, function(e){e$head})
    E(.)$head_att <- map_dbl(edgeList, function(e){e$head_att})
    E(.)$tail <- map_chr(edgeList, function(e){e$tail})
    E(.)$tail_att <- map_dbl(edgeList, function(e){e$tail_att})
    E(.)$inWorld <- map_lgl(edgeList, function(e){e$inWorld})
    E(.)$width <- map_dbl(edgeList, function(e){e$width})
    
    l <- layout_nicely(.)
    V(.)$x = l[,1]
    V(.)$y = l[,2]
    V(.)$size = 15
    V(.)$label.cex = .75
    E(.)$width = 2
    .
  } 
}

g_population <- sample_islands(3, 6, 1, 0) %>%
  pullFromGDict(g_reference)
  # {
  #   set.seed(4321)
  #   tempEgo <<-sample(V(g_reference)$name, vcount(.), F) %>%
  #     ego(g_reference, 0, .)
  #   
  #   V(.)$name <- map_chr(tempEgo, function(x){x$name})
  #   V(.)$stubborn <- map_dbl(tempEgo, function(x){x$stubborn})
  #   V(.)$attitude <- map_dbl(tempEgo, function(x){x$attitude})
  #   V(.)$color <- map_chr(tempEgo, function(x){x$color})
  #   V(.)$label.color <- map_chr(tempEgo, function(x){x$label.color})
  #   V(.)$usingDrugs <- map_lgl(tempEgo, function(x){x$usingDrugs})
  #   V(.)$size <- map_dbl(tempEgo, function(x){x$size})
  #   V(.)$label.cex <- map_dbl(tempEgo, function(x){x$label.cex})
  #   
  #   E(.)$id = map2_chr(tail_of(., E(.))$name, head_of(., E(.))$name, function(x,y){
  #     paste(min(c(x,y)), max(c(x,y)))
  #   })
  #   
  #   edgeList <- map(E(.)$id, function(e){ print(e); print(E(g_reference)); E(g_reference)[id == e]})
  #   E(.)$like <- map_lgl(edgeList, function(e){e$like})
  #   E(.)$color <- map_chr(edgeList, function(e){e$color}) 
  #   E(.)$head <- map_chr(edgeList, function(e){e$head})
  #   E(.)$head_att <- map_dbl(edgeList, function(e){e$head_att})
  #   E(.)$tail <- map_chr(edgeList, function(e){e$tail})
  #   E(.)$tail_att <- map_dbl(edgeList, function(e){e$tail_att})
  #   E(.)$inWorld <- map_lgl(edgeList, function(e){e$inWorld})
  #   E(.)$width <- map_dbl(edgeList, function(e){e$width})
  #   
  #   l <- layout_nicely(.)
  #   V(.)$x = l[,1]
  #   V(.)$y = l[,2]
  #   V(.)$size = 15
  #   V(.)$label.cex = .75
  #   E(.)$width = 2
  #   .
  # } 
  
plot(g_population)

g_pop_list <- list(g_population)

for(z in 1:20){
  #get ego info
  
  g_temp <- g_pop_list[[length(g_pop_list)]]
  g_temp <- egoEffect(g_temp)
  
  g_pop_list[[length(g_pop_list) + 1]] <- g_temp
  
}

saveGIF({
  imap(1:length(g_pop_list), function(x, i){
    g_pop_list[[x]] %>%
      plot(
        main = paste('T =', i),
        vertex.label = round(V(.)$attitude, 2)
      ) %>%
    print()
  })
}, movie.name = "drug_attitude_influence_example_commun.gif",  
ani.width = 600)
  
tRehab = list(c())

g_population %>%
{V(.)$usingDrugs = map_lgl(V(.), function(x){(x$attitude * 2 ) < runif(1)}) ; .} %>%
{tRehab[[length(tRehab) + 1]] <<- V(.)[usingDrugs]; .} %>%
  plot(
    vertex.shape = map_chr(V(.), function(v){
      if(v$usingDrugs) return('none')
      return('circle')
    }),
    vertex.label = map_chr(V(.), function(v){
      if(v$usingDrugs) return('')
      return(v$name)
    }),
    edge.color = map_chr(E(.), function(e){
      if(T %in% c(head_of(., e)$usingDrugs, tail_of(., e)$usingDrugs)) return('transparent')
      return(e$color)
      })
    )

t2rehab_g <- tRehab[[2]]$name %>%
  (function(x){
    sample_islands(length(x), ceiling(length(x)/2), 1, 0) %>%
    {if(vcount(.) > length(x)){. - V(.)[(length(x) + 1):vcount(.)]}}%>%
      {V(.)$name = x; .}
  }) %>%
  pullFromGDict(g_reference)
  

### create new edge if doesn't exist
### use below as logical
#E(g_reference)['Node 2' %--% 'Node 1'] %>% length() %>% as.logical()
#E(g_reference)['Node 11' %--% 'Node 1'] %>% length() %>% as.logical()


plot(t2rehab_g, asp = 0)
t2g_ref <- g_reference + edges