Circular angle calculations

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: CancerEvolutionVisualization
 Title: Publication Quality Phylogenetic Tree Plots
 Version: 2.0.2
-Date: 2023-12-15
+Date: 2024-04-09
 Authors@R: c(
 	person("Paul Boutros", role = "cre", email = "[email protected]"),
 	person("Adriana Salcedo", role = "aut"),

NEWS

@@ -1,4 +1,8 @@
-CancerEvolutionVisualization 2.0.2 2023-12-15 (Dan Knight)
+CancerEvolutionVisualization 2.0.2 2024-04-09 (Dan Knight)
+
+BUG
+* Fixed angle calculation bug where child angles do not follow
+  their parent angle, instead moving "downward" at 0 degrees.
 
 UPDATE
 * Updated package metadata and README

R/angles.R

@@ -3,11 +3,11 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) {
     node.ids <- c(root.node.id);
 
     total.angle <- total.angle * spread;
-    angles <- numeric(nrow(tree));
+    angles <- v$angle;
 
     while (length(node.ids) > 0) {
         # "Pops" next element in FIFO queue node.ids
-        current.node.id <- node.ids[1];
+        current.node.id <- as.numeric(node.ids[1]);
         node.ids <- node.ids[-1];
 
         parent.id <- tree$parent[tree$tip == current.node.id];
@@ -16,11 +16,17 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) {
             tree$angle[tree$tip == current.node.id] <- 0;
             }
 
-        child.ids <- tree$tip[tree$parent == current.node.id & !is.na(tree$parent)];
+        child.ids <- as.numeric(
+            tree$tip[tree$parent == current.node.id & !is.na(tree$parent)]
+            );
         num.children <- length(child.ids);
 
         if (num.children > 0) {
-            parent.angle <- tree$angle[tree$tip == current.node.id];
+            parent.angle <- angles[current.node.id];
+            if (is.na(parent.angle) || length(parent.angle) == 0) {
+                parent.angle <- 0;
+                angles[current.node.id] <- parent.angle;
+                }
             child.weight <- assign.weight(current.node.id, v);
 
             start.angle <- parent.angle - (total.angle) * (num.children > 1) / 2;
@@ -29,29 +35,39 @@ calculate.angles.radial <- function(v, tree, spread, total.angle) {
 
             for (i in seq_along(child.ids)) {
                 child.id <- child.ids[i];
-                angle <- start.angle + (i - 1) * (angle.increment);
-                angles[tree$tip == child.id] <- angle;
+
+                if (is.na(angles[child.id])) {
+                    angle <- start.angle + (i - 1) * (angle.increment);
+                    angles[tree$tip == child.id] <- angle;
+                    }
                 }
 
             # Appending to end of queue for breadth-first traversal
             node.ids <- append(node.ids, child.ids);
             }
         }
 
-    angles <- override.angles(tree, v, angles);
     return(angles);
     }
 
 calculate.angles.fixed <- function(v, tree, fixed.angle) {
-    angles <- numeric(nrow(tree));
+    angles <- v$angle;
     node.ids <- c(v$id[[1]]);
 
     while (length(node.ids) > 0) {
         # "Pops" next element in FIFO queue node.ids
-        current.node.id <- node.ids[1];
+        current.node.id <- as.numeric(node.ids[1]);
         node.ids <- node.ids[-1];
 
-        child.ids <- tree$tip[tree$parent == current.node.id & !is.na(tree$parent)];
+        parent.angle <- angles[current.node.id];
+        if (is.na(parent.angle) || length(parent.angle) == 0) {
+            parent.angle <- 0;
+            angles[current.node.id] <- parent.angle;
+            }
+
+        child.ids <- as.numeric(
+            tree$tip[tree$parent == current.node.id & !is.na(tree$parent)]
+            );
         num.children <- length(child.ids);
         if (num.children > 0) {
             # Safe to hardcode temporarily. This will only ever apply to
@@ -60,20 +76,23 @@ calculate.angles.fixed <- function(v, tree, fixed.angle) {
             # In future, I would like to remove this fixed angle calculation entirely.
             # It would be ideal to handle all calculations in the same way, and
             # rely more on user defined spread and explicit angle overrides.
-            child.angles <- if (num.children == 1) c(0) else c(-1, 1) * fixed.angle;
+            child.angles <- (if (num.children == 1) c(0) else c(-1, 1)) * fixed.angle;
+            child.angles <- child.angles + parent.angle;
 
             for (i in seq_along(child.ids)) {
                 child.id <- child.ids[i];
-                angle <- child.angles[i];
-                angles[tree$tip == child.id] <- angle;
+
+                if (is.na(angles[child.id])) {
+                    angle <- child.angles[i];
+                    angles[tree$tip == child.id] <- angle;
+                    }
                 }
             }
 
         # Appending to end of queue for breadth-first traversal
         node.ids <- append(node.ids, child.ids);
         }
 
-    angles <- override.angles(tree, v, angles);
     return(angles);
     }
 

tests/testthat/test-angles.R

@@ -124,6 +124,33 @@ test_that(
         }
     );
 
+test_that(
+    'calculate.angles.radial handles children of overriden angle', {
+        num.children <- 4;
+        test.tree <- data.frame(
+            parent = c(-1, rep(1, num.children))
+            );
+        test.tree$tip <- rownames(test.tree)
+
+        test.v <- data.frame(
+            id = test.tree$tip,
+            parent = test.tree$parent,
+            angle = NA
+            );
+        new.angle <- degrees.to.radians(15);
+        test.v[1, 'angle'] <- new.angle;
+
+        result <- calculate.angles.radial(
+            test.v,
+            test.tree,
+            spread = 1,
+            total.angle = pi / 2.5
+            );
+
+        expect_equal(mean(result[-1]), new.angle);
+        }
+    );
+
 test_that(
     'calculate.angles.fixed sets angle correctly', {
         test.tree <- data.frame(
@@ -175,4 +202,32 @@ test_that(
 
         expect_equal(result[angles.to.override], override.values);
         }
-);
+    );
+
+test_that(
+    'calculate.angles.fixed handles children of overriden angle', {
+        num.children <- 2;
+        test.tree <- data.frame(
+            parent = c(-1, rep(1, num.children))
+            );
+        test.tree$tip <- rownames(test.tree)
+
+        test.v <- data.frame(
+            id = test.tree$tip,
+            parent = test.tree$parent,
+            angle = NA
+            );
+        new.angle <- 15;
+        test.v[1, 'angle'] <- new.angle;
+
+        fixed.angle <- pi / 4;
+        result <- calculate.angles.fixed(
+            test.v,
+            test.tree,
+            fixed.angle = fixed.angle
+            );
+        expected.angles <- c(new.angle, new.angle - fixed.angle, new.angle + fixed.angle);
+
+        expect_equal(result, expected.angles);
+        }
+    );