Tees: Add method to merge knuckle nodes

Updates #814

lib/Biodiverse/Tree.pm

@@ -2714,6 +2714,46 @@ sub trim_to_last_common_ancestor {
     return;
 }
 
+
+sub merge_knuckle_nodes {
+    my $self = shift;
+
+    #  merge any single-child nodes with their children
+    my @node_refs = reverse sort {$a->get_depth <=> $b->get_depth} $self->get_node_refs;
+    my %deleted;
+    foreach my $node_ref (grep {$_->get_child_count == 1} @node_refs) {
+        my $node_name = $node_ref->get_name;
+        next if $deleted{$node_name};  #  skip ones we already deleted
+        my $children = $node_ref->get_children;
+        next if @$children != 1;  # check again as we might have added a child to this node in a previous iteration
+        my $child = $children->[0];
+
+        #say "Merging parent $node_name with child " . $child->get_name;
+        #  we retain tip node, otherwise named node nearer the tip, otherwise the parent
+        if ($child->is_terminal_node || !$child->is_internal_node) {
+            $child->set_length_aa ($node_ref->get_length + $child->get_length);
+            $node_ref->delete_child (child => $child);
+            my $grandparent = $node_ref->get_parent;
+            $grandparent->delete_child (child => $node_ref);
+            $grandparent->add_children (children => [$child], is_treenodes => 1);
+            $child->set_parent_aa ($grandparent);
+            $self->delete_from_node_hash (node => $node_name);
+            $deleted{$node_name}++;
+        }
+        else {
+            $node_ref->set_length_aa ($node_ref->get_length + $child->get_length);
+            $node_ref->delete_child (child => $child);
+            $node_ref->add_children (children => [$child->get_children], is_treenodes => 1);
+            $self->delete_from_node_hash (node => $child->get_name);
+            $deleted{$child->get_name}++;
+        }
+
+    }
+    $self->delete_cached_values_below;
+
+    return scalar keys %deleted;
+}
+
 sub is_ultrametric {
     my $self = shift;
 

t/13-Tree.t

@@ -1316,7 +1316,26 @@ sub get_site_data_newick_tree {
 }
 
 
-
+sub test_knuckle_nodes {
+    my $nwk_with_knuckles = '(((t3:0.129,(t6:0.948,t2:0.866):0.673):0.671,t1:0.598):0.049,(t4:0.604,t5:0.857):0.202);';
+    my $nwk_no_knuckles   = '((t3:0.129,t6:1.621):0.720,(t4:0.604,t5:0.857):0.202);';
+
+    my $parser = Biodiverse::ReadNexus->new;
+    ok $parser->import_data (data => "$nwk_with_knuckles\n$nwk_no_knuckles"), "Imported knuckle trees";
+    my @trees = $parser->get_tree_array;
+    is scalar @trees, 2, 'Imported two knuckle trees';
+    my $tree_with_knuckles = shift @trees;
+    my $tree_no_knuckles = shift @trees;
+
+    $tree_with_knuckles->delete_node(node => 't1');
+    $tree_with_knuckles->delete_node(node => 't2');
+
+    my $delete_count = $tree_with_knuckles->merge_knuckle_nodes;
+    is $delete_count, 2, 'deleted expected number of nodes';
+
+    my $comp = $tree_with_knuckles->trees_are_same(comparison => $tree_no_knuckles);
+    ok $comp, 'got expected tree topology after clearing knuckles';
+}
 
 
 1;