Merge pull request #887 from shawnlaffan/issue_880_bd_trim

GUI: Generalise basedata trimming
shawnlaffan · Oct 24, 2023 · b7493f7 · b7493f7
2 parents 197baf5 + 8f5c799
commit b7493f7
Show file tree

Hide file tree

Showing 6 changed files with 172 additions and 48 deletions.
diff --git a/bin/ui/wndMain.ui b/bin/ui/wndMain.ui
@@ -310,6 +310,14 @@ Skips any matrices already in the project.</property>
             <signal handler="on_basedata_extract_embedded_matrices" name="activate"/>
           </object>
         </child>
+        <child>
+          <object class="GtkAction" id="menu_trim_basedata_using_object">
+            <property name="name">menu_trim_basedata_using_object</property>
+            <property name="tooltip" translatable="yes">Remove labels from the selected basedata using a second basedata, tree or matrix</property>
+            <property name="label" translatable="yes">Trim using other basedata, matrix or tree</property>
+            <signal handler="on_basedata_trim_using_object" name="activate"/>
+          </object>
+        </child>
         <child>
           <object class="GtkAction" id="menu_trim_basedata_to_match_tree">
             <property name="name">menu_trim_basedata_to_match_tree</property>
@@ -318,30 +326,6 @@ Skips any matrices already in the project.</property>
             <signal handler="on_basedata_trim_to_match_tree" name="activate"/>
           </object>
         </child>
-        <child>
-          <object class="GtkAction" id="menu_trim_basedata_to_match_matrix">
-            <property name="name">menu_trim_basedata_to_match_matrix</property>
-            <property name="tooltip" translatable="yes">Remove BaseData labels not in the selected matrix</property>
-            <property name="label" translatable="yes">Trim to match matrix elements</property>
-            <signal handler="on_basedata_trim_to_match_matrix" name="activate"/>
-          </object>
-        </child>
-        <child>
-          <object class="GtkAction" id="menu_trim_basedata_using_tree">
-            <property name="name">menu_trim_basedata_using_tree</property>
-            <property name="tooltip" translatable="yes">Trim BaseData labels that occur as nodes in the tree</property>
-            <property name="label" translatable="yes">Trim using tree nodes</property>
-            <signal handler="on_basedata_trim_using_tree" name="activate"/>
-          </object>
-        </child>
-        <child>
-          <object class="GtkAction" id="menu_trim_basedata_using_matrix">
-            <property name="name">menu_trim_basedata_using_matrix</property>
-            <property name="tooltip" translatable="yes">Trim BaseData labels that occur as elements in the matrix</property>
-            <property name="label" translatable="yes">Trim using matrix elements</property>
-            <signal handler="on_basedata_trim_using_matrix" name="activate"/>
-          </object>
-        </child>
         <child>
           <object class="GtkAction" id="menu_basedata_export_groups">
             <property name="name">menu_basedata_export_groups</property>
@@ -780,9 +764,7 @@ This cannot be undone.  </property>
           <menuitem action="menu_extract_embedded_matrices"/>
           <separator/>
           <menuitem action="menu_trim_basedata_to_match_tree"/>
-          <menuitem action="menu_trim_basedata_to_match_matrix"/>
-          <menuitem action="menu_trim_basedata_using_tree"/>
-          <menuitem action="menu_trim_basedata_using_matrix"/>
+          <menuitem action="menu_trim_basedata_using_object"/>
           <separator/>
           <menuitem action="menu_basedata_export_groups"/>
           <menuitem action="menu_basedata_export_labels"/>

