csqsiew / spreadr

spreadr: A set of functions to simulate the spreading of activation among nodes in a network.
8 stars 1 forks source link

even spreading in weighted directed networks #6

Closed marcobiella closed 1 year ago

marcobiella commented 1 year ago

Hi! I'm trying to simulate spread activation on an igraph object that is a weighted bipartite network. The network is simple, two target nodes (at t0 one has 100 activation while the other has 0) and two attribute nodes (with 0 activation at t0). In the first timestep, the 100 activation is spread evenly across the attribute nodes. This shouldn't happen as the two edges connecting the target to the attributes have drastically different weights. The issue persists during subsequent timesteps.

The adjacency matrix is this: | ----------- | tgt1 | tgt2 | att1 | att2 | | tgt1 | 0 | 0 | 6 | 6 | | tgt2 | 0 | 0 | 10 | 2 | | att1 | 6 | 10 | 0 | 0 | | att2 | 6 | 2 | 0 | 0 |

Here is the code to reproduce the issue and after that, my sessioninfo:

`rm(list = ls())

library(tidyverse) library(scales) library(igraph) library(spreadr) library(tidygraph) library(ggraph)

plot network at different timesteps

plot_tempNet <- function(network, activation, timestep){ activation <- activation %>% dplyr::filter(time == timestep) V(network)$activation = activation$activation plt <- network %>% ggraph(layout = lot) + geom_edge_link(aes(color = weight), width = 2) + geom_node_point(aes(color = activation), size = 10) + scale_edge_color_gradient(low = "green", high = "red", na.value = NA) + scale_color_gradient(low = "white", high = "darkviolet", na.value = NA) + geom_node_text(aes(label = paste0(name, "\n", round(activation, digits = 2)))) + theme_graph() + ggtitle(label = paste0("time t=", timestep)) return(plt) }

initial network

read adj matrix

adjWeight <- read_csv2(file = "bug.csv") %>% dplyr::select(-...1) %>% as.matrix()

format type (bipartite) and names

adjWeight <- graph_from_adjacency_matrix(adjmatrix = adjWeight, mode = "directed", weighted = TRUE) V(graph = adjWeight)$type <- c(rep("tgt", 2), rep("att", 2)) V(adjWeight)$name <- c("tgt1", "tgt2", "att1", "att2")

custom layout

lot <- cbind("x" <- c(1:2, 1:2), "y" <- c(rep(0, 2), rep(1, 2))) names(lot) <- c("x", "y")

preliminary plots

adjWeight %>% plot() adjWeight %>% ggraph(layout = lot) + geom_edge_link(aes(color = weight), width = 3) + geom_node_point(aes(color = type), size = 10) + scale_edge_color_gradient(low = "green", high = "red", na.value = NA) + geom_node_text(aes(label = name)) + theme_graph()

spread activation (weighted)

start_run_we <- data.frame( node = V(adjWeight)$name, activation = rep(0, length(V(adjWeight)))) start_run_we[grepl(pattern = "tgt2", x = start_run_we$node), "activation"] = 100 # result_we <- spreadr(network = adjWeight, start_run = start_run_we, include_t0 = TRUE, time = 50, retention = 0, #total activation that remains in the node

decay = , #proportion of activation lost at each time step

                 # suppress = 10, #minimum activation to have node firing

)

format results

result_we <- result_we %>% mutate( type = case_when( !grepl(pattern = "[0-9]", x = node) ~ "tgt", grepl(pattern = "[0-9]", x = node) ~ "att",), attType = case_when( grepl(pattern = "att1", x = node) ~ "good", grepl(pattern = "att2", x = node) ~ "bad", .default = "target"), attType = factor(attType, levels = c("bad", "good", "target")))

plot results

ggplot(data = result_we, aes(x = time, y = activation, group = node, color = attType)) + geom_point() + geom_line() + scale_color_manual(values = c("darkred", "darkgreen", "black")) + scale_x_continuous(breaks = 0:999) + facet_grid(. ~ type)

ggplot(data = result_we %>% dplyr::filter(attType != "target") %>% group_by(time, type, attType) %>% reframe(activation = mean(activation)), aes(x = time, y = activation, color = attType)) + geom_point() + geom_line() + scale_color_manual(values = c("darkred", "darkgreen")) + scale_x_continuous(breaks = 0:999) + facet_grid(. ~ type)

check results for bugs

plot_tempNet(network = adjWeight, activation = result_we, timestep = 0) plot_tempNet(network = adjWeight, activation = result_we, timestep = 1) plot_tempNet(network = adjWeight, activation = result_we, timestep = 2) plot_tempNet(network = adjWeight, activation = result_we, timestep = 3) plot_tempNet(network = adjWeight, activation = result_we, timestep = 4) plot_tempNet(network = adjWeight, activation = result_we, timestep = 5)

result_we %>% dplyr::filter(time == 0) result_we %>% dplyr::filter(time == 1) result_we %>% dplyr::filter(time == 2) result_we %>% dplyr::filter(time == 3) result_we %>% dplyr::filter(time == 4) result_we %>% dplyr::filter(time == 5)

sessionInfo() `

