diff --git a/bin/ui/wndMain.ui b/bin/ui/wndMain.ui index 83f06fbe0..639a4a78c 100644 --- a/bin/ui/wndMain.ui +++ b/bin/ui/wndMain.ui @@ -310,6 +310,14 @@ Skips any matrices already in the project. + + + menu_trim_basedata_using_object + Remove labels from the selected basedata using a second basedata, tree or matrix + Trim using other basedata, matrix or tree + + + menu_trim_basedata_to_match_tree @@ -318,30 +326,6 @@ Skips any matrices already in the project. - - - menu_trim_basedata_to_match_matrix - Remove BaseData labels not in the selected matrix - Trim to match matrix elements - - - - - - menu_trim_basedata_using_tree - Trim BaseData labels that occur as nodes in the tree - Trim using tree nodes - - - - - - menu_trim_basedata_using_matrix - Trim BaseData labels that occur as elements in the matrix - Trim using matrix elements - - - menu_basedata_export_groups @@ -780,9 +764,7 @@ This cannot be undone. - - - + diff --git a/lib/Biodiverse/GUI/Callbacks.pm b/lib/Biodiverse/GUI/Callbacks.pm index d1159bf14..2aa4579cf 100644 --- 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 index bf5fd0b90..f7fa949f8 100644 --- 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 index c10a35b0b..2b074c42e 100644 --- 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 index bb2c44113..22fa6a5f0 100644 --- 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 index 5037c0c73..f72f35dce 100644 --- 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 {