diff --git a/lib/Biodiverse/GUI/Callbacks.pm b/lib/Biodiverse/GUI/Callbacks.pm
@@ -267,22 +267,26 @@ my %data_funcs = (
     on_basedata_extract_embedded_matrices => {
         METHOD => 'do_basedata_extract_embedded_matrices',
     },
-    on_basedata_trim_to_match_tree => {
-        METHOD => 'do_basedata_trim_to_tree',
-        ARGS   => { option => 'keep' },
-    },
-    on_basedata_trim_to_match_matrix => {
-        METHOD => 'do_basedata_trim_to_matrix',
+    on_basedata_trim_using_object => {
+        METHOD => 'do_basedata_trim_using_object',
         ARGS   => { option => 'keep' },
     },
-    on_basedata_trim_using_tree => {
+    on_basedata_trim_to_match_tree => {
         METHOD => 'do_basedata_trim_to_tree',
-        ARGS   => { option => 'trim' },
-    },
-    on_basedata_trim_using_matrix => {
-        METHOD => 'do_basedata_trim_to_matrix',
-        ARGS   => { option => 'trim' },
+        ARGS   => { option => 'keep' },
     },
+    # on_basedata_trim_to_match_matrix => {
+    #     METHOD => 'do_basedata_trim_to_matrix',
+    #     ARGS   => { option => 'keep' },
+    # },
+    # on_basedata_trim_using_tree => {
+    #     METHOD => 'do_basedata_trim_to_tree',
+    #     ARGS   => { option => 'trim' },
+    # },
+    # on_basedata_trim_using_matrix => {
+    #     METHOD => 'do_basedata_trim_to_matrix',
+    #     ARGS   => { option => 'trim' },
+    # },
     on_basedata_attach_properties => {
         METHOD => 'do_basedata_attach_properties',
     },

diff --git a/lib/Biodiverse/GUI/GUIManager.pm b/lib/Biodiverse/GUI/GUIManager.pm
@@ -1740,6 +1740,7 @@ sub do_range_weight_tree {
     );
 }
 
+
 #  Should probably rename this sub as it is being used for more purposes,
 #  some of which do not involve trimming.
 sub do_trim_tree_to_basedata {

diff --git a/lib/Biodiverse/GUI/Manager/BaseDatas.pm b/lib/Biodiverse/GUI/Manager/BaseDatas.pm
@@ -1168,16 +1168,125 @@ sub do_basedata_trim_to_tree {
     return;
 }
 
-sub do_basedata_trim_to_matrix {
+# sub do_basedata_trim_to_matrix {
+#     my $self = shift;
+#     my %args = @_;      #  keep or trim flag
+#
+#     my $bd = $self->{project}->get_selected_base_data;
+#     my $mx = $self->{project}->get_selected_matrix;
+#
+#     return if !defined $bd || !defined $mx;
+#
+#     $self->do_trim_basedata( $bd, $mx, %args );
+#
+#     return;
+# }
+
+sub do_basedata_trim_using_object {
     my $self = shift;
-    my %args = @_;      #  keep or trim flag
+    my %args = @_;
+
+    my $project = $self->get_project;
+
+    my $bd = $project->get_selected_base_data || return 0;
+
+    my @bd_sources
+        = grep {$_ != $bd} (@{ $project->get_base_data_list });
+    my @matrix_sources = @{ $project->get_matrix_list };
+    my @tree_sources = @{ $project->get_phylogeny_list };
+    my @trim_sources = (@bd_sources, @matrix_sources, @tree_sources);
+
+    my $trim_combo = Gtk2::ComboBox->new_text;
+    my $controller_combo = Gtk2::ComboBox->new_text;
+
+    my $source_tooltip = 'Choose a data source to trim with';
+    foreach my $object (@bd_sources) {
+        $trim_combo->append_text("Basedata: " . $object->get_name);
+    }
+    foreach my $object (@matrix_sources) {
+        $trim_combo->append_text("Matrix: " . $object->get_name);
+    }
+    foreach my $object (@tree_sources) {
+        $trim_combo->append_text("Tree: " . $object->get_name);
+    }
+    $trim_combo->set_active(0);
+    $trim_combo->show_all;
+    $trim_combo->set_tooltip_text ($source_tooltip);
+
+    my $label = Gtk2::Label->new('Label source: ');
+    $label->set_tooltip_text ($source_tooltip);
+    my $select_hbox = Gtk2::HBox->new;
+    $select_hbox->pack_start($label, 0, 0, 0);
+    $select_hbox->pack_start($trim_combo, 0, 0, 0);
+    $select_hbox->show_all;
+
+    my $chk_tooltip = 'Delete any matching labels (inverts the default)';
+    my $chk_label = Gtk2::Label->new('Delete matching?');
+    my $chk    = Gtk2::CheckButton->new;
+    my $chk_hbox = Gtk2::HBox->new;
+    $chk_hbox->pack_start($chk_label, 0, 0, 0);
+    $chk_hbox->pack_start($chk, 0, 0, 0);
+    $chk->set_tooltip_text($chk_tooltip);
+    $chk_label->set_tooltip_text($chk_tooltip);
+    $chk_hbox->show_all;
+
+    my $tooltip_clone
+        = "Clone basedata first (required if basedata contains outputs).\n"
+    . 'New name is ignored if this is off.';
+    my $label_clone = Gtk2::Label->new('Trim a clone');
+    my $chk_clone = Gtk2::CheckButton->new;
+    $chk_clone->set_active(1);
+    my $hbox_clone = Gtk2::HBox->new;
+    $hbox_clone->pack_start($label_clone, 0, 0, 0);
+    $hbox_clone->pack_start($chk_clone, 0, 0, 0);
+    $chk_clone->set_tooltip_text($tooltip_clone);
+    $label_clone->set_tooltip_text($tooltip_clone);
+    $hbox_clone->show_all;
+
+    # Show the Get Name dialog
+    my ( $dlgxml, $dlg ) = $self->get_dlg_duplicate();
+    $dlg->set_transient_for( $self->get_object('wndMain') );
 
-    my $bd = $self->{project}->get_selected_base_data;
-    my $mx = $self->{project}->get_selected_matrix;
+    my $vbox = $dlg->get_content_area;
+    $vbox->pack_start( $hbox_clone,  0, 0, 0 );
+    $vbox->pack_start( $select_hbox,  0, 0, 0 );
+    $vbox->pack_start( $chk_hbox,  0, 0, 0 );
 
-    return if !defined $bd || !defined $mx;
+    my $suffix = $args{suffix} || 'TRIMMED';
 
-    $self->do_trim_basedata( $bd, $mx, %args );
+    my $txt_name = $dlgxml->get_object('txtName');
+    my $name = $bd->get_name;
+    # If ends with _TRIMMED followed by a number then increment it
+    if ( $name =~ /(.*_$suffix)([0-9]+)$/ ) {
+        $name = $1 . ( $2 + 1 );
+    }
+    else {
+        $name .= "_${suffix}1";
+    }
+    $txt_name->set_text($name);
+
+    my $response          = $dlg->run();
+    my $chosen_name              = $txt_name->get_text;
+    my $other_bd_iter = $trim_combo->get_active;
+    my $delete_matching = $chk->get_active;
+    my $clone_first = $chk_clone->get_active;
+
+    $dlg->destroy;
+
+    return if $response ne 'ok';    #  they chickened out
+
+    my $other_bd =$trim_sources[$other_bd_iter];
+
+    my $new_bd = $clone_first ? $bd->clone (no_outputs => 1) : $bd;
+    my $option = $delete_matching ? 'trim' : 'keep';
+    $self->do_trim_basedata ($new_bd, $other_bd, option => $option);
+
+    $new_bd->delete_cached_values;
+
+    if ($clone_first) {
+        $new_bd->set_param(NAME => $chosen_name);
+        $project->add_base_data( $new_bd, 0 );
+    }
 
     return;
 }

diff --git a/lib/Biodiverse/GUI/Project.pm b/lib/Biodiverse/GUI/Project.pm
@@ -1294,9 +1294,7 @@ sub manage_empty_basedatas {
           menu_extract_embedded_trees
           menu_extract_embedded_matrices
           menu_trim_basedata_to_match_tree
-          menu_trim_basedata_to_match_matrix
-          menu_trim_basedata_using_tree
-          menu_trim_basedata_using_matrix
+          menu_trim_basedata_using_object
           menu_rename_basedata_labels
           menu_rename_basedata_groups
           menu_attach_basedata_properties

diff --git a/t/11-BaseData.t b/t/11-BaseData.t
@@ -1908,6 +1908,36 @@ sub _test_rename_labels_or_groups {
 
 }
 
+sub test_trim_with_basedata {
+    my $bd = Biodiverse::BaseData->new (
+        NAME => 'trim_base', CELL_SIZES => [2, 2],
+    );
+    my $bd2 = Biodiverse::BaseData->new (
+        NAME => 'trim2', CELL_SIZES => [2, 2],
+    );
+
+    foreach my $label ('a' .. 'z') {
+        $bd->add_element (label => $label, group => '1:1');
+    }
+    foreach my $label ('a' .. 'k') {
+        $bd2->add_element (label => $label, group => '1:1');
+    }
+
+    {
+        my $bd_trim1 = $bd->clone;
+        $bd_trim1->trim(trim => $bd2);
+        my @expected = ('l' .. 'z');
+        my @labels = sort $bd_trim1->get_labels;
+        is \@labels, \@expected, 'Expected labels after trimming with trim option';
+    }
+    {
+        my $bd_trim2 = $bd->clone;
+        $bd_trim2->trim(keep => $bd2);
+        my @expected = ('a' .. 'k');
+        my @labels = sort $bd_trim2->get_labels;
+        is \@labels, \@expected, 'Expected labels after trimming with keep option';
+    }
+}
 
 #  reordering of axes
 sub test_reorder_axes {