R version 4.2.2 (2022-10-31 ucrt) Platform: x86_64-w64-mingw32/x64 (64-bit) Running under: Windows 10 x64 (build 19045)

Matrix products: default

locale: [1] LC_COLLATE=German_Switzerland.utf8 LC_CTYPE=German_Switzerland.utf8 LC_MONETARY=German_Switzerland.utf8 [4] LC_NUMERIC=C LC_TIME=German_Switzerland.utf8

attached base packages: [1] stats graphics grDevices utils datasets methods base

other attached packages: [1] ggraph_2.1.0 tidygraph_1.2.3 spreadr_0.2.0 Rcpp_1.0.10 igraph_1.5.1 scales_1.2.1 lubridate_1.9.2 forcats_1.0.0
[9] stringr_1.5.0 dplyr_1.1.0 purrr_1.0.1 readr_2.1.4 tidyr_1.3.0 tibble_3.1.8 ggplot2_3.4.1 tidyverse_2.0.0

loaded via a namespace (and not attached): [1] pillar_1.9.0 compiler_4.2.2 viridis_0.6.2 tools_4.2.2 bit_4.0.5 digest_0.6.31 lattice_0.20-45
[8] viridisLite_0.4.1 lifecycle_1.0.3 gtable_0.3.3 timechange_0.2.0 pkgconfig_2.0.3 rlang_1.1.0 Matrix_1.5-1
[15] cli_3.6.0 rstudioapi_0.14 parallel_4.2.2 ggrepel_0.9.3 gridExtra_2.3 withr_2.5.0 graphlayouts_1.0.0 [22] generics_0.1.3 vctrs_0.5.2 hms_1.1.3 bit64_4.0.5 grid_4.2.2 tidyselect_1.2.0 glue_1.6.2
[29] R6_2.5.1 fansi_1.0.4 vroom_1.6.1 polyclip_1.10-4 farver_2.1.1 tweenr_2.0.2 tzdb_0.3.0
[36] magrittr_2.0.3 MASS_7.3-58.3 assertthat_0.2.1 ggforce_0.4.1 colorspace_2.1-0 labeling_0.4.2 utf8_1.2.2
[43] stringi_1.7.12 munsell_0.5.0 crayon_1.5.2

This is my first bug report, I hope I haven't missed something!

csqsiew commented 1 year ago

Hello, could you attach the bug.csv file? It was mentioned in your code.

In addition, did you try this with the github version of spreadr? You can download it via devtools::install_github("csqsiew/spreadr")

When I ran your code (based on my re-construction of I think what bug.csv included) I obtained the following:

   node activation time
1  tgt1    0.00000    0
2  tgt2  100.00000    0
3  att1    0.00000    0
4  att2    0.00000    0
5  tgt1    0.00000    1
6  tgt2    0.00000    1
7  att1   83.33333    1
8  att2   16.66667    1
9  tgt1   43.75000    2
10 tgt2   56.25000    2
11 att1    0.00000    2
12 att2    0.00000    2

It seemed like att1 and att2 received different activation values.

marcobiella commented 1 year ago

bug.csv

Hi! I attached the bug.csv file for completeness but the issue is solved using the GitHub version of the package.

Thanks for your help (and for the amazing package)!

csqsiew commented 1 year ago

You are welcome and thanks for the kind words :) I will close the issue now.