Merge pull request #1044 from shawnlaffan/sp_label_ancestor_range

spatial conditions: sp_in_label_ancestor_range

Author: shawnlaffan

.github/workflows/windows.yml

@@ -20,7 +20,7 @@ jobs:
 
       - uses: shogo82148/actions-setup-perl@v1
         with:
-          perl-version: "5.38"
+          perl-version: "5.38.2"
           distribution: strawberry
           install-modules-with: cpanm
           install-modules-args: --with-develop --with-configure --verbose

lib/Biodiverse/BaseData.pm

@@ -2717,17 +2717,8 @@ sub get_outputs_with_same_spatial_conditions {
         || croak "[BASEDATA] compare_with argument not specified\n";
 
     my $sp_params = $compare->get_spatial_conditions;
-    my $def_query = $compare->get_def_query;
-    if ( defined $def_query && ( length $def_query ) == 0 ) {
-        $def_query = undef;
-    }
 
-    my $def_conditions;
-    if ( blessed $def_query) {
-        $def_conditions = $def_query->get_conditions_unparsed();
-    }
-
-    my @outputs = $self->get_output_refs_of_class( class => $compare );
+    my @outputs = $self->get_outputs_with_same_def_query (%args);
 
     my @comparable_outputs;
 
@@ -2738,25 +2729,6 @@ sub get_outputs_with_same_spatial_conditions {
         my $completed = $output->get_param('COMPLETED');
         next LOOP_OUTPUTS if defined $completed and !$completed;
 
-        my $def_query_comp = $output->get_def_query;
-        if ( defined $def_query_comp && ( length $def_query_comp ) == 0 ) {
-            $def_query_comp = undef;
-        }
-
-        next LOOP_OUTPUTS
-            if ( defined $def_query ) ne ( defined $def_query_comp );
-
-        if ( defined $def_query ) {
-
-            #  check their def queries match
-            my $def_conditions_comp =
-                eval { $def_query_comp->get_conditions_unparsed() }
-                    // $def_query_comp;
-            my $def_conditions_text =
-                eval { $def_query->get_conditions_unparsed() } // $def_query;
-            next LOOP_OUTPUTS if $def_conditions_comp ne $def_conditions_text;
-        }
-
         my $sp_params_comp = $output->get_spatial_conditions || [];
 
         #  must have same number of conditions
@@ -2767,6 +2739,12 @@ sub get_outputs_with_same_spatial_conditions {
             next LOOP_OUTPUTS
                 if ( $sp_params->[$i]->get_param('CONDITIONS') ne
                     $sp_obj->get_conditions_unparsed() );
+
+            my $tree_ref = $sp_params->[$i]->get_tree_ref;
+            my $tree_ref_comp = $sp_obj->get_tree_ref;
+            next LOOP_OUTPUTS
+                if ($tree_ref // '') ne ($tree_ref_comp // '');
+
             $i++;
         }
 
@@ -2790,8 +2768,10 @@ sub get_outputs_with_same_def_query {
     }
 
     my $def_conditions;
+    my $tree_ref;
     if ( blessed $def_query) {
         $def_conditions = $def_query->get_conditions_unparsed();
+        $tree_ref = $def_query->get_tree_ref;
     }
 
     #  could be more general with def queries
@@ -2828,6 +2808,9 @@ sub get_outputs_with_same_def_query {
             my $def_conditions_text =
                 eval { $def_query->get_conditions_unparsed() } // $def_query;
             next LOOP_OUTPUTS if $def_conditions_comp ne $def_conditions_text;
+
+            my $tree_ref_comp = $def_query_comp->get_tree_ref;
+            next LOOP_OUTPUTS if ($tree_ref // '') ne ($tree_ref_comp // '');
         }
 
         #  if we get this far then we have a match

lib/Biodiverse/GUI/SpatialParams.pm

@@ -76,6 +76,9 @@ sub new {
     $options_button->signal_connect_swapped(clicked => \&run_options_dialogue, $self);
     $options_button->set_tooltip_text('Control some of the processing options');
 
+    my $tree_combo = $self->update_dendrogram_combo;
+    $tree_combo->show_all;
+
     # Scrolled window for multi-line conditions
     my $scroll = Gtk3::ScrolledWindow->new;
     $scroll->set_policy('automatic', 'automatic');
@@ -86,16 +89,23 @@ sub new {
     my $frame = Gtk3::Frame->new();
     $frame->add($text_view_no_scroll);
 
-    my $hideable_widgets = [$scroll, $frame, $options_button, $syntax_button];
+    my $hideable_widgets = [
+        $scroll, $frame,
+        $tree_combo,
+        $options_button, $syntax_button,
+    ];
 
     # HBox
     $hbox->pack_start($expander, 0, 0, 0);
     $hbox->pack_start($scroll, 1, 1, 0);
     $hbox->pack_start($frame, 1, 1, 0);
+    $hbox->pack_start($tree_combo, 0, 1, 0);
     $hbox->pack_start($options_button, 0, 0, 0);
     $hbox->pack_end($syntax_button, 0, 0, 0);
     $hbox->show_all();
 
+    $self->{tree_combo} = $tree_combo;
+
     my $cb_text_buffer = sub {
         if ($text_buffer->get_line_count > 1) {
             $scroll->show;
@@ -118,31 +128,33 @@ sub new {
 
 
     my $expander_cb = sub {
-        my $expand = !$expander->get_expanded;
-        my $method = $expand ? 'show' : 'hide';
+        my $visible = !$expander->get_expanded;
         foreach my $widget (@$hideable_widgets) {
-            if (not $widget =~ 'Button' and not $widget =~ $self->{current_text_view}) {
+            if (not $widget =~ 'Button|ComboBox' and not $widget =~ $self->{current_text_view}) {
                 $widget->hide;  # hide the inactive textview regardless
             }
             else {
-                $widget->$method;
+                $widget->set_visible($visible);
             }
         }
     };
-    $expander->set_tooltip_text ('Show or hide the edit and verify boxes.  Use this to free up some screen real estate.');
+    $expander->set_tooltip_text (
+        'Show or hide the edit box and other widgets.  '
+      . 'Use this to free up some screen real estate.'
+    );
     $expander->signal_connect_swapped (
         activate => $expander_cb,
         $self,
     );
     $expander->set_expanded(!$start_hidden);
 
-    my $method = $start_hidden ? 'hide' : 'show';
+    my $visible = !$start_hidden;
     foreach my $widget (@$hideable_widgets) {
-        if (not $widget =~ 'Button' and not $widget =~ $self->{current_text_view}) {
+        if (not $widget =~ 'Button|ComboBox' and not $widget =~ $self->{current_text_view}) {
             $widget->hide;  # hide the inactive textview regardless
         }
         else {
-            $widget->$method;
+            $widget->set_visible($visible);
         }
     }
 
@@ -176,6 +188,7 @@ sub on_syntax_check {
             conditions            => $expr,
             basedata_ref          => $bd,
             promise_current_label => $self->{promise_current_label},
+            tree_ref              => $self->get_tree_ref,
         );
     };
     #croak $EVAL_ERROR if $EVAL_ERROR;
@@ -206,7 +219,8 @@ sub get_validated_conditions {
     my $self = shift;
 
     my $conditions = $self->{validated_conditions};
-    croak "Conditions not yet validated\n" if !defined $conditions;
+    return if !defined $conditions;
+    # croak "Conditions not yet validated\n" if !defined $conditions;
 
     my $options = $self->get_options;
     $conditions->set_no_recycling_flag ($options->{no_recycling});
@@ -215,6 +229,26 @@ sub get_validated_conditions {
     return $conditions;
 }
 
+sub get_tree_ref {
+    my $self = shift;
+
+    my $combo = $self->{tree_combo};
+    return if !$combo;
+
+    my $iter = $combo->get_active_iter;
+    my $tree_ref = $iter ? $combo->get_model->get($iter, 1) : undef;
+
+    if ($tree_ref eq 'no tree') {
+        $tree_ref = undef;
+    }
+    elsif ($tree_ref eq 'project') {
+        my $gui = Biodiverse::GUI::GUIManager->instance;
+        $tree_ref = $gui->get_project->get_selected_phylogeny;
+    }
+
+    return $tree_ref;
+}
+
 sub get_object {
     my $self = shift;
     return $self->{hbox};
@@ -314,6 +348,62 @@ sub get_options {
     return wantarray ? %$options : $options;
 }
 
+sub update_dendrogram_combo {
+    my $self = shift;
+
+    my $combobox = Gtk3::ComboBox->new;
+
+    my $renderer_text = Gtk3::CellRendererText->new();
+    $combobox->pack_start($renderer_text, 1);
+    $combobox->add_attribute($renderer_text, "text", 0);
+
+    #  Clear the current entries.
+    #  We need to load a new ListStore to avoid crashes due
+    #  to them being destroyed somewhere in the refresh process
+    #  (Not sure that is still the case)
+    my $model = Gtk3::ListStore->new('Glib::String', 'Glib::Scalar');
+
+    my @combo_items;
+
+    my $output_ref = eval {$self->get_validated_conditions};
+    if ($output_ref && $output_ref->can('get_tree_ref') && $output_ref->get_tree_ref) {
+        my $iter = $model->append();
+        $model->set( $iter, 0 => 'analysis', 1 =>  $output_ref->get_tree_ref);
+        push @combo_items, 'analysis';
+    }
+
+    foreach my $option ('no tree', 'project') {
+        my $iter = $model->append();
+        $model->set( $iter, 0 => $option, 1 => $option );
+        push @combo_items, $option;
+    }
+
+    my $list = Biodiverse::GUI::GUIManager->instance->get_project->get_phylogeny_list;
+    foreach my $tree (@$list) {
+        my $name = $tree->get_name;
+        my $iter = $model->append();
+        $model->set( $iter, 0 => $name, 1 => $tree );
+    }
+
+    $combobox->set_model ($model);
+
+    state $tooltip = <<~'EOT';
+        Choose the tree to use in the spatial conditions.
+
+        The remainder of the options are the trees available at
+        the project level.  Note that this set is not updated as
+        trees are added to and removed from the project.
+        Changes can be triggered by closing and reopening the tab.
+        EOT
+    ;
+
+    $combobox->set_tooltip_text ($tooltip);
+    $combobox->set_active(0);
+    # $combobox->show_all;
+
+    return $combobox;
+}
+
 
 1;
 

lib/Biodiverse/Metadata/SpatialConditions.pm

@@ -23,6 +23,7 @@ my %methods_and_defaults = (
     use_cell_distances     => [],
     use_abs_cell_distances => [],
     is_volatile_cb         => sub{},
+    requires_tree_ref      => undef,
 );
 
 sub _get_method_default_hash {

lib/Biodiverse/SpatialConditions.pm

@@ -87,6 +87,7 @@ sub new {
         KEEP_LAST_DISTANCES => $args{keep_last_distances},
     );
     $self->set_promise_current_label($args{promise_current_label});
+    $self->set_tree_ref($args{tree_ref});
 
     eval {$self->parse_distances};
     croak $EVAL_ERROR if $EVAL_ERROR;
@@ -109,6 +110,20 @@ sub get_metadata {
     return $self->SUPER::get_metadata (@_, no_use_cache => 1);
 }
 
+sub get_tree_ref {
+    my ($self) = @_;
+    $self->get_param('TREE_REF');
+}
+
+sub set_tree_ref {
+    my ($self, $tree_ref) = @_;
+    if (my $old_tree = $self->get_tree_ref) {
+        $self->delete_cached_values
+          if ref $tree_ref ne ref $old_tree;
+    }
+    $self->set_param(TREE_REF => $tree_ref);
+}
+
 sub get_conditions {
     my $self = shift;
     my %args = @_;
@@ -194,6 +209,17 @@ sub set_promise_current_label {
     return $self->{promise_current_label} = $promise;
 }
 
+sub get_requires_tree_ref {
+    my ($self) = @_;
+    return $self->{requires_tree_ref};
+}
+
+sub set_requires_tree_ref {
+    my ($self, $bool) = @_;
+    return $self->{requires_tree_ref} = $bool;
+}
+
+
 sub get_used_dists {
     my $self = shift;
     return $self->get_param('USES');
@@ -291,7 +317,10 @@ sub parse_distances {
     my $re_sub_names_text = '\b(?:' . join( q{|}, @subs_to_check ) . ')\b';
     my $re_sub_names      = qr /$re_sub_names_text/xsm;
     my $is_volatile;
-    
+
+    #  maybe the user calls this in the condition somewhere
+    my $requires_tree_ref = $conditions =~ /\$self\s*\-\>\s*get_tree_ref\b/;
+
     my %shape_hash;
 
     my $str_len = length $conditions;
@@ -387,6 +416,8 @@ sub parse_distances {
                 $is_volatile ||= $self->$cb(%hash_1);
             }
 
+            $requires_tree_ref ||= $metadata->get_requires_tree_ref;
+
             #  REALLY BAD CODE - does not allow for other
             #  functions and operators
             $results_types .= ' ' . $metadata->get_result_type;
@@ -427,6 +458,12 @@ sub parse_distances {
     $self->set_param( USES             => \%uses_distances );
     $self->set_param( SHAPE_TYPES      => join ' ', sort keys %shape_hash);
     $self->set_volatile_flag($is_volatile);
+    $self->set_requires_tree_ref($requires_tree_ref);
+
+    if (!$requires_tree_ref) {
+        #  clear the tree if we do not need it
+        $self->set_tree_ref(undef);
+    }
 
     #  do we need to calculate the distances?  NEEDS A BIT MORE THOUGHT
     $self->set_param( CALC_DISTANCES => undef );