Fix text annotation

R/add.text.R

@@ -213,7 +213,7 @@ position.node.text <- function(
                     #back computing the x position based on the intercept and the slope
                     xpos <- ifelse(
                         is.infinite(slope),
-                        yes = tree.max.adjusted$x0[s],
+                        yes = tree.max.adjusted$x1[s],
                         no = (ypos - intercept) / slope
                         );
 
@@ -497,10 +497,32 @@ add.text2 <- function(
     node.radius <- node.radius / scale;
     node.text <- node.text[node.text$node %in% tree$tip, ];
 
-    node.list <- data.frame(row.names = rownames(tree));
-    node.text.col <- node.text.fontface <- lapply
+    node.list <- vector('list', nrow(tree));
+    node.text.col <- vector('list', nrow(tree));
+    node.text.fontface <- vector('list', nrow(tree));
+
+    # Loop to assign text to nodes
+    for (i in seq_len(nrow(node.text))) {
+        text.row <- node.text[i, ];
+        pos <- which(tree$tip == text.row$node);
+        text.value <- text.row$name;
+
+        # Check if the text contains an underscore and parse if necessary
+        if (length(grep('_', text.value)) > 0) {
+            text.split <- strsplit(text.value, split = '_')[[1]];
+            node.text.value <- text.split[1];
+            amp <- text.split[2];
+            call <- paste0(node.text.value, '^\'A', amp, '\'');
+            text.value <- parse(text = call);
+            }
+
+        # Assign text value, color, and font face
+        node.list[[pos]] <- c(node.list[[pos]], text.value);
+        node.text.col[[pos]] <- c(node.text.col[[pos]], if (!is.na(text.row$col)) text.row$col else 'black');
+        node.text.fontface[[pos]] <- c(node.text.fontface[[pos]], if (!is.na(text.row$fontface)) text.row$fontface else 'plain');
+        }
 
-    tree.max.adjusted <- apply(
+    tree.max <- apply(
         tree,
         MARGIN = 1,
         FUN = function(x) {
@@ -514,35 +536,36 @@ add.text2 <- function(
 
             tipx <- v$x[v$id == x['tip']];
             tipy <- v$y[v$id == x['tip']];
+            mode <- v$mode[v$id == x['tip']];
 
-            return(data.frame(basex, basey, tipx, tipy));
+            return(data.frame(basex, basey, tipx, tipy, mode));
             }
         );
-    tree.max.adjusted <- do.call('rbind', tree.max.adjusted);
-    rownames(tree.max.adjusted) <- rownames(tree);
-    tree.max.adjusted <- cbind(tree, tree.max.adjusted);
-    tree.max <- tree.max.adjusted;
+    tree.max <- do.call('rbind', tree.max);
+    rownames(tree.max) <- rownames(tree);
+    tree.max <- cbind(tree, tree.max);
+
+    tree.max.adjusted <- as.data.frame(do.call(rbind, lapply(
+        1:nrow(tree.max),
+        FUN = function(i) {
+            x <- tree.max[i, ];
+            if (x['mode'] == 'radial') {
+                angle <- x['angle'];
+            } else if (x['mode'] == 'dendrogram') {
+                angle <- 0;
+                x['basex'] <- x['tipx'];
+                }
+            # 1 if positive angle, -1 if negative (or 0 degrees)
+            angle.modifier <- (angle > 0) * 2 - 1;
 
-    # 1 if positive angle, -1 if negative (or 0 degrees)
-    angle.modifier <- (tree.max.adjusted$angle > 0) * 2 - 1;
+            basex <- x['basex'] + (angle.modifier * node.radius * sin(angle));
+            tipx  <- x['tipx']  - (angle.modifier * node.radius * sin(angle));
+            basey <- x['basey'] + (angle.modifier * node.radius * cos(angle));
+            tipy  <- x['tipy']  - (angle.modifier * node.radius * cos(angle));
 
-    # Length of the visible line segments
-    tree.max.adjusted$basex <- (
-        tree.max.adjusted$basex +
-        angle.modifier * node.radius * sin(tree.max.adjusted$angle)
-        );
-    tree.max.adjusted$tipx <- (
-        tree.max.adjusted$tipx -
-        -angle.modifier * node.radius * sin(tree.max.adjusted$angle)
-        );
-    tree.max.adjusted$basey <- (
-        tree.max.adjusted$basey +
-        angle.modifier * node.radius * cos(tree.max.adjusted$angle)
-        );
-    tree.max.adjusted$tipy <- (
-        tree.max.adjusted$tipy -
-        -angle.modifier * node.radius * cos(tree.max.adjusted$angle)
-        );
+            return(data.frame(basex, basey, tipx, tipy));
+            })));
+    tree.max.adjusted <- cbind(tree, tree.max.adjusted);
 
     # Push a viewport the same size as the final panel
     # to perform calculations using absolute size units
@@ -552,7 +575,7 @@ add.text2 <- function(
         pushViewport(viewport(
             height = unit(panel.height, 'inches'),
             name = 'ref',
-            width = unit(panel.width,'inches'),
+            width = unit(panel.width, 'inches'),
             xscale = xlims,
             yscale = c(ymax, -2)
             ));
@@ -597,7 +620,6 @@ add.text2 <- function(
             children = text.grob.gList,
             vp = make.plot.viewport(clone.out, clip = 'off')
             );
-
         return(text.tree);
         }
 
@@ -615,4 +637,4 @@ add.text2 <- function(
         );
 
     return(list(text.tree, tree.max.adjusted));
-	}
+    }