Skip to content

Commit

Permalink
Merge pull request #926 from shawnlaffan/rpe_2024
Browse files Browse the repository at this point in the history 
PE, RPE and related optimisations
  • Loading branch information
@shawnlaffan
shawnlaffan authored Mar 11, 2024
2 parents 8216111 + 113cd2f commit ddc901f
Show file tree
Hide file tree
Showing 9 changed files with 452 additions and 235 deletions.
11 changes: 1 addition & 10 deletions lib/Biodiverse/Common.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -447,16 +447,7 @@ sub weaken_param {
sub delete_params {
my $self = shift;

my $count = 0;
foreach my $param (@_) { # should only delete those that exist...
if (delete $self->{PARAMS}{$param}) {
$count ++;
print "Deleted parameter $param from $self\n"
if $self->get_param('PARAM_CHANGE_WARN');
}
} # inefficient, as we could use a hash slice to do all in one hit, but allows better feedback

return $count;
scalar delete @{$self->{PARAMS}}{@_};
}

# an internal apocalyptic sub. use only for destroy methods
Expand Down
35 changes: 14 additions & 21 deletions lib/Biodiverse/Indices/Indices.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1703,22 +1703,13 @@ sub _calc_abc_any {
my $self = shift;

my $cache_hash = $self->get_param('AS_RESULTS_FROM_LOCAL');
my $cache_key
= List::Util::first {defined $cache_hash->{$_}}
(qw/calc_abc calc_abc2 calc_abc3/);

# say STDERR 'NO previous cache key'
# if !$cache_key;
my $results = $cache_hash->{calc_abc}
// $cache_hash->{calc_abc2}
// $cache_hash->{calc_abc3}
// $self->calc_abc(@_);

# fall back to calc_abc if nothing had an explicit abc dependency
my $cached = $cache_key
? $cache_hash->{$cache_key}
: $self->calc_abc(@_);

croak 'No previous calc_abc results found'
if !$cached;

return wantarray ? %$cached : $cached;
return wantarray ? %$results : $results;
}

sub get_metadata_calc_abc {
Expand Down Expand Up @@ -1813,20 +1804,22 @@ sub _calc_abc_dispatcher {
// $args{label_list2}
);

state $empty_array = [];

return $self->_calc_abc_pairwise_mode(%args)
if $self->get_pairwise_mode
&& @{$args{element_list1} // []} == 1
&& @{$args{element_list2} // []} == 1
&& !$have_lb_lists;
if @{$args{element_list1} // $empty_array} == 1
&& @{$args{element_list2} // $empty_array} == 1
&& $self->get_pairwise_mode
&& !$have_lb_lists;

return $self->_calc_abc_hierarchical_mode(%args)
if $args{current_node_details}
&& !$have_lb_lists
&& $self->get_hierarchical_mode;
&& !$have_lb_lists
&& $self->get_hierarchical_mode;

return $self->_calc_abc(%args)
if is_hashref($args{element_list1})
|| @{$args{element_list1} // []} != 1
|| @{$args{element_list1} // $empty_array} != 1
|| defined $args{element_list2}
|| $have_lb_lists;

Expand Down
2 changes: 1 addition & 1 deletion lib/Biodiverse/Indices/PhyloCom.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -347,7 +347,7 @@ sub _calc_phylo_mpd_mntd {
# Save some cycles if all the weights are the same.
# If we ever implement dissim then we can also check label_hash2.
if ($use_wts && $label_hashrefs_are_same) {
if (not List::Util::any {$_ != 1} values %$label_hash1) {
if (List::Util::all {$_ == 1} values %$label_hash1) {
$use_wts = undef;
}
}
Expand Down
67 changes: 41 additions & 26 deletions lib/Biodiverse/Indices/Phylogenetic.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -664,10 +664,18 @@ sub get_path_lengths_to_root_node {
# but first option is faster still
my $len_hash = $tree_ref->get_node_length_hash;
if (HAVE_BD_UTILS_108) {
# get keys and vals in one call
Biodiverse::Utils::XS::add_hash_keys_and_vals_until_exists_AoA (
$path_hash, \@collected_paths, $len_hash,
);
# sometimes there are no paths
if (@collected_paths) {
# direct assign the first (could do first few, or the longest but that needs another scan)
my $first = shift @collected_paths;
@$path_hash{@$first} = @$len_hash{@$first};
if (@collected_paths) {
# get keys and vals in one call
Biodiverse::Utils::XS::add_hash_keys_and_vals_until_exists_AoA(
$path_hash, \@collected_paths, $len_hash,
);
}
}
}
elsif (HAVE_BD_UTILS) {
Biodiverse::Utils::copy_values_from ($path_hash, $len_hash);
Expand Down Expand Up @@ -772,7 +780,8 @@ sub get_metadata_calc_pe_lists {
name => 'Phylogenetic Endemism lists',
reference => 'Rosauer et al (2009) Mol. Ecol. https://doi.org/10.1111/j.1365-294X.2009.04311.x',
type => 'Phylogenetic Endemism Indices',
pre_calc => ['_calc_pe'],
pre_calc => [qw /_calc_pe_lists/],
pre_calc_global => [ 'get_node_range_hash' ],
uses_nbr_lists => 1,
distribution => 'nonnegative',
indices => {
Expand Down Expand Up @@ -800,6 +809,12 @@ sub calc_pe_lists {

my @keys = qw /PE_WTLIST PE_RANGELIST PE_LOCAL_RANGELIST/;
my %results = %args{@keys};
# PE_RANGELIST used to be done in _calc_pe
if (!$results{PE_RANGELIST}) {
\my %ranges = $args{node_range};
my %h = %ranges{keys %{$results{PE_WTLIST}}};
$results{PE_RANGELIST} = \%h;
}

return wantarray ? %results : \%results;
}
Expand Down Expand Up @@ -830,7 +845,7 @@ END_PEC_DESC
name => 'Phylogenetic Endemism central',
reference => 'Rosauer et al (2009) Mol. Ecol. https://doi.org/10.1111/j.1365-294X.2009.04311.x',
type => 'Phylogenetic Endemism Indices',
pre_calc => [qw /_calc_pe _calc_phylo_abc_lists/],
pre_calc => [qw /_calc_pe _calc_pe_lists _calc_phylo_abc_lists/],
pre_calc_global => [qw /get_trimmed_tree/],
uses_nbr_lists => 1, # how many lists it must have
formula => $formula,
Expand Down Expand Up @@ -888,7 +903,7 @@ END_PEC_DESC
name => 'Phylogenetic Endemism central lists',
reference => 'Rosauer et al (2009) Mol. Ecol. https://doi.org/10.1111/j.1365-294X.2009.04311.x',
type => 'Phylogenetic Endemism Indices',
pre_calc => [qw /_calc_pe _calc_phylo_abc_lists/],
pre_calc => [qw /_calc_pe calc_pe_lists _calc_phylo_abc_lists/],
uses_nbr_lists => 1, # how many lists it must have
distribution => 'nonnegative',
indices => {
Expand Down Expand Up @@ -1100,7 +1115,7 @@ sub get_metadata_calc_pe_clade_contributions {
name => 'PE clade contributions',
reference => '',
type => 'Phylogenetic Endemism Indices',
pre_calc => ['_calc_pe', 'get_sub_tree_as_hash'],
pre_calc => [qw/_calc_pe _calc_pe_lists get_sub_tree_as_hash/],
pre_calc_global => ['get_trimmed_tree'],
uses_nbr_lists => 1,
distribution => 'nonnegative', # default
Expand Down Expand Up @@ -1417,7 +1432,7 @@ EOD
name => 'Phylogenetic Endemism single',
reference => 'Rosauer et al (2009) Mol. Ecol. https://doi.org/10.1111/j.1365-294X.2009.04311.x',
type => 'Phylogenetic Endemism Indices',
pre_calc => ['_calc_pe'],
pre_calc => [qw/_calc_pe calc_pe_lists/],
pre_calc_global => ['get_trimmed_tree'],
uses_nbr_lists => 1,
indices => {
Expand Down Expand Up @@ -1768,14 +1783,14 @@ sub get_inverse_range_weighted_path_lengths {
my %args = @_;

my $tree = $args{tree_ref};
my $node_ranges = $args{node_range};

\my %node_ranges = $args{node_range};
\my %node_length_hash = $tree->get_node_length_hash;

my %range_weighted;

foreach my $node ($tree->get_node_refs) {
my $name = $node->get_name;
next if !$node_ranges->{$name};
$range_weighted{$name} = $node->get_length / $node_ranges->{$name};

foreach my $name (keys %node_length_hash) {
next if !$node_ranges{$name};
$range_weighted{$name} = $node_length_hash{$name} / $node_ranges{$name};
}

my %results = (inverse_range_weighted_node_lengths => \%range_weighted);
Expand Down Expand Up @@ -2653,7 +2668,7 @@ sub get_metadata__calc_phylo_abc_lists {
name => 'Phylogenetic ABC lists',
description => 'Calculate the sets of shared and not shared branches between two sets of labels',
type => 'Phylogenetic Indices',
pre_calc => 'calc_abc',
pre_calc => '_calc_abc_any',
pre_calc_global => [qw /get_trimmed_tree get_path_length_cache set_path_length_cache_by_group_flag/],
uses_nbr_lists => 1, # how many sets of lists it must have
required_args => {tree_ref => 1},
Expand All @@ -2679,7 +2694,9 @@ sub _calc_phylo_abc_lists {
el_list => $args{element_list1},
);

if (!@{$args{element_list2}}) {
# $args{C} is the count of labels unique to set 2
# so if it is zero then we can short-circuit.
if ($args{C} == 0) {
my $res = {
PHYLO_A_LIST => {},
PHYLO_B_LIST => $nodes_in_path1,
Expand All @@ -2688,14 +2705,12 @@ sub _calc_phylo_abc_lists {
return wantarray ? %$res : $res;
}

my $nodes_in_path2 = @{$args{element_list2}}
? $self->get_path_lengths_to_root_node (
%args,
labels => $label_hash2,
tree_ref => $tree,
el_list => $args{element_list2},
)
: {};
my $nodes_in_path2 = $self->get_path_lengths_to_root_node (
%args,
labels => $label_hash2,
tree_ref => $tree,
el_list => $args{element_list2},
);

my %results;
# one day we can clean this all up
Expand Down
Loading

0 comments on commit ddc901f

Please sign in to comment.