sync; broken

decomverse · Sep 16, 2024 · 029d5f9 · 029d5f9
1 parent df5b35e
commit 029d5f9
Show file tree

Hide file tree

Showing 13 changed files with 308 additions and 674 deletions.
diff --git a/.gitignore b/.gitignore
@@ -18,4 +18,4 @@ README.md
 pybind11/
 .vscode/
 *.code-workspace
-
+.lintr
diff --git a/ACTIONet.code-workspace b/ACTIONet.code-workspace
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -27,4 +27,4 @@ biocViews: ACTION, ACTIONet, ArchetypalAnalysis, GeneExpression, RNASeq, SingleC
 Remotes: shmohammadi86/ACTIONetExperiment,shmohammadi86/SCINET,immunogenomics/harmony
 Encoding: UTF-8
 VignetteBuilder: knitr
-RoxygenNote: 7.2.2
+RoxygenNote: 7.3.1
diff --git a/R/RcppExports.R b/R/RcppExports.R
@@ -304,12 +304,26 @@ NULL
 #' @param resolution_parameter Granularity of clustering. Larger values result
 NULL
 
+#'
+#' @return clusters Assignment vector of samples to clusters
+#'
+#' @examples
+#' clusters = signed_cluster(G_signed)
+NULL
+
 #' Computes graph clustering using Leiden algorith over unsigned graphs
 #'
 #' @param G Adjacency matrix of the input graph
 #' @param resolution_parameter Granularity of clustering. Larger values result
 NULL
 
+#'
+#' @return clusters Assignment vector of samples to clusters
+#'
+#' @examples
+#' clusters = unsigned_cluster(G)
+NULL
+
 #' Computes a coreset for archetypal analysis
 #' Ref: Coresets for Archetypal Analysis
 NULL
@@ -825,28 +839,6 @@ MWM_hungarian <- function(G) {
     .Call(`_ACTIONet_MWM_hungarian`, G)
 }
 
-#'
-#' @return clusters Assignment vector of samples to clusters
-#'
-#' @examples
-#' clusters = signed_cluster(G_signed)
-signed_cluster <- function(A, resolution_parameter = 1.0, initial_clusters_ = NULL, seed = 0L) {
-    .Call(`_ACTIONet_signed_cluster`, A, resolution_parameter, initial_clusters_, seed)
-}
-
-unsigned_cluster_batch <- function(A, resolutions, initial_clusters_ = NULL, seed = 0L) {
-    .Call(`_ACTIONet_unsigned_cluster_batch`, A, resolutions, initial_clusters_, seed)
-}
-
-#'
-#' @return clusters Assignment vector of samples to clusters
-#'
-#' @examples
-#' clusters = unsigned_cluster(G)
-unsigned_cluster <- function(A, resolution_parameter = 1.0, initial_clusters_ = NULL, seed = 0L) {
-    .Call(`_ACTIONet_unsigned_cluster`, A, resolution_parameter, initial_clusters_, seed)
-}
-
 sgd2_layout_weighted <- function(G, S_r, t_max = 30L, eps = .01, seed = 0L) {
     .Call(`_ACTIONet_sgd2_layout_weighted`, G, S_r, t_max, eps, seed)
 }
@@ -1117,5 +1109,5 @@ computeSparseRowVariances <- function(j, val, rm, n) {
 
 # Register entry points for exported C++ functions
 methods::setLoadAction(function(ns) {
-    .Call('_ACTIONet_RcppExport_registerCCallable', PACKAGE = 'ACTIONet')
+    .Call(`_ACTIONet_RcppExport_registerCCallable`)
 })
diff --git a/R/clusters.R b/R/clusters.R
@@ -239,54 +239,55 @@ cluster.graph <- function(G,
                           resolution_parameter = 0.5,
                           initial_clusters = NULL,
                           seed = 0) {
-  if (is.matrix(G)) {
-    G <- as(G, "sparseMatrix")
-  }
-
-  is.signed <- FALSE
-  if (min(G) < 0) {
-    is.signed <- TRUE
-    print("Graph is signed. Switching to signed graph clustering mode.")
-  }
-
-  if (!is.null(initial_clusters)) {
-    print("Perform graph clustering with *prior* initialization")
-
-    if (is.signed) {
-      clusters <- as.numeric(signed_cluster(
-        A = G,
-        resolution_parameter = resolution_parameter,
-        initial_clusters_ = initial_clusters,
-        seed = seed
-      ))
-    } else {
-      clusters <- as.numeric(unsigned_cluster(
-        A = G,
-        resolution_parameter = resolution_parameter,
-        initial_clusters_ = initial_clusters,
-        seed = seed
-      ))
-    }
-  } else {
-    print("Perform graph clustering with *uniform* initialization")
-
-    if (is.signed) {
-      clusters <- as.numeric(signed_cluster(
-        A = G,
-        resolution_parameter = resolution_parameter,
-        initial_clusters_ = NULL,
-        seed = seed
-      ))
-    } else {
-      clusters <- as.numeric(unsigned_cluster(
-        A = G,
-        resolution_parameter = resolution_parameter,
-        initial_clusters_ = NULL,
-        seed = seed
-      ))
-    }
-  }
-  return(clusters)
+  # if (is.matrix(G)) {
+  #   G <- as(G, "sparseMatrix")
+  # }
+
+  # is.signed <- FALSE
+  # if (min(G) < 0) {
+  #   is.signed <- TRUE
+  #   print("Graph is signed. Switching to signed graph clustering mode.")
+  # }
+
+  # if (!is.null(initial_clusters)) {
+  #   print("Perform graph clustering with *prior* initialization")
+
+  #   if (is.signed) {
+  #     clusters <- as.numeric(signed_cluster(
+  #       A = G,
+  #       resolution_parameter = resolution_parameter,
+  #       initial_clusters_ = initial_clusters,
+  #       seed = seed
+  #     ))
+  #   } else {
+  #     clusters <- as.numeric(unsigned_cluster(
+  #       A = G,
+  #       resolution_parameter = resolution_parameter,
+  #       initial_clusters_ = initial_clusters,
+  #       seed = seed
+  #     ))
+  #   }
+  # } else {
+  #   print("Perform graph clustering with *uniform* initialization")
+
+  #   if (is.signed) {
+  #     clusters <- as.numeric(signed_cluster(
+  #       A = G,
+  #       resolution_parameter = resolution_parameter,
+  #       initial_clusters_ = NULL,
+  #       seed = seed
+  #     ))
+  #   } else {
+  #     clusters <- as.numeric(unsigned_cluster(
+  #       A = G,
+  #       resolution_parameter = resolution_parameter,
+  #       initial_clusters_ = NULL,
+  #       seed = seed
+  #     ))
+  #   }
+  # }
+  # return(clusters)
+  return(NULL)
 }
 
 #' @export
@@ -443,4 +444,4 @@ clusterCells <- function(ace, algorithm = "leiden",
   ace <- computeGeneSpecifity.ace(ace, cl, out_name = cluster_name)
 
   return(ace)
-}
+}
diff --git a/R/pseudobulk_DGE.R b/R/pseudobulk_DGE.R
@@ -116,104 +116,6 @@ get.pseudobulk.SE <- function(
     return(se)
 }
 
