From d4362df0fa61ebc8f91dea13be664a6a65d0065b Mon Sep 17 00:00:00 2001
From: Dominik Krzeminski <dkk33@cam.ac.uk>
Date: Thu, 23 Jun 2022 11:51:54 +0100
Subject: [PATCH] dotprops vectors direction included in topo

---
 R/dotprops.R | 26 +++++++++++++++++++++++---
 1 file changed, 23 insertions(+), 3 deletions(-)

diff --git a/R/dotprops.R b/R/dotprops.R
index ae78f880..ed5296e5 100644
--- a/R/dotprops.R
+++ b/R/dotprops.R
@@ -162,7 +162,11 @@ dotprops.neuron<-function(x, Labels=NULL, resample=NA, topo=FALSE, ...) {
   if(is.null(Labels) || isTRUE(Labels)) Labels=x$d$Label
   else if(is.logical(labels) && labels==FALSE) Labels=NULL
   topo_features <- NULL
-  if (isTRUE(topo)) topo_features <- get_topo_features(x)
+  if (isTRUE(topo)) {
+    topo_features <- get_topo_features(x)
+    topo_features$Parent <- x$d$Parent
+    topo_features$PointNo <- x$d$PointNo
+  }
   dotprops(xyzmatrix(x), Labels=Labels, topo_features=topo_features, ...)
 }
 
@@ -261,10 +265,21 @@ dotprops.default<-function(x, k=NULL, Labels=NULL, na.rm=FALSE, topo_features=NU
     vect[i,]=v1d1$vectors[,1]
   }
   rlist=list(points=x,alpha=alpha,vect=vect)
-  
   rlist$labels=Labels
-  
+
   if (!is.null(topo_features)) {
+    # orient vectors so they look at their parent
+    vect_orientations <- rep(TRUE, npoints)
+    for (i in 1:npoints) {
+      par_id = topo_features$Parent[[i]]
+      if (par_id == -1) next
+      pnt_idx = which(topo_features$PointNo == par_id)
+      vect_orientations[[i]] <- is_pointing_towards(x[pnt_idx,], x[i,], vect[i])
+    }
+    vect[!vect_orientations,] <- -vect[!vect_orientations,]
+    rlist$vect = vect
+    topo_features$Parent <- NULL
+    topo_features$PointNo <- NULL
     rlist$topo <- topo_features
   }
   
@@ -272,6 +287,11 @@ dotprops.default<-function(x, k=NULL, Labels=NULL, na.rm=FALSE, topo_features=NU
   return(as.dotprops(rlist))
 }
 
+is_pointing_towards <- function(soma_position, point_pos, vects) {
+  to_point <- soma_position - point_pos
+  dotprod(to_point, vects) > 0
+}
+
 # internal function to convert a dotprops object to SWC
 # representation.
 dotprops2swc<-function(x, label=0L, veclength=1, radius=0) {