separate the colours from the rest of the bootstrap block lists

Updates #630
shawnlaffan · Feb 19, 2017 · 7b28273 · 7b28273
1 parent a21c74e
commit 7b28273
Show file tree

Hide file tree

Showing 5 changed files with 72 additions and 38 deletions.
diff --git a/lib/Biodiverse/GUI/Dendrogram.pm b/lib/Biodiverse/GUI/Dendrogram.pm
@@ -1149,15 +1149,16 @@ sub set_node_colour {
 
     # also store it in the node for export purposes
     my $node_ref 
-        = $self->get_tree_object()->get_node_ref(node => $node_name);
+      = $self->get_tree_object->get_node_ref(node => $node_name);
 
+    my $colour_string = $colour_ref
+        ? $self->get_proper_colour_format(colour_ref => $colour_ref) 
+        : DEFAULT_LINE_COLOUR_RGB;
 
-    my $colour_string = 
-        $colour_ref ? $self->get_proper_colour_format(colour_ref => $colour_ref) 
-                    : "#000000";
-
-    $node_ref->set_bootstrap_value( key => "color", 
-                                    value => $colour_string );
+    $node_ref->set_bootstrap_value(
+        key   => "color",
+        value => $colour_string
+    );
 }
 
 # boolean: has a colour been set for a given node