-#' @export
-get.pseudobulk.SE.old <- function(
-  ace,
-  sample_attr,
-  ensemble = FALSE,
-  bins = 20,
-  assay = "counts",
-  col_data = NULL,
-  pseudocount = 0,
-  with_S = FALSE,
-  with_E = FALSE,
-  with_V = FALSE,
-  min_cells_per_batch = 3,
-  BPPARAM = BiocParallel::SerialParam()
-) {
-
-    IDX = ACTIONetExperiment::get.data.or.split(ace, attr = sample_attr, to_return = "split")
-    good_batches = sapply(IDX, length) >= min_cells_per_batch
-
-    if(!any(good_batches)){
-      msg = sprintf("No samples remaining.")
-      warning(msg)
-      return(NULL)
-    } else if(!all(good_batches)) {
-      old_batches = names(IDX)
-      ace = ace[, ace[[sample_attr]] %in% names(good_batches[good_batches])]
-      IDX = ACTIONetExperiment::get.data.or.split(ace, attr = sample_attr, to_return = "split")
-      bad_batch_names = setdiff(old_batches, names(IDX))
-      msg = sprintf("Samples Dropped: %s\n", paste0(bad_batch_names, collapse = ", "))
-      message(msg)
-    }
-
-    counts_mat = SummarizedExperiment::assays(ace)[[assay]]
-    sample_names = names(IDX)
-    counts_list = bplapply(IDX, function(idx) counts_mat[, idx, drop = FALSE], BPPARAM = BPPARAM)
-
-    se_assays = list()
-
-    S0 = do.call(cbind, bplapply(counts_list, ACTIONetExperiment:::fastRowSums, BPPARAM = BPPARAM)) + pseudocount
-    se_assays$counts = S0
-
-    if (with_E == TRUE) {
-      E0 = do.call(cbind, bplapply(counts_list, ACTIONetExperiment:::fastRowMeans, BPPARAM = BPPARAM))
-      se_assays$mean = E0
-    }
-
-    if (with_V == TRUE) {
-      V0 = do.call(cbind, bplapply(counts_list,  MatrixGenerics::rowVars, BPPARAM = BPPARAM))
-      se_assays$var = V0
-    }
-
-    if (ensemble == TRUE) {
-        if (!any(with_S, with_E, with_V)) {
-            err = sprintf("No ensemble assays to make.\n")
-            stop(err)
-        }
-
-        mr_assays = .make_ensemble_assays(
-          counts_list = counts_list,
-          bins = bins,
-          pseudocount = pseudocount,
-          with_S = with_S,
-          with_E = with_E,
-          with_V = with_V,
-          BPPARAM = BPPARAM
-        )
-        se_assays = c(se_assays, mr_assays$assays)
-    }
-
-    n_cells = sapply(counts_list, NCOL)
-    nnz_feat_mean = sapply(counts_list, function(X) mean(Matrix::colSums(X > 0)))
-    cd = data.frame(
-      n_cells = n_cells,
-      nnz_feat_mean = nnz_feat_mean,
-      sample = factor(sample_names)
-    )
-
-    if (!is.null(col_data)) {
-        md = col_data[col_data[[sample_attr]] %in% sample_names, , drop = FALSE]
-        md = md[match(sample_names, md[[sample_attr]]), , drop = FALSE]
-        cd = data.frame(md, cd)
-    }
-    rownames(cd) = sample_names
-    cd = droplevels(cd)
-    se = SummarizedExperiment::SummarizedExperiment(
-      assays = se_assays,
-      colData = cd,
-      rowData = SummarizedExperiment::rowData(ace)
-    )
-
-    if (ensemble == TRUE) {
-        S4Vectors::metadata(se)[["bins"]] = bins
-    }
-
-    invisible(gc())
-    return(se)
-}
-
 .make_ensemble_assays <- function(
   counts_list,
   bins,