Add node degree

Signed-off-by: Liang Zhang <psychelzh@outlook.com>
psychelzh · Mar 9, 2024 · d7fcabf · d7fcabf
1 parent a2abdf5
commit d7fcabf
Show file tree

Hide file tree

Showing 2 changed files with 59 additions and 28 deletions.
diff --git a/R/cpm.R b/R/cpm.R
@@ -46,34 +46,49 @@ calc_dice_pairs <- function(result, level) {
     enframe(name = "network", value = "dice")
 }
 
-calc_edges_enrich <- function(result, atlas_dseg, level = 0.5) {
-  cbind(
-    as_tibble(
-      t(combn(atlas_dseg$network_label, 2)),
-      .name_repair = ~ c("row", "col")
-    ),
-    result$edges > level * length(unique(result$folds))
+binarize_edges <- function(result, level = 0.5) {
+  result$edges > level * length(unique(result$folds))
+}
+
+calc_edges_degree <- function(edges) {
+  apply(
+    edges, 2,
+    \(x) colSums(Rfast::squareform(x)),
+    simplify = FALSE
+  ) |>
+    enframe(name = "network", value = "degree")
+}
+
+calc_edges_enrich <- function(edges, atlas_dseg) {
+  labels <- with(atlas_dseg, coalesce(network_label, atlas_name)) |>
+    fct_collapse(Subcortical = c("CIT168Subcortical", "SubcorticalHCP")) |>
+    as.character()
+  network_pairs <- as_tibble(
+    t(combn(labels, 2)),
+    .name_repair = ~ c("row", "col")
+  )
+  apply(
+    edges, 2,
+    \(x) {
+      cbind(network_pairs, val = x) |>
+        drop_na() |>
+        mutate(
+          label_x = pmin(row, col),
+          label_y = pmax(row, col),
+          .keep = "unused"
+        ) |>
+        summarise(
+          n = sum(val),
+          total = n(),
+          .by = c(label_x, label_y)
+        ) |>
+        mutate(
+          prop = n / total,
+          enrich = (n / sum(n)) / (total / sum(total))
+        )
+    }
   ) |>
-    drop_na() |>
-    mutate(
-      label_x = pmin(row, col),
-      label_y = pmax(row, col),
-      .keep = "unused"
-    ) |>
-    pivot_longer(
-      c(pos, neg),
-      names_to = "network",
-      values_to = "val"
-    ) |>
-    summarise(
-      n = sum(val),
-      total = n(),
-      .by = c(label_x, label_y, network)
-    ) |>
-    mutate(
-      prop = n / total,
-      enrich = (n / sum(n)) / (total / sum(total))
-    )
+    list_rbind(names_to = "network")
 }
 
 match_confounds <- function(users_confounds, fd_mean) {

diff --git a/_scripts/predict_phenotypes.R b/_scripts/predict_phenotypes.R
@@ -47,10 +47,16 @@ cpm_branches <- tarchetypes::tar_map(
     retrieval = "worker",
     storage = "worker"
   ),
+  tar_target(edges, lapply(cpm_result, binarize_edges)),
+  tar_target(
+    edges_degree,
+    lapply(edges, calc_edges_degree) |>
+      list_rbind(names_to = "latent"),
+  ),
   tar_target(
     edges_enrich,
     lapply(
-      cpm_result,
+      edges,
       calc_edges_enrich,
       atlas_dseg = qs::qread(file_atlas_dseg)
     ) |>
@@ -114,6 +120,16 @@ list(
     ),
     deployment = "main"
   ),
+  tarchetypes::tar_combine(
+    edges_degree,
+    cpm_branches$edges_degree,
+    command = bind_rows_meta(
+      !!!.x,
+      .names = c(names(config_fc), names(hypers_cpm)),
+      .prefix = "edges_degree"
+    ),
+    deployment = "main"
+  ),
   tarchetypes::tar_combine(
     edges_enrich,
     cpm_branches$edges_enrich,