Merge pull request #918 from shawnlaffan/richness_estimation_2024

Updates and optimisations for the richness estimation indices, including displaying the metadata as categories in the GUI. And a few other minor things.
shawnlaffan · Feb 20, 2024 · da1e625 · da1e625
2 parents f9078c1 + 18232bd
commit da1e625
Show file tree

Hide file tree

Showing 14 changed files with 319 additions and 195 deletions.
diff --git a/Makefile.PL b/Makefile.PL
@@ -6,13 +6,14 @@ use ExtUtils::MakeMaker;
 #  these are from the cpanfile
 #  need to look at https://metacpan.org/pod/ExtUtils::MakeMaker::CPANfile
 my %common_reqs = (
-    "Class::Inspector" => 0,
-    "Clone" => "0.35",
-    "Cpanel::JSON::XS" => "3",
+    "Class::Inspector"      => 0,
+    "Clone"                 => "0.35",
+    "Cpanel::JSON::XS"      => "3",
     "Data::Structure::Util" => 0,
-    "Data::Compare" => 0,
-    "Exception::Class" => 0,
-    "Exporter::Easy" => 0,
+    "Data::Compare"         => 0,
+    "Exception::Class"      => 0,
+    "Exporter::Easy"        => 0,
+    "Faster::Maths"         => 0,
     "File::BOM" => 0,
     "File::Find::Rule" => 0,
     "Geo::Converter::dms2dd" => "0.05",

diff --git a/cpanfile b/cpanfile
@@ -8,6 +8,7 @@ requires "Excel::ValueReader::XLSX";
 requires "Exception::Class";
 requires "Exporter::Easy";
 #requires "FFI::Platypus::Declare";
+requires "Faster::Maths";
 requires "File::BOM";
 requires "File::Find::Rule";
 requires "Geo::Converter::dms2dd", "0.05";
@@ -49,7 +50,7 @@ requires "rlib";
 #requires "Math::AnyNum";  #  until we don't
 requires "Statistics::Descriptive::PDL", "0.15";
 
-suggests "Panda::Lib";
+# suggests "Panda::Lib";
 suggests "Data::Recursive";
 
 #test_requires => sub {

diff --git a/lib/Biodiverse/Common/ColourPalettes.pm b/lib/Biodiverse/Common/ColourPalettes.pm
@@ -0,0 +1,91 @@
+package Biodiverse::Common::ColourPalettes;
+use strict;
+use warnings;
+
+our $VERSION = '4.99_002';
+
+#  A set of colour palettes.
+#  Add to as needed.
+
+sub get_palette_colorbrewer_paired {
+    # Paired colour scheme from colorbrewer, plus a dark grey
+    #  note - this works poorly when 9 or fewer groups are selected
+    no warnings 'qw';  #  we know the hashes are not comments
+    my @palette = (
+        '#A6CEE3', '#1F78B4', '#B2DF8A', '#33A02C',
+        '#FB9A99', '#E31A1C', '#FDBF6F', '#FF7F00',
+        '#CAB2D6', '#6A3D9A', '#FFFF99', '#B15928',
+        '#4B4B4B',
+    );
+    return wantarray ? @palette : [@palette];
+}
+
+sub get_palette_colorbrewer_set1 {
+    # 9 class colour scheme from www.colorbrewer2.org
+    my @palette = (
+        '#E41A1C', '#377EB8', '#4DAF4A', '#984EA3',
+        '#FF7F00', '#FFFF33', '#A65628', '#F781BF',
+        '#999999',
+    );
+    return wantarray ? @palette : [@palette];
+}
+
+sub get_palette_colorbrewer_set2 {
+    # 8 class colour scheme from www.colorbrewer2.org
+    my @palette = (
+        '#66c2a5', '#fc8d62', '#8da0cb', '#e78ac3',
+        '#a6d854', '#ffd92f', '#e5c494', '#b3b3b3',
+    );
+    return wantarray ? @palette : [@palette];
+}
+
+sub get_palette_colorbrewer_set3 {
+    # 12 class colour scheme from www.colorbrewer2.org
+    my @palette = (
+        '#8dd3c7', '#ffffb3', '#bebada', '#fb8072',
+        '#80b1d3', '#fdb462', '#b3de69', '#fccde5',
+        '#d9d9d9', '#bc80bd', '#ccebc5', '#ffed6f',
+    );
+    return wantarray ? @palette : [@palette];
+}
+
+sub get_palette_colorbrewer_pastel1 {
+    # 9 class colour scheme from www.colorbrewer2.org
+    my @palette = (
+        '#fbb4ae', '#b3cde3', '#ccebc5', '#decbe4',
+        '#fed9a6', '#ffffcc', '#e5d8bd', '#fddaec',
+        '#f2f2f2'
+    );
+    return wantarray ? @palette : [@palette];
+}
+
+sub get_palette_colorbrewer_pastel2 {
+    # 8 class colour scheme from www.colorbrewer2.org
+    my @palette = (
+        '#b3e2cd', '#fdcdac', '#cbd5e8', '#f4cae4',
+        '#e6f5c9', '#fff2ae', '#f1e2cc', '#cccccc'
+    );
+    return wantarray ? @palette : [@palette];
+}
+
+sub get_palette_colorbrewer_accent {
+    # 8 class colour scheme from www.colorbrewer2.org
+    my @palette = (
+        '#7fc97f', '#beaed4', '#fdc086', '#ffff99',
+        '#386cb0', '#f0027f', '#bf5b17', '#666666'
+    );
+    return wantarray ? @palette : [@palette];
+}
+
+sub get_palette_colorbrewer_dark2 {
+    # 8 class colour scheme from www.colorbrewer2.org
+    my @palette = (
+        '#1b9e77', '#d95f02', '#7570b3', '#e7298a',
+        '#66a61e', '#e6ab02', '#a6761d', '#666666',
+    );
+    return wantarray ? @palette : [@palette];
+}
+
+
+
+1;
diff --git a/lib/Biodiverse/GUI/GUIManager.pm b/lib/Biodiverse/GUI/GUIManager.pm
@@ -13,7 +13,6 @@ use Carp;
 use Scalar::Util qw /blessed/;
 
 use English ( -no_match_vars );
-use Readonly;
 
 use FindBin qw ( $Bin );
 use Path::Tiny qw /path/;

diff --git a/lib/Biodiverse/GUI/Legend.pm b/lib/Biodiverse/GUI/Legend.pm
@@ -213,10 +213,12 @@ sub make_rect {
         my $label_hash = $self->{categorical}{labels};
 
         my $n = (scalar keys %$label_hash) - 1;
+        my @classes = sort {$a <=> $b} keys %$label_hash;
+        $n = $#classes;
         foreach my $row (0..($height - 1)) {
             #  cat 0 at the top
-            my $class = $n - int (0.5 + $n * $row / ($height - 1));
-            my $colour = $self->get_colour_categorical ($class);
+            my $class_iter = $n - int (0.5 + $n * $row / ($height - 1));
+            my $colour = $self->get_colour_categorical ($classes[$class_iter]);
             $self->add_row($self->{legend_colours_group}, $row, $colour);
         }
     }

diff --git a/lib/Biodiverse/GUI/Manager/BaseDatas.pm b/lib/Biodiverse/GUI/Manager/BaseDatas.pm
@@ -10,7 +10,6 @@ use Carp;
 use Scalar::Util qw /blessed/;
 
 use English ( -no_match_vars );
-use Readonly;
 
 use FindBin qw ( $Bin );
 use Text::Wrapper;

diff --git a/lib/Biodiverse/GUI/Tabs/CalculationsTree.pm b/lib/Biodiverse/GUI/Tabs/CalculationsTree.pm
@@ -21,7 +21,6 @@ use Text::Wrapper;
 
 our $VERSION = '4.99_002';
 
-#use Readonly;
 my $i;
 use constant MODEL_NAME_COL        =>   $i || 0;
 use constant MODEL_INDEX_COL       => ++$i;

diff --git a/lib/Biodiverse/Indices/Indices.pm b/lib/Biodiverse/Indices/Indices.pm
@@ -87,14 +87,13 @@ sub calc_richness {  #  calculate the aggregate richness for a set of elements
     my $self = shift;
     my %args = @_;  #  rest of args into a hash
 
-    my %results = (RICHNESS_ALL => $args{ABC},
-                   RICHNESS_SET1 => $args{A} + $args{B},
-                   RICHNESS_SET2 => $args{A} + $args{C},
-                  );
+    my %results = (
+        RICHNESS_ALL  => $args{ABC},
+        RICHNESS_SET1 => $args{A} + $args{B},
+        RICHNESS_SET2 => $args{A} + $args{C},
+    );
 
-    return wantarray
-        ? (%results)
-        : \%results;
+    return wantarray ? %results : \%results;
 }
 
 sub get_metadata_calc_redundancy {
@@ -1518,7 +1517,6 @@ sub get_metadata_calc_nonempty_elements_used {
         name            => 'Non-empty element counts',
         description     => "Counts of non-empty elements in neighbour sets 1 and 2.\n",
         type            => 'Lists and Counts',
-        pre_calc        => 'calc_abc',
         uses_nbr_lists  => 1,  #  how many sets of lists it must have
         indices         => {
             EL_COUNT_NONEMPTY_SET1 => {
@@ -1548,24 +1546,17 @@ sub calc_nonempty_elements_used {
     #  should run a precalc_gobal to check if the
     #  basedata has empty groups as then we can shortcut
     my $bd   = $self->get_basedata_ref;
-    my $list = $args{element_list_all};
 
-    my %nonempty;
-    foreach my $gp (@$list) {
-        my $ref = $bd->get_labels_in_group_as_hash (group => $gp);
-        next if !scalar keys %$ref;
-        $nonempty{$gp}++;
-    }
-    my $non_empty_all  = scalar keys %nonempty;
-    my $non_empty_set1 = grep {exists $nonempty{$_}} keys %{$args{element_list1} // {}};
-    my $non_empty_set2 = $args{element_list2}
-        ? grep {exists $nonempty{$_}} keys %{$args{element_list2}}
+    my $non_empty_set1 = grep {$bd->get_richness_aa($_)} @{$args{element_list1} // []};
+    my $non_empty_set2
+        = $args{element_list2}
+        ? grep {$bd->get_richness_aa($_)} @{$args{element_list2}}
         : undef;
 
     my %results = (
         EL_COUNT_NONEMPTY_SET1 => $non_empty_set1,
         EL_COUNT_NONEMPTY_SET2 => $non_empty_set2,
-        EL_COUNT_NONEMPTY_ALL  => $non_empty_all,
+        EL_COUNT_NONEMPTY_ALL  => $non_empty_set1 + ($non_empty_set2 // 0),
     );
 
     return wantarray ? %results : \%results;