Closed marcobiella closed 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.
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)!
You are welcome and thanks for the kind words :) I will close the issue now.
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
)
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!