WIP implement alternative to cosine clustering

DESCRIPTION

@@ -24,7 +24,7 @@ Imports:
     glue,
     checkmate,
     dplyr,
-    coconat (> 0.1.2),
+    coconat (>= 0.1.2.9000),
     stringr,
     magrittr,
     bit64,
@@ -59,7 +59,7 @@ Remotes:
     natverse/neuprintr,
     catmaid=natverse/rcatmaid,
     natverse/nat.h5reg,
-    natverse/coconat
+    natverse/coconat@feature/connectivity-similarity
 RoxygenNote: 7.3.3
 URL: https://github.com/natverse/coconatfly,
     https://natverse.org/coconatfly/

R/cosine.R

@@ -1,6 +1,8 @@
 # private function taking a list of input and output connection tables
-# and turning them into a cosine matrix
-multi_cosine_matrix <- function(x, partners, nas, group='type') {
+# and turning them into a similarity matrix
+multi_cosine_matrix <- function(x, partners, nas, group='type',
+                                metric=c("cosine", "jaccard", "weighted_jaccard", "tanimoto")) {
+  metric=match.arg(metric)
   if(is.data.frame(x)) {
     x=split(x, x$partners)
     partners=names(x)
@@ -19,18 +21,18 @@ multi_cosine_matrix <- function(x, partners, nas, group='type') {
       inputcol = 'pre_key',
       outputcol = groupcol,
       inputids = ids)
-    cm[['cout']] = coconat::cosine_sim(oam, transpose = T)
+    cm[['cout']] = coconat::connectivity_similarity(oam, metric = metric, transpose = T)
     cm[['wout']]=sum(x[['outputs']]$weight)
   }
   if('inputs' %in% partners) {
     groupcol <- if(isFALSE(group)) "pre_key" else group
     iam <- coconat::partner_summary2adjacency_matrix(
       x[['inputs']],
       inputcol = groupcol, outputcol = 'post_key', outputids = ids)
-    cm[['cin']] = coconat::cosine_sim(iam, transpose = F)
+    cm[['cin']] = coconat::connectivity_similarity(iam, metric = metric, transpose = F)
     cm[['win']]=sum(x[['inputs']]$weight)
   }
-  cm <- coconat::prepare_cosine_matrix(cm, partners = partners, action=nas)
+  cm <- coconat::prepare_similarity_matrix(cm, partners = partners, action=nas)
   cm
 }
 
@@ -85,6 +87,8 @@ multi_cosine_matrix <- function(x, partners, nas, group='type') {
 #'   limitation in the second case.
 #' @param matrix Whether to return the raw cosine matrix (rather than a
 #'   heatmap/dendrogram)
+#' @param metric Similarity metric to use. One of \code{"cosine"},
+#'   \code{"jaccard"}, \code{"weighted_jaccard"}, or \code{"tanimoto"}.
 #' @param drop_dataset_prefix Whether to remove dataset prefix such as
 #'   \code{hb:} or \code{fw:} from dendrograms. This is useful when reviewing
 #'   neurons in interactive mode.
@@ -240,6 +244,7 @@ cf_cosine_plot <- function(ids=NULL, ..., threshold=5,
                            group='type',
                            heatmap=TRUE,
                            matrix=FALSE,
+                           metric=c("cosine", "jaccard", "weighted_jaccard", "tanimoto"),
                            interactive=FALSE,
                            drop_dataset_prefix=FALSE,
                            keep.all.meta=TRUE,
@@ -248,14 +253,15 @@ cf_cosine_plot <- function(ids=NULL, ..., threshold=5,
                            method=c("ward.D", "single", "complete", "average",
                                     "mcquitty", "median", "centroid", "ward.D2")) {
   method=match.arg(method)
+  metric=match.arg(metric)
   partners=match.arg(partners, several.ok = T)
   if(is.mct(ids)) {
     x=ids
     partners=unique(x$partners)
   } else
     x=multi_connection_table(ids, partners = partners, threshold = threshold, group=group, min_datasets = min_datasets)
 
-  cm <- multi_cosine_matrix(x, partners = partners, group=group, nas=nas)
+  cm <- multi_cosine_matrix(x, partners = partners, group=group, nas=nas, metric=metric)
 
   if(is.character(labRow) && length(labRow)==1 && any(grepl("\\{", labRow))) {
     tm=cf_meta(colnames(cm), keep.all = keep.all.meta)
@@ -291,8 +297,8 @@ cf_cosine_plot <- function(ids=NULL, ..., threshold=5,
     colnames(cm)=sub("^[a-z]+:","", colnames(cm))
   if(isTRUE(matrix))
     return(cm)
-  coconat:::cosine_heatmap(cm, interactive = interactive, labRow = labRow,
-                           method = method, heatmap=heatmap, ...)
+  coconat:::connectivity_heatmap(cm, interactive = interactive, labRow = labRow,
+                                 method = method, heatmap=heatmap, ...)
 }
 
 
@@ -406,4 +412,3 @@ multi_connection_table <- function(ids, partners=c("inputs", "outputs"),
 is.mct <- function(x) {
   is.data.frame(x) && all(c("pre_id", "post_id", "dataset", "partners") %in% colnames(x))
 }
-

R/triple.R

@@ -74,6 +74,8 @@ triple_meta <- function(ids, version=fafbseg::flywire_connectome_data_version())
 #'   \emph{OR} a function to plot the heatmap whose argument names are
 #'   compatible with \code{stats::\link{heatmap}}. \code{gplots::heatmap.2} is a
 #'   good example.
+#' @param metric Similarity metric to use. One of \code{"cosine"},
+#'   \code{"jaccard"}, \code{"weighted_jaccard"}, or \code{"tanimoto"}.
 #' @param nas What to do with rows/columns with NAs when computing cosine
 #'   matrix. Dropping may be more mathematically satisfactory but eliminates
 #'   neurons from the comparison, so the default is to set NA elements to do 0
@@ -105,18 +107,20 @@ triple_cosine_plot <- function(x, fwtype=x, version=NULL, ..., threshold=5,
                                labRow='{type}_{abbreviate_datasets(dataset)}{side}',
                                group='type',
                                heatmap=TRUE,
+                               metric=c("cosine", "jaccard", "weighted_jaccard", "tanimoto"),
                                interactive=FALSE,
                                nas=c('zero','drop'),
                                method=c("ward.D", "single", "complete", "average",
                                         "mcquitty", "median", "centroid", "ward.D2")) {
   method=match.arg(method)
+  metric=match.arg(metric)
   partners=match.arg(partners, several.ok = T)
   if(is.null(version))
     version=flywire_connectome_data_version()
   if(!is.data.frame(x))
     x=triple_connection_table(x, fwtype, partners = partners, threshold = threshold, version = version, group=group)
 
-  cm <- multi_cosine_matrix(x, partners = partners, group=group, nas=nas)
+  cm <- multi_cosine_matrix(x, partners = partners, group=group, nas=nas, metric=metric)
 
   if(is.character(labRow) && length(labRow)==1 && any(grepl("\\{", labRow))) {
     tm=cf_meta(colnames(cm))
@@ -128,6 +132,6 @@ triple_cosine_plot <- function(x, fwtype=x, version=NULL, ..., threshold=5,
       stop("Please install/update suggested package coconat.\n",
            "natmanager::install(pkgs = 'coconat')\n","is a good way to do this")
   }
-  coconat:::cosine_heatmap(cm, interactive = interactive, labRow = labRow,
-                           method = method, heatmap=heatmap, ...)
+  coconat:::connectivity_heatmap(cm, interactive = interactive, labRow = labRow,
+                                 method = method, heatmap=heatmap, ...)
 }

tests/testthat/test-cosine.R

@@ -35,6 +35,22 @@ test_that("cosine plots work", {
 })
 
 
+test_that("cf_cosine_plot supports alternative similarity metrics", {
+  ids <- cf_ids(hemibrain="/type:LAL00.+")
+  ref <- cf_cosine_plot(ids, group = FALSE, heatmap = FALSE, matrix = TRUE)
+
+  for(metric in c("jaccard", "weighted_jaccard", "tanimoto")) {
+    cm <- cf_cosine_plot(ids, group = FALSE, heatmap = FALSE, matrix = TRUE,
+                         metric = metric)
+    expect_true(is.matrix(cm), info = metric)
+    expect_equal(dim(cm), dim(ref), info = metric)
+    expect_equal(rownames(cm), rownames(ref), info = metric)
+    expect_equal(colnames(cm), colnames(ref), info = metric)
+    expect_equal(unname(diag(cm)), rep(1, nrow(cm)), info = metric)
+  }
+})
+
+
 test_that("cosine plot with no partners", {
   op <- options(fafbseg.use_static_celltypes=T)
   on.exit(options(op))