Merge pull request #4 from danforthcenter/identity_networks

accounting for single asv clusters
danforthcenter · Sep 5, 2024 · 3bb2744 · 3bb2744
2 parents eb59c10 + 9267740
commit 3bb2744
Show file tree

Hide file tree

Showing 3 changed files with 12 additions and 3 deletions.
diff --git a/R/netThresh.R b/R/netThresh.R
@@ -70,12 +70,19 @@ netThresh <- function(net, asvTab, asvCols = NULL, clusterCol = NULL, cluster =
   #* `take nodes in a given cluster and aggregate a count in the asv table`
   clust_ag <- do.call(cbind, lapply(cluster, function(clust) {
     asvs_in_cluster <- nodes[nodes[[clusterCol]] == clust, "asv"]
-    setNames(data.frame(rowSums(asvTab[, c(asvs_in_cluster)])), c(paste0("cluster_", clust)))
+    setNames(
+      data.frame(
+        rowSums(
+          as.data.frame(asvTab[, c(asvs_in_cluster)])
+        )
+      ), c(paste0("cluster_", clust))
+    )
   }))
   clusterColumns <- colnames(clust_ag)
   clust_ag <- cbind(asvTab[, -which(colnames(asvTab) %in% asvCols)], clust_ag)
   #* `calibrate phenotype by calibratePheno`
   netThreshOut <- do.call(rbind, lapply(phenoCols, function(phenotype) {
+    clust_ag <- clust_ag[!is.na(clust_ag[[phenotype]]), ]
     if (!is.null(calibratePheno)) {
       formString <- paste0(phenotype, "~", paste0(calibratePheno, collapse = "+"))
       clust_ag[[phenotype]] <- residuals(lm(as.formula(formString), data = clust_ag))
@@ -109,6 +116,7 @@ netThresh <- function(net, asvTab, asvCols = NULL, clusterCol = NULL, cluster =
           out$phenotype <- phenotype
           out$model <- model
           out$clusterType <- clusterCol
+          out$model_id <- paste(clusterCol, col, phenotype, model, sep = "_")
           if (!is.null(calibratePheno)) {
             out$calibratePheno <- formString
           }

diff --git a/R/threshPlot.R b/R/threshPlot.R
@@ -38,7 +38,8 @@ threshPlot <- function(thresh, asv, asvCols = NULL, phenotype = NULL, unit = "as
     clusters <- unique(nodes[[clusterCol]])
     clust_ag <- do.call(cbind, lapply(clusters, function(clust) {
       asvs_in_cluster <- nodes[nodes[[clusterCol]] == clust, "asv"]
-      setNames(data.frame(rowSums(asv[, c(asvs_in_cluster)])), c(paste0("cluster_", clust)))
+      setNames(data.frame(rowSums(as.data.frame(asv[, c(asvs_in_cluster)]))),
+               c(paste0("cluster_", clust)))
     }))
     asv <- cbind(asv[, -which(grepl("ASV", colnames(asv)))], clust_ag)
   }

diff --git a/tools/linting.R b/tools/linting.R
@@ -18,7 +18,7 @@ style_pkg("~/syncomBuildR", dry = "off", scope = "line_breaks")
 style_pkg("~/syncomBuildR", dry = "off", scope = "tokens")
 
 if(FALSE){
-  file = "~/syncomBuildR/vignettes/dada2.Rmd"
+  file = "~/syncomBuildR/R/netThresh.R"
   styler::style_file(file, scope = "line_breaks")
   lintr::lint(file, linters = lintr::linters_with_defaults(lintr::line_length_linter(length = 105L),
                                                            lintr::object_name_linter(styles = c("snake_case", "symbols",