diff --git a/lib/Biodiverse/Tree.pm b/lib/Biodiverse/Tree.pm
@@ -897,7 +897,7 @@ sub get_metadata_export_nexus {
         {
             name       => 'export_colours',
             label_text => 'Export colours',
-            tooltip    => 'Include user defined colours (in the nexus bootstrap block)',
+            tooltip    => 'Include user defined colours (in the nexus comments blocks)',
             type       => 'boolean',
             default    => 0,
         },
@@ -991,26 +991,28 @@ sub export_newick {
     open( my $fh, '>', $file )
       || croak "Could not open file '$file' for writing\n";
 
-    my @node_refs = $self->get_node_refs;
-    my $export_colours = $args{export_colours};
-    my $added_exclusions;
-    if(!$export_colours) {
-        $added_exclusions++;
-        foreach my $node_ref (@node_refs) {
-            $node_ref->get_bootstrap_block->add_exclusion(
-                exclusion => 'color',
-            );
-        }
-    }
+    #  Plain newick does not support colours
+    #  We need nexus for that
+    #my @node_refs = $self->get_node_refs;
+    #my $export_colours = $args{export_colours};
+    #my $added_exclusions;
+    #if(!$export_colours) {
+    #    $added_exclusions++;
+    #    foreach my $node_ref (@node_refs) {
+    #        $node_ref->get_bootstrap_block->add_exclusion(
+    #            exclusion => 'color',
+    #        );
+    #    }
+    #}
 
     print {$fh} $self->to_newick(%args);
     $fh->close;
 
-    if ($added_exclusions) {
-        foreach my $node_ref (@node_refs) {
-            $node_ref->get_bootstrap_block->clear_exclusions;
-        }
-    }
+    #if ($added_exclusions) {
+    #    foreach my $node_ref (@node_refs) {
+    #        $node_ref->get_bootstrap_block->clear_exclusions;
+    #    }
+    #}
     return 1;
 }
 

diff --git a/lib/Biodiverse/TreeNode.pm b/lib/Biodiverse/TreeNode.pm
@@ -1580,7 +1580,12 @@ sub set_bootstrap_value {
     my $value = $args{ value };
 
     my $bootstrap_block = $self->get_bootstrap_block();
-    $bootstrap_block->set_value( key => $key, value => $value );
+    if ($key eq 'color' || $key eq 'colour') {
+        $bootstrap_block->set_colour_aa ($value);
+    }
+    else {
+        $bootstrap_block->set_value( key => $key, value => $value );
+    }
 }
 
 sub get_bootstrap_value {
@@ -1637,7 +1642,7 @@ sub to_table {
 
 
     my @header = qw /TREENAME NODE_NUMBER PARENTNODE LENGTHTOPARENT NAME/;
-    if( $export_colours ) {
+    if ( $export_colours ) {
         push @header, "COLOUR";
     }
 
@@ -1663,10 +1668,9 @@ sub to_table {
         my $number = $node->get_value ('NODE_NUMBER');
         my %data;
 
-        my $colour = $node->get_bootstrap_value (key => 'color');
-
         #  add to the basestruct object
         if( $export_colours ) {
+            my $colour = $node->get_bootstrap_value (key => 'color');
             @data{@header} = ($treename, $number, $parent_num, 
                               $node->get_length || 0, $taxon_name, $colour);
         }
@@ -1926,11 +1930,11 @@ sub to_newick {   #  convert the tree to a newick format.  Based on the NEXUS li
         #$name = "'$name'";  #  quote otherwise
     }
 
-    # build the bootstrap block
+    # build the bootstrap block - should be conditional
     my $bootstrap_block = $self->get_bootstrap_block();
-
-    my $bootstrap_string = 
-        $bootstrap_block->encode_bootstrap_block();
+    my $bootstrap_string = $bootstrap_block->encode_bootstrap_block(
+        include_colour => $args{export_colours} || $args{include_colours},
+    );
 
     if (! $self->is_terminal_node) {   #  not a terminal node
         $string .= "(";

diff --git a/lib/Biodiverse/TreeNode/BootstrapBlock.pm b/lib/Biodiverse/TreeNode/BootstrapBlock.pm
@@ -41,6 +41,26 @@ sub delete_value {
     delete $self->{$key};
 }
 
+sub set_colour {
+    my ($self, %args) = @_;
+    $self->{colour} = $args{colour};
+}
+
+sub set_colour_aa {
+    my ($self, $colour) = @_;
+    $self->{colour} = $colour;
+}
+
+sub get_colour {
+    my $self = shift;
+    return $self->{colour};
+}
+
+sub delete_colour {
+    my $self= shift;
+    delete $self->{colour};
+}
+
 # given a boostrap block as it was imported, populate this object.
 # e.g. "color:#ffffff,foo:bar" etc.
 sub decode_bootstrap_block {
@@ -88,11 +108,14 @@ sub encode_bootstrap_block {
     foreach my $key (keys %boot_values) {
         my $value = $boot_values{$key};
         #  should test if the value looks like a valid colour value
-        if ($key eq 'color') {
-            $key = '!color';
-        }
         push @bootstrap_strings, "$key=$value";
     }
+    if ($args{include_colour}) {
+        my $colour = $self->get_colour;
+        if (defined $colour) {
+            unshift @bootstrap_strings, "!color=" . $colour;
+        }
+    }
 
     # if we have nothing in this block, we probably don't want to
     # write out [], as it makes the nexus file ugly.

diff --git a/t/32-BootstrapBlock.t b/t/32-BootstrapBlock.t
@@ -9,6 +9,8 @@ use Test::Lib;
 use Test::More;
 use Test::Exception;
 
+use rlib;
+
 use Biodiverse::TreeNode::BootstrapBlock;
 
 use Devel::Symdump;
@@ -186,7 +188,6 @@ sub test_colour_specific_export {
     my %hash = (
         "foo"      => "bar", 
         "footwo"   => "bartwo", 
-        "color"    => "red",
     );
 
     my $bootstrap_block = Biodiverse::TreeNode::BootstrapBlock->new();
@@ -197,13 +198,16 @@ sub test_colour_specific_export {
             value => $hash{ $key },
         );
     }
+    $bootstrap_block->set_colour_aa('red');
 
-    my $actual = $bootstrap_block->encode_bootstrap_block();
+    my $actual = $bootstrap_block->encode_bootstrap_block(
+        include_colour => 1,
+    );
 
     # we don't know what order the bootstrap block will be written, so
     # just look for the pairs we know should be there.
     ok (index($actual, "!color=red") != -1, 
         "Block contained !color=red",
     );
 
-}
+}