From 8749a5b03745a774620856d5824cab0de18b0acf Mon Sep 17 00:00:00 2001
From: Gregory Jefferis <jefferis@gmail.com>
Date: Thu, 30 Jan 2020 01:31:37 +0000
Subject: [PATCH] fix bug swapping pre/post partners

* basic tests
* examples
---
 R/connectivity.R                    | 36 +++++++++++++++++++++--------
 man/neuprint_simple_connectivity.Rd |  6 +++++
 tests/testthat/test-connectivity.R  |  2 ++
 3 files changed, 35 insertions(+), 9 deletions(-)

diff --git a/R/connectivity.R b/R/connectivity.R
index 011f7226..5d5f7d75 100644
--- a/R/connectivity.R
+++ b/R/connectivity.R
@@ -228,25 +228,43 @@ neuprint_common_connectivity <- function(bodyids, statuses = NULL,
 #' @seealso \code{\link{neuprint_common_connectivity}},
 #'   \code{\link{neuprint_get_adjacency_matrix}}
 #' @export
-#' @rdname neuprint_simple_connectivity
+#' @examples
+#' inputs <- neuprint_simple_connectivity(5901222731, prepost='PRE')
+#' head(inputs)
+#' # top inputs
+#' head(sort(table(inputs$type), decreasing = TRUE))
+#' outputs <- neuprint_simple_connectivity(5901222731, prepost='POST')
+#' head(outputs)
 neuprint_simple_connectivity <- function(bodyids,
                                          prepost = c("PRE","POST"),
                                          dataset = NULL,
                                          conn = NULL,
                                          ...){
   prepost = match.arg(prepost)
-  find_inputs = ifelse(prepost=="PRE", "false","true")
-  # nb looks odd, but convert back to character to allow pblapply ...
   dataset=check_dataset(dataset = dataset)
   bodyids=unique(id2char(bodyids))
-  if(length(bodyids)>10){
-    m  = Reduce(function(x,y,...) dplyr::full_join(x,y,by=c("name",ifelse(prepost=="PRE","output","input"),"type")),(pbapply::pblapply(bodyids, function(bi) tryCatch(neuprint_simple_connectivity(
-                                bodyids = bi,
-                                prepost = prepost,
-                                dataset = dataset, conn = conn, ...),
-                                error = function(e) NULL))))
+  if(length(bodyids)>10) {
+    m  = Reduce(function(x, y, ...)
+      dplyr::full_join(x, y, by = c(
+        "name", partners, "type"
+      )),
+      (pbapply::pblapply(bodyids, function(bi)
+        tryCatch(
+          neuprint_simple_connectivity(
+            bodyids = bi,
+            partners = partners,
+            dataset = dataset,
+            conn = conn,
+            ...
+          ),
+          error = function(e)
+            NULL
+        ))))
+    # FIXME need to convert NA weights to 0
     return(m)
   }
+
+  find_inputs = ifelse(prepost=="PRE", "true", "false")
   Payload = noquote(sprintf('{"dataset":"%s","neuron_ids":%s,"find_inputs":%s}',
                             dataset,
                             id2json(bodyids),
diff --git a/man/neuprint_simple_connectivity.Rd b/man/neuprint_simple_connectivity.Rd
index 78fa02ab..857485ad 100644
--- a/man/neuprint_simple_connectivity.Rd
+++ b/man/neuprint_simple_connectivity.Rd
@@ -41,6 +41,12 @@ Get all of the neurons in the database that connect to the
 da2s=neuprint_search(".*DA2.*")
 neuprint_common_connectivity(da2s$bodyid)
 }
+inputs <- neuprint_simple_connectivity(5901222731, prepost='PRE')
+head(inputs)
+# top inputs
+head(sort(table(inputs$type), decreasing = TRUE))
+outputs <- neuprint_simple_connectivity(5901222731, prepost='POST')
+head(outputs)
 }
 \seealso{
 \code{\link{neuprint_common_connectivity}},
diff --git a/tests/testthat/test-connectivity.R b/tests/testthat/test-connectivity.R
index 5392df3a..1d426c2b 100644
--- a/tests/testthat/test-connectivity.R
+++ b/tests/testthat/test-connectivity.R
@@ -15,4 +15,6 @@ test_that("neuprint_connection_table works", {
   expect_equal(colnames(t1), rownames(t1))
   expect_is(t2 <- neuprint_common_connectivity(da2s$bodyid), 'matrix')
   expect_equal(rownames(t1), rownames(t2))
+  expect_is(t3 <- neuprint_simple_connectivity(da2s$bodyid[1], prepost='PRE'),
+            'data.frame')
 })