Skip to content

Instantly share code, notes, and snippets.

@beemyfriend

beemyfriend/drug_attitude

Created February 7, 2019 18:52
Show Gist options
  • Save beemyfriend/6282204f6e2ad729852c0b018583708d to your computer and use it in GitHub Desktop.
Save beemyfriend/6282204f6e2ad729852c0b018583708d to your computer and use it in GitHub Desktop.
Download ZIP
rehab cycle model factoring in relationships
Raw
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment