Merge pull request #16 from natverse/feature/cf_partner_summary-enh

cf_partner summary enh

R/partners.R

@@ -136,13 +136,19 @@ connection_table2queryids <- function(x) {
 #'
 #' @param rval Choose what the function will return. \code{sparse} and
 #'   \code{matrix} return sparse and dense (standard) matrices, respectively.
+#' @param aggregate.query Whether to aggregate all query neurons of the same
+#'   type (the default) or when \code{aggregate.query=FALSE} only to aggregate
+#'   the partner neurons.
+#' @param normalise Whether to normalise the reported weights as a fraction of
+#'   the total for each query cell type (or individual query neuron when
+#'   \code{aggregate.query=TRUE}).
 #' @inheritParams cf_partners
 #' @return a data.frame or (sparse) matrix based on \code{rval}. The column
 #'   \code{n} refers to the number of \emph{partner} neurons.
 #' @export
 #' @details This function currently groups by dataset, and pre and postsynaptic
-#' type. It does not currently group by side. The forms returning matrices rely
-#' on \code{coconat::\link{partner_summary2adjacency_matrix}}.
+#'   type. It does not currently group by side. The forms returning matrices
+#'   rely on \code{coconat::\link{partner_summary2adjacency_matrix}}.
 #'
 #' @examples
 #' \dontrun{
@@ -156,8 +162,10 @@ connection_table2queryids <- function(x) {
 #'     names_from = c(type.post,dataset), values_from = weight, values_fill = 0)
 #' }
 #' @importFrom glue glue
-#' @importFrom dplyr .data select mutate left_join group_by n_distinct summarise arrange desc
+#' @importFrom dplyr .data select mutate left_join group_by n_distinct summarise
+#'   arrange desc
 cf_partner_summary <- function(ids, threshold=1L, partners=c("inputs", "outputs"),
+                               aggregate.query=TRUE, normalise=FALSE,
                                rval=c("data.frame", "sparse", "matrix")) {
   # ids=expand_ids(ids)
   partners=match.arg(partners)
@@ -172,16 +180,32 @@ cf_partner_summary <- function(ids, threshold=1L, partners=c("inputs", "outputs"
   names(join_spec)=paste0(qfix, "_key")
   suffix=paste0(".",c(pfix, qfix))
 
+  gv <- if(aggregate.query) c("dataset", "type.pre", "type.post") else {
+    pp <- if(qfix=='post')
+      pp %>% mutate(query=post_key)
+    else
+      pp %>% mutate(query=pre_key)
+    c("dataset", "query", "type.pre", "type.post")
+  }
+
   pp2 <- pp %>%
     select(-dataset) %>%
     left_join(qmeta, by = join_spec, suffix=suffix) %>%
-    group_by(dataset, type.pre, type.post) %>%
+    group_by(across(all_of(gv))) %>%
     summarise(weight=sum(weight),
               npre=n_distinct(pre_key),
               npost=n_distinct(post_key),
               .groups='drop') %>%
-    arrange(desc(weight)) %>%
-    mutate(query=paste0(abbreviate_datasets(dataset),":", .data[[glue("type.{qfix}")]]))
+    arrange(desc(weight))
+  if(aggregate.query) {
+    # make a query type
+    pp2 <- pp2 %>%
+      mutate(query=paste0(abbreviate_datasets(dataset),":", .data[[glue("type.{qfix}")]]))
+  }
+  if(normalise) {
+    pp2 <- pp2 %>% group_by(query) %>% mutate(weight=weight/sum(weight)) %>% ungroup()
+  }
+
   if(rval=='data.frame')
     return(pp2)
   pp2 %>%