From 71a23aa82b3331cb16b23ee924cfb40e3e1e71b2 Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Thu, 21 Dec 2023 13:48:28 +1100
Subject: [PATCH 01/19] Indices: allow for categorical types in bounds tests

---
 t/23-Indices.t | 26 +++++++++++++++++---------
 1 file changed, 17 insertions(+), 9 deletions(-)

diff --git a/t/23-Indices.t b/t/23-Indices.t
index 3bdbef41f..79a1f5882 100644
--- a/t/23-Indices.t
+++ b/t/23-Indices.t
@@ -242,17 +242,25 @@ sub test_index_bounds {
 
     foreach my $index (sort keys %$indices) {
         my $bounds = $indices_object->get_index_bounds (index => $index);
-        like $bounds,
-            [$RE_bound, $RE_bound],
-            "Bounds for scalar index $index match expected pattern";
         my $index_source = $indices_object->get_index_source(index => $index);
         my $metadata = $indices_object->get_metadata( sub => $index_source );
-        my $expected
-            = $metadata->get_index_is_unit_interval ($index) ? [0,1]
-            : $metadata->get_index_is_nonnegative ($index)   ? [0,'Inf']
-            : $metadata->get_index_is_categorical ($index)   ? []
-            : ['-Inf','Inf'];
-        is $bounds, $expected, "Bounds correct for $index";
+        if ($metadata->get_index_is_categorical($index)) {
+            my $todo = todo('categorical needs tests');
+            like $bounds,
+                [ $RE_bound, $RE_bound ],
+                "Bounds for scalar index $index match expected pattern";
+        }
+        else {
+            like $bounds,
+                [ $RE_bound, $RE_bound ],
+                "Bounds for scalar index $index match expected pattern";
+            my $expected
+                = $metadata->get_index_is_unit_interval($index) ? [ 0, 1 ]
+                : $metadata->get_index_is_nonnegative($index) ? [ 0, 'Inf' ]
+                : $metadata->get_index_is_categorical($index) ? []
+                : [ '-Inf', 'Inf' ];
+            is $bounds, $expected, "Bounds correct for $index";
+        }
     }
 }
 

From 8198cf627631ec230b67a41d0a1f599b684bfa22 Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Thu, 21 Dec 2023 17:46:04 +1100
Subject: [PATCH 02/19] GUI: handle divergent indices in dendrogram plotting

---
 lib/Biodiverse/GUI/Tabs/Spatial.pm | 25 ++++++++++++++++++-------
 lib/Biodiverse/GUI/Tabs/Tab.pm     |  9 +++++----
 2 files changed, 23 insertions(+), 11 deletions(-)

diff --git a/lib/Biodiverse/GUI/Tabs/Spatial.pm b/lib/Biodiverse/GUI/Tabs/Spatial.pm
index e56a45f3b..d545fa70c 100644
--- a/lib/Biodiverse/GUI/Tabs/Spatial.pm
+++ b/lib/Biodiverse/GUI/Tabs/Spatial.pm
@@ -1579,6 +1579,8 @@ sub colour_branches_on_dendrogram {
     $legend->set_zscore_mode ($is_zscore);
     my $is_prank = $list_name =~ />>p_rank>>/;
     $legend->set_prank_mode ($is_prank);
+    my $is_divergent = $self->index_is_divergent (list => $list_name);
+    $legend->set_divergent_mode ($is_divergent);
 
     my $log_check_box = $self->{xmlPage}->get_object('menuitem_spatial_tree_log_scale');
     if ($log_check_box->get_active) {
@@ -1598,15 +1600,24 @@ sub colour_branches_on_dendrogram {
     
     my $minmax
       = $self->get_index_min_max_values_across_full_list ($list_name);
-
-    $legend->set_min_max (@$minmax);
     my ($min, $max) = @$minmax;  #  should not need to pass this
-
-    #  currently does not handle divergent, ratio or CANAPE - these do not yet apply for tree branches
-    my @minmax_args = ($is_zscore || $is_prank) ? () : ($min, $max);
+    if ($is_divergent) {  #  legend should really handle this
+        my $mx = max (abs($min), abs($max));
+        $min =  0;
+        $max =  $mx;
+        @$minmax = ($min, $mx);
+    }
+    $legend->set_min_max ($min, $max);
+
+    #  currently does not handle ratio or CANAPE - these do not yet apply for tree branches
+    my @minmax_args
+        = ($is_zscore || $is_prank) ? ()
+        : $is_divergent ? (0, $max)
+        : ($min, $max);
     my $colour_method
-        = $is_zscore ? 'get_colour_zscore'
-        : $is_prank  ? 'get_colour_prank'
+        = $is_zscore    ? 'get_colour_zscore'
+        : $is_prank     ? 'get_colour_prank'
+        : $is_divergent ? 'get_colour_divergent'
         : 'get_colour';
 
     my $checkbox_show_legend = $self->{xmlPage}->get_object('menuitem_spatial_tree_show_legend');
diff --git a/lib/Biodiverse/GUI/Tabs/Tab.pm b/lib/Biodiverse/GUI/Tabs/Tab.pm
index 34b250743..874a89300 100644
--- a/lib/Biodiverse/GUI/Tabs/Tab.pm
+++ b/lib/Biodiverse/GUI/Tabs/Tab.pm
@@ -557,9 +557,8 @@ sub index_is_divergent {
     my %args = @_;
 
     #  check list and then check index
-    my $list = $args{list} // '';
-
-    return if $args{list} ne 'SPATIAL_RESULTS';
+    my $list  = $args{list} // '';
+    my $index = $args{index} // '';
 
     state $bd_obj = Biodiverse::BaseData->new (
         NAME         => 'divergency',
@@ -570,7 +569,9 @@ sub index_is_divergent {
         BASEDATA_REF => $bd_obj,
     );
 
-    my $index = $args{index} // '';
+    return 1
+        if $indices_object->index_is_list (index => $list)
+            && $indices_object->index_is_divergent (index => $list);
 
     return $indices_object->index_is_divergent (index => $index);
 }

From f5e171b128263ff879f1d079d81f394f94998558 Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Thu, 21 Dec 2023 21:32:18 +1100
Subject: [PATCH 03/19] GUI: Simplify legend plot modes

It was getting very messy and repetitive.
---
 lib/Biodiverse/GUI/Dendrogram.pm   |  84 +++++-----------------
 lib/Biodiverse/GUI/Legend.pm       | 112 ++++++++++++++++++++++++-----
 lib/Biodiverse/GUI/Tabs/Spatial.pm |  75 ++++---------------
 lib/Biodiverse/GUI/Tabs/Tab.pm     |   9 +--
 4 files changed, 131 insertions(+), 149 deletions(-)

diff --git a/lib/Biodiverse/GUI/Dendrogram.pm b/lib/Biodiverse/GUI/Dendrogram.pm
index 094f7961e..2466ab830 100644
--- a/lib/Biodiverse/GUI/Dendrogram.pm
+++ b/lib/Biodiverse/GUI/Dendrogram.pm
@@ -872,19 +872,6 @@ sub recolour_cluster_elements {
     my $cluster_colour_mode = $self->get_cluster_colour_mode();
     my $colour_callback;
 
-    my %list_and_index = (list => $list_name, index => $list_index);
-    my $is_canape = $list_name =~ />>CANAPE>>/ && $list_index =~ /CANAPE/;
-    my $is_zscore = eval {
-        $parent_tab->index_is_zscore(%list_and_index);
-    };
-    my $is_prank = $list_name =~ />>p_rank>>/;
-    my $is_ratio
-        = !$is_prank && !$is_zscore
-        && eval {$parent_tab->index_is_ratio(%list_and_index)};
-    my $is_divergent
-        = !$is_prank && !$is_zscore && !$is_ratio
-        && eval {$parent_tab->index_is_divergent(%list_and_index)};
-
     if ($cluster_colour_mode eq 'palette') {
         # sets colours according to palette
         $colour_callback = sub {
@@ -924,17 +911,13 @@ sub recolour_cluster_elements {
         };
     }
     elsif ($cluster_colour_mode eq 'list-values') {
-        my $abs_extreme;
-        if ($is_ratio) {
-            $abs_extreme = exp (max (abs log $analysis_min, log $analysis_max));
-            $analysis_min = 1 / $abs_extreme;
-            $analysis_max = $abs_extreme;
-        }
-        elsif ($is_divergent) {  #  assumes zero - needs work
-            $abs_extreme = max(abs $analysis_min, abs $analysis_max);
-            $analysis_min = 0;
-            $analysis_max = $abs_extreme;
-        }
+        my $legend = $map->get_legend;
+        $legend->set_colour_mode_from_list_and_index (
+            list  => $list_name,
+            index => $list_index,
+        );
+        my @minmax_args = ($analysis_min, $analysis_max);
+        my $colour_method = $legend->get_colour_method;
 
         # sets colours according to (usually spatial)
         # list value for the element's cluster
@@ -952,12 +935,7 @@ sub recolour_cluster_elements {
                 my $val = $list_ref->{$list_index}
                   // return $colour_for_undef;
                 
-                return $is_canape ? $map->get_colour_canape ($val)
-                     : $is_zscore ? $map->get_colour_zscore ($val)
-                     : $is_prank  ? $map->get_colour_prank ($val)
-                     : $is_ratio  ? $map->get_colour_ratio ($val, $abs_extreme)
-                     : $is_divergent  ? $map->get_colour_divergent ($val, 0, $abs_extreme)
-                     : $map->get_colour($val, $analysis_min, $analysis_max);
+                return $legend->$colour_method ($val, @minmax_args);
             }
             else {
                 return exists $terminal_elements->{$elt}
@@ -974,12 +952,6 @@ sub recolour_cluster_elements {
 
     $map->colour ($colour_callback);
 
-    $map->get_legend->set_canape_mode($is_canape);
-    $map->get_legend->set_zscore_mode($is_zscore);
-    $map->get_legend->set_prank_mode($is_prank);
-    $map->get_legend->set_ratio_mode($is_ratio);
-    $map->get_legend->set_divergent_mode($is_divergent);
-
     if ($cluster_colour_mode eq 'list-values') {
         $map->set_legend_min_max($analysis_min, $analysis_max);
     }
@@ -1259,31 +1231,13 @@ sub recolour_cluster_lines {
     my $analysis_max = $self->{analysis_max};
     my $colour_mode  = $self->get_cluster_colour_mode();
 
-    my %list_and_index = (list => $list_name, index => $list_index);
-    my $is_canape = $list_name =~ />>CANAPE>>/ && $list_index =~ /^CANAPE/;
-    my $is_zscore = eval {
-        $self->{parent_tab}->index_is_zscore (%list_and_index);
-    };
-    my $is_prank = $list_name =~ />>p_rank>>/;
-    my $is_ratio
-        = !$is_prank && !$is_zscore
-        && eval {$self->{parent_tab}->index_is_ratio(%list_and_index)};
-    my $is_divergent
-        = !$is_prank && !$is_zscore && !$is_ratio
-        && eval {$self->{parent_tab}->index_is_divergent(%list_and_index)};
-
-    my $abs_extreme;
-    if ($is_ratio) {
-        $abs_extreme = exp (max (abs log $analysis_min, log $analysis_max));
-        $analysis_min = 1 / $abs_extreme;
-        $analysis_max = $abs_extreme;
-    }
-    elsif ($is_divergent) {  #  assumes zero - needs work
-        $abs_extreme = max(abs $analysis_min, abs $analysis_max);
-        $analysis_min = 0;
-        $analysis_max = $abs_extreme;
-    }
-
+    my $legend = $map->get_legend;
+    $legend->set_colour_mode_from_list_and_index (
+        list  => $list_name,
+        index => $list_index,
+    );
+    my @minmax_args = ($analysis_min, $analysis_max);
+    my $colour_method = $legend->get_colour_method;
 
     foreach my $node_ref (@$cluster_nodes) {
 
@@ -1307,13 +1261,7 @@ sub recolour_cluster_lines {
               : undef;  #  allows for missing lists
 
             $colour_ref = defined $val
-              ? (  $is_canape ? $map->get_colour_canape($val) :
-                   $is_zscore ? $map->get_colour_zscore($val) :
-                   $is_prank  ? $map->get_colour_prank($val) :
-                   $is_ratio  ? $map->get_colour_ratio ($val, $abs_extreme) :
-                   $is_divergent ? $map->get_colour_divergent ($val, 0, $abs_extreme) :
-                   $map->get_colour ($val, $analysis_min, $analysis_max)
-                )
+              ? $legend->$colour_method ($val, @minmax_args)
               : undef;
         }
         else {
diff --git a/lib/Biodiverse/GUI/Legend.pm b/lib/Biodiverse/GUI/Legend.pm
index 2e4f7181c..b10499cdb 100644
--- a/lib/Biodiverse/GUI/Legend.pm
+++ b/lib/Biodiverse/GUI/Legend.pm
@@ -252,10 +252,10 @@ sub make_rect {
         local $self->{log_mode} = 0; # hacky override
 
         my $mid = ($height - 1) / 2;
-        foreach my $row (0..($height - 1)) {
+        foreach my $row (reverse 0..($height - 1)) {
             my $val = $row < $mid ? 1 / ($mid - $row) : $row - $mid;
             #  invert again so colours match legend text
-            my $colour = $self->get_colour_ratio (1 / $val, $mid);
+            my $colour = $self->get_colour_ratio (1/$val, 1/$mid, $mid);
             $self->add_row($self->{legend_colours_group}, $row, $colour);
         }
     }
@@ -267,9 +267,10 @@ sub make_rect {
 
         my $centre = ($height - 1) / 2;
         my $extreme = $height - $centre;
-        foreach my $row (0..($height - 1)) {
-            #  ensure colours match plot since 0 is the top
-            my $colour = $self->get_colour_divergent ($height - $row, $centre, $extreme);
+
+        #  ensure colours match plot since 0 is the top
+        foreach my $row (reverse 0..($height - 1)) {
+            my $colour = $self->get_colour_divergent ($centre - $row, -$extreme, $extreme);
             $self->add_row($self->{legend_colours_group}, $row, $colour);
         }
     }
@@ -658,16 +659,17 @@ sub get_colour_prank {
 }
 
 sub get_colour_divergent {
-    my ($self, $val, $centre, $max_dist) = @_;
+    my ($self, $val, $min, $max) = @_;
 
     state $default_colour = Gtk2::Gdk::Color->new(0, 0, 0);
 
     return $default_colour
-        if ! defined $max_dist;
+        if ! (defined $max && defined $min);
 
     state $centre_colour = Gtk2::Gdk::Color->parse('#ffffbf');
 
-    $centre //= 0;
+    my $centre = 0;
+    my $max_dist = max (abs($min), abs($max));
 
     return $centre_colour
         if $val == $centre || $max_dist == 0;
@@ -705,18 +707,23 @@ sub get_colour_divergent {
 }
 
 sub get_colour_ratio {
-    my ($self, $val, $extreme) = @_;
+    my ($self, $val, $min, $max) = @_;
 
     state $default_colour = Gtk2::Gdk::Color->new(0, 0, 0);
 
     return $default_colour
-        if ! defined $extreme;
+        if ! (defined $min && defined $max);
 
     state $centre_colour = Gtk2::Gdk::Color->parse('#ffffbf');
 
+    my $extreme = exp (max (abs log $min, log $max));
+
     return $centre_colour
         if $val == 1 || $extreme == 1;
 
+    # $min = 1 / $extreme;
+    # $max = $extreme;
+
     #  simplify logic below
     if ($extreme < 1) {
         $extreme = 1 / $extreme;
@@ -916,11 +923,18 @@ sub set_min_max {
     return $self->set_text_marks_canape
         if $self->get_canape_mode;
 
-    return $self->set_text_marks_divergent ($val1, $val2)
-        if $self->get_divergent_mode;
-
-    return $self->set_text_marks_ratio ($val2)
-        if $self->get_ratio_mode;
+    if ($self->get_divergent_mode) {
+        my $abs_extreme = max(abs $val1, abs $val2);
+        my $min = 0;
+        my $max = $abs_extreme;
+        return $self->set_text_marks_divergent($min, $max);
+    }
+    elsif ($self->get_ratio_mode) {
+        my $abs_extreme = exp (max (abs log $val1, log $val2));
+        my $min = 1 / $abs_extreme;
+        my $max = $abs_extreme;
+        return $self->set_text_marks_ratio($min, $max)
+    }
 
     my $min = $val1 //= $self->{last_min};
     my $max = $val2 //= $self->{last_max};
@@ -1039,7 +1053,10 @@ sub set_text_marks_zscore {
 
 #  refactor needed
 sub set_text_marks_divergent {
-    my ($self, $mid, $extent) = @_;
+    my ($self, $min, $max) = @_;
+
+    my $extent = max (abs($min), abs ($max));
+    my $mid = 0;
 
     my $mid2 = ($mid + $extent) / 2;
     my @strings = (
@@ -1075,7 +1092,7 @@ sub set_text_marks_divergent {
 }
 
 sub set_text_marks_ratio {
-    my ($self, $max) = @_;
+    my ($self, $min, $max) = @_;
 
     $max //= 1;
     my $mid = 1 + ($max - 1) / 2;
@@ -1161,6 +1178,67 @@ sub get_log_mode {
     $_[0]->{log_mode};
 }
 
+#  need a better name
+sub _get_nonbasic_plot_modes {
+    my @modes = qw/canape zscore prank ratio divergent/;
+    return wantarray ? @modes : \@modes;
+}
+
+sub set_colour_mode_from_list_and_index {
+    my ($self, %args) = @_;
+    my $index = $args{index} // '';
+    my $list  = $args{list}  // '';
+
+    state $bd_obj = Biodiverse::BaseData->new (
+        NAME         => 'colour-mode',
+        CELL_SIZES   => [1],
+        CELL_ORIGINS => [0]
+    );
+    state $indices_object = Biodiverse::Indices->new (
+        BASEDATA_REF => $bd_obj,
+    );
+
+    my $is_list = $list && $list !~ />>/ && $indices_object->index_is_list (index => $list);
+    if ($is_list) {
+        $index = $list
+    }
+
+    #  check list name then index name
+    my $mode
+        = $list =~ />>z_scores>>/                               ? 'zscore'
+        : $list =~ />>p_rank>>/                                 ? 'prank'
+        : $list =~ />>CANAPE>>/ && $index =~ /^CANAPE/          ? 'canape'
+        : $indices_object->index_is_zscore (index => $index)    ? 'zscore'
+        : $indices_object->index_is_ratio (index => $index)     ? 'ratio'
+        : $indices_object->index_is_divergent (index => $index) ? 'divergent'
+        : '';
+
+    #  clunky to have to iterate over these but they trigger things turning off
+    foreach my $possmode (_get_nonbasic_plot_modes()) {
+        my $method = "set_${possmode}_mode";
+        $self->$method ($mode eq $possmode);
+    }
+
+    return;
+}
+
+sub get_colour_method {
+    my $self = shift;
+
+    my $method = 'get_colour';
+
+    #  clunky to have to iterate over these,
+    #  even if we use a lookup table
+    foreach my $mode (_get_nonbasic_plot_modes()) {
+        my $check_method = "get_${mode}_mode";
+        if ($self->$check_method) {
+            $method = "get_colour_${mode}";
+        }
+    }
+
+    return $method;
+}
+
 sub set_canape_mode_on {
     my ($self) = @_;
     my $prev_val = $self->{canape_mode};
diff --git a/lib/Biodiverse/GUI/Tabs/Spatial.pm b/lib/Biodiverse/GUI/Tabs/Spatial.pm
index d545fa70c..2c4f4e3ff 100644
--- a/lib/Biodiverse/GUI/Tabs/Spatial.pm
+++ b/lib/Biodiverse/GUI/Tabs/Spatial.pm
@@ -1574,13 +1574,10 @@ sub colour_branches_on_dendrogram {
     my $output_ref = $self->{output_ref};
 
     my $legend = $dendrogram->get_legend;
-
-    my $is_zscore = $self->index_is_zscore (list => $list_name);
-    $legend->set_zscore_mode ($is_zscore);
-    my $is_prank = $list_name =~ />>p_rank>>/;
-    $legend->set_prank_mode ($is_prank);
-    my $is_divergent = $self->index_is_divergent (list => $list_name);
-    $legend->set_divergent_mode ($is_divergent);
+    $legend->set_colour_mode_from_list_and_index (
+        list  => $list_name,
+        index => '',
+    );
 
     my $log_check_box = $self->{xmlPage}->get_object('menuitem_spatial_tree_log_scale');
     if ($log_check_box->get_active) {
@@ -1601,24 +1598,11 @@ sub colour_branches_on_dendrogram {
     my $minmax
       = $self->get_index_min_max_values_across_full_list ($list_name);
     my ($min, $max) = @$minmax;  #  should not need to pass this
-    if ($is_divergent) {  #  legend should really handle this
-        my $mx = max (abs($min), abs($max));
-        $min =  0;
-        $max =  $mx;
-        @$minmax = ($min, $mx);
-    }
     $legend->set_min_max ($min, $max);
 
     #  currently does not handle ratio or CANAPE - these do not yet apply for tree branches
-    my @minmax_args
-        = ($is_zscore || $is_prank) ? ()
-        : $is_divergent ? (0, $max)
-        : ($min, $max);
-    my $colour_method
-        = $is_zscore    ? 'get_colour_zscore'
-        : $is_prank     ? 'get_colour_prank'
-        : $is_divergent ? 'get_colour_divergent'
-        : 'get_colour';
+    my @minmax_args = ($min, $max);
+    my $colour_method = $legend->get_colour_method;
 
     my $checkbox_show_legend = $self->{xmlPage}->get_object('menuitem_spatial_tree_show_legend');
     if ($checkbox_show_legend->get_active) {
@@ -2016,28 +2000,13 @@ sub recolour {
     #delete @{$colour_cache}{keys %$colour_cache};  #  temp for debug
     my $ccache = $colour_cache->{$list}{$index} //= {};
 
-    my %list_and_index = (list => $list, index => $index);
-    my $is_canape = $list =~ />>CANAPE>>/ && $index =~ /^CANAPE/;
-    my $is_zscore = $self->index_is_zscore (%list_and_index);
-    my $is_prank  = $list =~ />>p_rank>>/;
-    my $is_ratio
-        = !$is_prank && !$is_zscore
-          && $self->index_is_ratio (%list_and_index);
-    my $is_divergent
-        = !$is_prank && !$is_zscore && !$is_ratio
-          && $self->index_is_divergent (%list_and_index);
-
-    my $abs_extreme;
-    if ($is_ratio) {
-        $abs_extreme = exp (max (abs log $min, log $max));
-        $min = 1 / $abs_extreme;
-        $max = $abs_extreme;
-    }
-    elsif ($is_divergent) {  #  assumes zero - needs work
-        $abs_extreme = max(abs $min, abs $max);
-        $min = 0;
-        $max = $abs_extreme;
-    }
+    my $legend = $grid->get_legend;
+
+    $legend->set_colour_mode_from_list_and_index (
+        list  => $list,
+        index => $index,
+    );
+    my $colour_method = $legend->get_colour_method;
 
     my $colour_func = sub {
         my $elt = shift // return;
@@ -2051,14 +2020,8 @@ sub recolour {
             #  should use a method here
             my $val = $elements_hash->{$elt}{$list}{$index};
             $colour
-              = defined $val ? (
-                  $is_canape ? $grid->get_colour_canape ($val) :
-                  $is_zscore ? $grid->get_colour_zscore ($val) :
-                  $is_prank  ? $grid->get_colour_prank ($val)  :
-                  $is_ratio  ? $grid->get_colour_ratio ($val, $abs_extreme) :
-                  $is_divergent ? $grid->get_colour_divergent ($val, 0, $abs_extreme) :
-                  $grid->get_colour($val, $min, $max)
-              )
+              = defined $val
+              ? $legend->$colour_method ($val, $min, $max)
               : $colour_none;
         }
         
@@ -2072,14 +2035,6 @@ sub recolour {
     #    !$output_ref->group_passed_def_query(group => $elt);
     #};
 
-    my $legend = $self->{grid}->get_legend;
-    #  This is getting messy but ensures cleanup of old labels.
-    #  Should register active labels.
-    $legend->set_canape_mode($is_canape);
-    $legend->set_zscore_mode($is_zscore);
-    $legend->set_prank_mode($is_prank);
-    $legend->set_ratio_mode($is_ratio);
-    $legend->set_divergent_mode($is_divergent);
     $self->show_legend;
 
     $grid->colour($colour_func);
diff --git a/lib/Biodiverse/GUI/Tabs/Tab.pm b/lib/Biodiverse/GUI/Tabs/Tab.pm
index 874a89300..4b7deb280 100644
--- a/lib/Biodiverse/GUI/Tabs/Tab.pm
+++ b/lib/Biodiverse/GUI/Tabs/Tab.pm
@@ -534,9 +534,8 @@ sub index_is_ratio {
     my %args = @_;
 
     #  check list and then check index
-    my $list = $args{list} // '';
-
-    return if $args{list} ne 'SPATIAL_RESULTS';
+    my $list  = $args{list} // '';
+    my $index = $args{index} // '';
 
     state $bd_obj = Biodiverse::BaseData->new (
         NAME         => 'rationing',
@@ -547,7 +546,9 @@ sub index_is_ratio {
         BASEDATA_REF => $bd_obj,
     );
 
-    my $index = $args{index} // '';
+    return 1
+        if $indices_object->index_is_list (index => $list)
+            && $indices_object->index_is_ratio (index => $list);
 
     return $indices_object->index_is_ratio (index => $index);
 }

From 2e53d7badf1851ec1604655e35c4248e5958022a Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Thu, 21 Dec 2023 21:39:15 +1100
Subject: [PATCH 04/19] Grid.pm: remove no longer needed methods

---
 lib/Biodiverse/GUI/Grid.pm | 31 -------------------------------
 1 file changed, 31 deletions(-)

diff --git a/lib/Biodiverse/GUI/Grid.pm b/lib/Biodiverse/GUI/Grid.pm
index e47d83d6d..7e30e81b6 100644
--- a/lib/Biodiverse/GUI/Grid.pm
+++ b/lib/Biodiverse/GUI/Grid.pm
@@ -1135,37 +1135,6 @@ sub set_colour_for_undef {
     $self->{colour_none} = $colour;
 }
 
-#  need factory generation for the next few
-sub get_colour {
-    my $self = shift;
-    return $self->get_legend->get_colour (@_);
-}
-
-sub get_colour_canape {
-    my $self = shift;
-    return $self->get_legend->get_colour_canape (@_);
-}
-
-sub get_colour_zscore {
-    my $self = shift;
-    return $self->get_legend->get_colour_zscore (@_);
-}
-
-sub get_colour_prank {
-    my $self = shift;
-    return $self->get_legend->get_colour_prank (@_);
-}
-
-sub get_colour_ratio {
-    my $self = shift;
-    return $self->get_legend->get_colour_ratio (@_);
-}
-
-sub get_colour_divergent {
-    my $self = shift;
-    return $self->get_legend->get_colour_divergent (@_);
-}
-
 
 ##########################################################
 # Data extraction utilities

From 38b5bebf93cd4357263772df057b1448e025fd32 Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Thu, 21 Dec 2023 22:06:38 +1100
Subject: [PATCH 05/19] Legend: change mark structures

This will enable other future changes.
---
 lib/Biodiverse/GUI/Legend.pm | 64 ++++++++++++++++++------------------
 1 file changed, 32 insertions(+), 32 deletions(-)

diff --git a/lib/Biodiverse/GUI/Legend.pm b/lib/Biodiverse/GUI/Legend.pm
index b10499cdb..b1dd59b87 100644
--- a/lib/Biodiverse/GUI/Legend.pm
+++ b/lib/Biodiverse/GUI/Legend.pm
@@ -109,19 +109,19 @@ sub new {
 
     #  reverse might not be needed but ensures the array is the correct size from the start
     foreach my $i (reverse 0..3) {
-        $self->{marks}[$i] = $self->make_mark($self->{legend_marks}[$i]);
+        $self->{marks}{default}[$i] = $self->make_mark($self->{legend_marks}[$i]);
     }
     #  clunky that we need to do it here
     my @anchors = ('nw', ('w') x 3, 'sw');
     foreach my $i (reverse 0..4) {
-        $self->{canape_marks}[$i]    = $self->make_mark($anchors[$i]);
-        $self->{divergent_marks}[$i] = $self->make_mark($anchors[$i]);
-        $self->{ratio_marks}[$i]     = $self->make_mark($anchors[$i]);
+        $self->{marks}{canape}[$i]    = $self->make_mark($anchors[$i]);
+        $self->{marks}{divergent}[$i] = $self->make_mark($anchors[$i]);
+        $self->{marks}{ratio}[$i]     = $self->make_mark($anchors[$i]);
     }
     @anchors = ('nw', ('w') x 5, 'sw');
     foreach my $i (reverse 0..6) {
-        $self->{zscore_marks}[$i] = $self->make_mark($anchors[$i]);
-        $self->{prank_marks}[$i]  = $self->make_mark($anchors[$i]);
+        $self->{marks}{zscore}[$i] = $self->make_mark($anchors[$i]);
+        $self->{marks}{prank}[$i]  = $self->make_mark($anchors[$i]);
     }
 
     #  debug stuff
@@ -429,12 +429,12 @@ sub reposition {
 
     # Reposition the "mark" textboxes
     my @mark_arr
-        = $self->get_zscore_mode ? @{$self->{zscore_marks}}
-        : $self->get_prank_mode  ? @{$self->{prank_marks}}
-        : $self->get_canape_mode ? @{$self->{canape_marks}}
-        : $self->get_divergent_mode ? @{$self->{divergent_marks}}
-        : $self->get_ratio_mode  ? @{$self->{ratio_marks}}
-        : @{$self->{marks}};
+        = $self->get_zscore_mode ? @{$self->{marks}{zscore}}
+        : $self->get_prank_mode  ? @{$self->{marks}{prank}}
+        : $self->get_canape_mode ? @{$self->{marks}{canape}}
+        : $self->get_divergent_mode ? @{$self->{marks}{divergent}}
+        : $self->get_ratio_mode  ? @{$self->{marks}{ratio}}
+        : @{$self->{marks}{default}};
     foreach my $i (0..$#mark_arr) {
         my $mark = $mark_arr[$#mark_arr - $i];
         #  move the mark to right align with the legend
@@ -916,7 +916,7 @@ sub set_min_max {
     return $self->set_text_marks_prank
         if $self->get_prank_mode;
 
-    # foreach my $mark (@{$self->{marks}}) {
+    # foreach my $mark (@{$self->{marks}{default}}) {
     #     $mark->show;
     # }
 
@@ -943,13 +943,13 @@ sub set_min_max {
     $self->{last_max} = $max;
 
 
-    return if ! ($self->{marks}
+    return if ! ($self->{marks}{default}
                  && defined $min
                  && defined $max
                 );
 
     # Set legend textbox markers
-    my @mark_arr = @{$self->{marks}};
+    my @mark_arr = @{$self->{marks}{default}};
     my $marker_step = ($max - $min) / $#mark_arr;
     foreach my $i (0..$#mark_arr) {
         my $val = $min + $i * $marker_step;
@@ -973,7 +973,7 @@ sub set_min_max {
             $text = '  ' . $text;
         }
 
-        my $mark = $self->{marks}[$#mark_arr - $i];
+        my $mark = $self->{marks}{default}[$#mark_arr - $i];
         $mark->set( text => $text );
         #  move the mark to right align with the legend
         my @bounds = $mark->get_bounds;
@@ -994,15 +994,15 @@ sub set_min_max {
 sub set_text_marks_canape {
     my $self = shift;
 
-    return if !$self->{marks};
+    return if !$self->{marks}{default};
 
-    foreach my $mark (@{$self->{marks}}) {
+    foreach my $mark (@{$self->{marks}{default}}) {
         $mark->hide;
     }
 
     my @strings = qw /super mixed palaeo neo non-sig/;
 
-    my $mark_arr = $self->{canape_marks} //= [];
+    my $mark_arr = $self->{marks}{canape} //= [];
     if (!@$mark_arr) {
         foreach my $i (0 .. $#strings) {
             my $anchor_loc = $i == 0 ? 'nw' : $i == $#strings ? 'sw' : 'w';
@@ -1024,15 +1024,15 @@ sub set_text_marks_zscore {
     my $self = shift;
 
     #  needed?  seem to remember it avoids triggering marks if grid is not set up
-    return if !$self->{marks};
+    return if !$self->{marks}{default};
 
-    foreach my $mark (@{$self->{marks}}) {
+    foreach my $mark (@{$self->{marks}{default}}) {
         $mark->hide;
     }
 
     my @strings = ('<-2.58', '[-2.58,-1.96)', '[-1.96,-1.65)', '[-1.65,1.65]', '(1.65,1.96]', '(1.96,2.58]', '>2.58');
 
-    my $mark_arr = $self->{zscore_marks} //= [];
+    my $mark_arr = $self->{marks}{zscore} //= [];
     if (!@$mark_arr) {
         foreach my $i (0 .. $#strings) {
             my $anchor_loc = $i == 0 ? 'nw' : $i == $#strings ? 'sw' : 'w';
@@ -1088,7 +1088,7 @@ sub set_text_marks_divergent {
     }
     # say join ' ', @strings;
 
-    $self->set_text_marks_for_labels (\@strings, $self->{divergent_marks});
+    $self->set_text_marks_for_labels (\@strings, $self->{marks}{divergent});
 }
 
 sub set_text_marks_ratio {
@@ -1120,13 +1120,13 @@ sub set_text_marks_ratio {
         $strings[-1] = ">=$strings[-1]";
     }
 
-    $self->set_text_marks_for_labels (\@strings, $self->{ratio_marks});
+    $self->set_text_marks_for_labels (\@strings, $self->{marks}{ratio});
 }
 
 sub set_text_marks_prank {
     my $self = shift;
     my @strings = ('<0.01', '<0.025', '<0.05', '[0.05,0.95]', '>0.95', '>0.975', '>0.99');
-    $self->set_text_marks_for_labels (\@strings, $self->{prank_marks});
+    $self->set_text_marks_for_labels (\@strings, $self->{marks}{prank});
 }
 
 #  generalises z-score version - need to simplify it
@@ -1134,14 +1134,14 @@ sub set_text_marks_for_labels {
     my ($self, \@strings, $mark_arr) = @_;
 
     #  needed?  seem to remember it avoids triggering marks if grid is not set up
-    return if !$self->{marks};
+    return if !$self->{marks}{default};
 
     $mark_arr //= [];
 
     carp "Mark count does not match label count"
         if scalar(@strings) != scalar @$mark_arr;
 
-    foreach my $mark (@{$self->{marks}}) {
+    foreach my $mark (@{$self->{marks}{default}}) {
         $mark->hide;
     }
 
@@ -1254,7 +1254,7 @@ sub set_canape_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{canape_mode};
     $self->{canape_mode} = 0;
-    foreach my $mark (@{$self->{canape_marks}}) {
+    foreach my $mark (@{$self->{marks}{canape}}) {
         $mark->hide;
     }
     if ($prev_val) {  #  give back our colours
@@ -1294,7 +1294,7 @@ sub set_zscore_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{zscore_mode};
     $self->{zscore_mode} = 0;
-    foreach my $mark (@{$self->{zscore_marks}}) {
+    foreach my $mark (@{$self->{marks}{zscore}}) {
         $mark->hide;
     }
     if ($prev_val) {  #  give back our colours
@@ -1334,7 +1334,7 @@ sub set_divergent_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{divergent_mode};
     $self->{divergent_mode} = 0;
-    foreach my $mark (@{$self->{divergent_marks}}) {
+    foreach my $mark (@{$self->{marks}{divergent}}) {
         $mark->hide;
     }
     if ($prev_val) {  #  give back our colours
@@ -1374,7 +1374,7 @@ sub set_ratio_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{ratio_mode};
     $self->{ratio_mode} = 0;
-    foreach my $mark (@{$self->{ratio_marks}}) {
+    foreach my $mark (@{$self->{marks}{ratio}}) {
         $mark->hide;
     }
     if ($prev_val) {  #  give back our colours
@@ -1414,7 +1414,7 @@ sub set_prank_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{prank_mode};
     $self->{prank_mode} = 0;
-    foreach my $mark (@{$self->{prank_marks}}) {
+    foreach my $mark (@{$self->{marks}{prank}}) {
         $mark->hide;
     }
     if ($prev_val) {  #  give back our colours

From 9f9c822bb06cbfacdf3568166caac24ce0109c5c Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Fri, 22 Dec 2023 10:36:48 +1100
Subject: [PATCH 06/19] GUI legends: simplify mark array processing

Keep track of the current set.

Refactor several subs to call a commons process.
---
 lib/Biodiverse/GUI/Legend.pm | 73 +++++++++---------------------------
 1 file changed, 17 insertions(+), 56 deletions(-)

diff --git a/lib/Biodiverse/GUI/Legend.pm b/lib/Biodiverse/GUI/Legend.pm
index b1dd59b87..e0ca0ab25 100644
--- a/lib/Biodiverse/GUI/Legend.pm
+++ b/lib/Biodiverse/GUI/Legend.pm
@@ -123,6 +123,14 @@ sub new {
         $self->{marks}{zscore}[$i] = $self->make_mark($anchors[$i]);
         $self->{marks}{prank}[$i]  = $self->make_mark($anchors[$i]);
     }
+    $self->{marks}{current} = $self->{marks}{default};
+    #  generic
+    # foreach my $n (2..7) {
+    #     @anchors = ('nw', ('w') x $n-1, 'sw');
+    #     foreach my $i (reverse 0 .. $n) {
+    #         $self->{marks}{$n+1}[$i] = $self->make_mark($anchors[$i]);
+    #     }
+    # }
 
     #  debug stuff
     #my $sub = sub {
@@ -428,13 +436,7 @@ sub reposition {
     $self->{legend_colours_group}->affine_absolute($matrix);
 
     # Reposition the "mark" textboxes
-    my @mark_arr
-        = $self->get_zscore_mode ? @{$self->{marks}{zscore}}
-        : $self->get_prank_mode  ? @{$self->{marks}{prank}}
-        : $self->get_canape_mode ? @{$self->{marks}{canape}}
-        : $self->get_divergent_mode ? @{$self->{marks}{divergent}}
-        : $self->get_ratio_mode  ? @{$self->{marks}{ratio}}
-        : @{$self->{marks}{default}};
+    my @mark_arr = @{$self->{marks}{current} // []};
     foreach my $i (0..$#mark_arr) {
         my $mark = $mark_arr[$#mark_arr - $i];
         #  move the mark to right align with the legend
@@ -950,6 +952,7 @@ sub set_min_max {
 
     # Set legend textbox markers
     my @mark_arr = @{$self->{marks}{default}};
+    $self->{marks}{current} = \@mark_arr;
     my $marker_step = ($max - $min) / $#mark_arr;
     foreach my $i (0..$#mark_arr) {
         my $val = $min + $i * $marker_step;
@@ -994,61 +997,15 @@ sub set_min_max {
 sub set_text_marks_canape {
     my $self = shift;
 
-    return if !$self->{marks}{default};
-
-    foreach my $mark (@{$self->{marks}{default}}) {
-        $mark->hide;
-    }
-
     my @strings = qw /super mixed palaeo neo non-sig/;
-
-    my $mark_arr = $self->{marks}{canape} //= [];
-    if (!@$mark_arr) {
-        foreach my $i (0 .. $#strings) {
-            my $anchor_loc = $i == 0 ? 'nw' : $i == $#strings ? 'sw' : 'w';
-            $mark_arr->[$i] = $self->make_mark($anchor_loc);
-        }
-    }
-
-    # Set legend textbox markers
-    foreach my $i (0..$#strings) {
-        my $mark = $mark_arr->[$#$mark_arr - $i];
-        $mark->set( text => $strings[$i] );
-        $mark->raise_to_top;
-    }
-
-    return;
+    return $self->set_text_marks_for_labels (\@strings, $self->{marks}{canape});
 }
 
 sub set_text_marks_zscore {
     my $self = shift;
 
-    #  needed?  seem to remember it avoids triggering marks if grid is not set up
-    return if !$self->{marks}{default};
-
-    foreach my $mark (@{$self->{marks}{default}}) {
-        $mark->hide;
-    }
-
     my @strings = ('<-2.58', '[-2.58,-1.96)', '[-1.96,-1.65)', '[-1.65,1.65]', '(1.65,1.96]', '(1.96,2.58]', '>2.58');
-
-    my $mark_arr = $self->{marks}{zscore} //= [];
-    if (!@$mark_arr) {
-        foreach my $i (0 .. $#strings) {
-            my $anchor_loc = $i == 0 ? 'nw' : $i == $#strings ? 'sw' : 'w';
-            $mark_arr->[$i] = $self->make_mark($anchor_loc);
-        }
-    }
-
-    # Set legend textbox markers
-    foreach my $i (0 .. $#strings) {
-        my $mark = $mark_arr->[$#strings - $i];
-        $mark->set( text => $strings[$i] );
-        # $mark->show;
-        $mark->raise_to_top;
-    }
-
-    return;
+    return $self->set_text_marks_for_labels (\@strings, $self->{marks}{zscore});
 }
 
 #  refactor needed
@@ -1141,7 +1098,9 @@ sub set_text_marks_for_labels {
     carp "Mark count does not match label count"
         if scalar(@strings) != scalar @$mark_arr;
 
-    foreach my $mark (@{$self->{marks}{default}}) {
+    $self->{marks}{current} //= $self->{marks}{default};
+
+    foreach my $mark (@{$self->{marks}{current}}) {
         $mark->hide;
     }
 
@@ -1160,6 +1119,8 @@ sub set_text_marks_for_labels {
         $mark->raise_to_top;
     }
 
+    $self->{marks}{current} = $mark_arr;
+
     return;
 }
 

From 4d6b9f2365c9e0932f43960a1fe1e49941d77fd9 Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Fri, 22 Dec 2023 13:33:13 +1100
Subject: [PATCH 07/19] GUI legends: track current mark set

This will allow a refactor in a future commit.
---
 lib/Biodiverse/GUI/Legend.pm | 18 ++++++++++++------
 1 file changed, 12 insertions(+), 6 deletions(-)

diff --git a/lib/Biodiverse/GUI/Legend.pm b/lib/Biodiverse/GUI/Legend.pm
index e0ca0ab25..b2de72cb9 100644
--- a/lib/Biodiverse/GUI/Legend.pm
+++ b/lib/Biodiverse/GUI/Legend.pm
@@ -499,6 +499,9 @@ sub set_mode {
     #$self->colour_cells();
 
     # Update legend
+    foreach my $mark (@{$self->{marks}{current}}) {
+        $mark->hide;
+    }
     if ($self->{legend}) { # && $self->{width_px} && $self->{height_px}) {
         $self->{legend} = $self->make_rect();
         $self->reposition($self->{width_px}, $self->{height_px});  #  trigger a redisplay of the legend
@@ -951,8 +954,11 @@ sub set_min_max {
                 );
 
     # Set legend textbox markers
+    foreach my $mark (@{$self->{marks}{current} // []}) {
+        $mark->hide;
+    }
     my @mark_arr = @{$self->{marks}{default}};
-    $self->{marks}{current} = \@mark_arr;
+    $self->{marks}{current} = $self->{marks}{default};
     my $marker_step = ($max - $min) / $#mark_arr;
     foreach my $i (0..$#mark_arr) {
         my $val = $min + $i * $marker_step;
@@ -1215,7 +1221,7 @@ sub set_canape_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{canape_mode};
     $self->{canape_mode} = 0;
-    foreach my $mark (@{$self->{marks}{canape}}) {
+    foreach my $mark (@{$self->{marks}{current}}) {
         $mark->hide;
     }
     if ($prev_val) {  #  give back our colours
@@ -1255,7 +1261,7 @@ sub set_zscore_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{zscore_mode};
     $self->{zscore_mode} = 0;
-    foreach my $mark (@{$self->{marks}{zscore}}) {
+    foreach my $mark (@{$self->{marks}{current}}) {
         $mark->hide;
     }
     if ($prev_val) {  #  give back our colours
@@ -1295,7 +1301,7 @@ sub set_divergent_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{divergent_mode};
     $self->{divergent_mode} = 0;
-    foreach my $mark (@{$self->{marks}{divergent}}) {
+    foreach my $mark (@{$self->{marks}{current}}) {
         $mark->hide;
     }
     if ($prev_val) {  #  give back our colours
@@ -1335,7 +1341,7 @@ sub set_ratio_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{ratio_mode};
     $self->{ratio_mode} = 0;
-    foreach my $mark (@{$self->{marks}{ratio}}) {
+    foreach my $mark (@{$self->{marks}{current}}) {
         $mark->hide;
     }
     if ($prev_val) {  #  give back our colours
@@ -1375,7 +1381,7 @@ sub set_prank_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{prank_mode};
     $self->{prank_mode} = 0;
-    foreach my $mark (@{$self->{marks}{prank}}) {
+    foreach my $mark (@{$self->{marks}{current}}) {
         $mark->hide;
     }
     if ($prev_val) {  #  give back our colours

From 49a60ce6f6defe4ca4e509d2ec89828809a6dae6 Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Fri, 22 Dec 2023 13:51:43 +1100
Subject: [PATCH 08/19] GUI legends: refactor mark hiding and legend refresh

---
 lib/Biodiverse/GUI/Legend.pm | 80 ++++++++++++++++--------------------
 1 file changed, 36 insertions(+), 44 deletions(-)

diff --git a/lib/Biodiverse/GUI/Legend.pm b/lib/Biodiverse/GUI/Legend.pm
index b2de72cb9..0b36c0c61 100644
--- a/lib/Biodiverse/GUI/Legend.pm
+++ b/lib/Biodiverse/GUI/Legend.pm
@@ -367,6 +367,15 @@ sub make_mark {
     return $mark;
 }
 
+sub hide_current_marks {
+    my $self = shift;
+    my $marks = $self->{marks}{current} // [];
+    foreach my $mark (@$marks) {
+        $mark->hide;
+    }
+    return;
+}
+
 sub set_gt_flag {
     my $self = shift;
     my $flag = shift;
@@ -396,6 +405,14 @@ sub get_height {
     return $self->{back_rect_height} // LEGEND_HEIGHT;
 }
 
+sub refresh_legend {
+    my $self = shift;
+    $self->make_rect;
+    #  trigger a redisplay of the legend
+    $self->reposition($self->{width_px}, $self->{height_px});
+    1;
+}
+
 # Updates position of legend and value box
 # when canvas is resized or scrolled
 sub reposition {
@@ -499,9 +516,8 @@ sub set_mode {
     #$self->colour_cells();
 
     # Update legend
-    foreach my $mark (@{$self->{marks}{current}}) {
-        $mark->hide;
-    }
+    $self->hide_current_marks;
+    #  could use refresh_legend here?
     if ($self->{legend}) { # && $self->{width_px} && $self->{height_px}) {
         $self->{legend} = $self->make_rect();
         $self->reposition($self->{width_px}, $self->{height_px});  #  trigger a redisplay of the legend
@@ -954,9 +970,7 @@ sub set_min_max {
                 );
 
     # Set legend textbox markers
-    foreach my $mark (@{$self->{marks}{current} // []}) {
-        $mark->hide;
-    }
+    $self->hide_current_marks;
     my @mark_arr = @{$self->{marks}{default}};
     $self->{marks}{current} = $self->{marks}{default};
     my $marker_step = ($max - $min) / $#mark_arr;
@@ -1106,9 +1120,7 @@ sub set_text_marks_for_labels {
 
     $self->{marks}{current} //= $self->{marks}{default};
 
-    foreach my $mark (@{$self->{marks}{current}}) {
-        $mark->hide;
-    }
+    $self->hide_current_marks;
 
     if (!@$mark_arr) {
         foreach my $i (0 .. $#strings) {
@@ -1211,8 +1223,7 @@ sub set_canape_mode_on {
     my $prev_val = $self->{canape_mode};
     $self->{canape_mode} = 1;
     if (!$prev_val) {  #  update legend colours
-        $self->make_rect;
-        $self->reposition($self->{width_px}, $self->{height_px})  #  trigger a redisplay of the legend
+        $self->refresh_legend;
     }
     return 1;
 }
@@ -1221,12 +1232,9 @@ sub set_canape_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{canape_mode};
     $self->{canape_mode} = 0;
-    foreach my $mark (@{$self->{marks}{current}}) {
-        $mark->hide;
-    }
+    $self->hide_current_marks;
     if ($prev_val) {  #  give back our colours
-        $self->make_rect;
-        $self->reposition($self->{width_px}, $self->{height_px})  #  trigger a redisplay of the legend
+        $self->refresh_legend;
     }
     return 0;
 }
@@ -1251,8 +1259,7 @@ sub set_zscore_mode_on {
     my $prev_val = $self->{zscore_mode};
     $self->{zscore_mode} = 1;
     if (!$prev_val) {  #  update legend colours
-        $self->make_rect;
-        $self->reposition($self->{width_px}, $self->{height_px});  #  trigger a redisplay of the legend
+        $self->refresh_legend;
     }
     return 1;
 }
@@ -1261,12 +1268,9 @@ sub set_zscore_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{zscore_mode};
     $self->{zscore_mode} = 0;
-    foreach my $mark (@{$self->{marks}{current}}) {
-        $mark->hide;
-    }
+    $self->hide_current_marks;
     if ($prev_val) {  #  give back our colours
-        $self->make_rect;
-        $self->reposition($self->{width_px}, $self->{height_px})  #  trigger a redisplay of the legend
+        $self->refresh_legend;
     }
     return 0;
 }
@@ -1291,8 +1295,7 @@ sub set_divergent_mode_on {
     my $prev_val = $self->{divergent_mode};
     $self->{divergent_mode} = 1;
     if (!$prev_val) {  #  update legend colours
-        $self->make_rect;
-        $self->reposition($self->{width_px}, $self->{height_px});  #  trigger a redisplay of the legend
+        $self->refresh_legend;
     }
     return 1;
 }
@@ -1301,12 +1304,9 @@ sub set_divergent_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{divergent_mode};
     $self->{divergent_mode} = 0;
-    foreach my $mark (@{$self->{marks}{current}}) {
-        $mark->hide;
-    }
+    $self->hide_current_marks;
     if ($prev_val) {  #  give back our colours
-        $self->make_rect;
-        $self->reposition($self->{width_px}, $self->{height_px})  #  trigger a redisplay of the legend
+        $self->refresh_legend;
     }
     return 0;
 }
@@ -1331,8 +1331,7 @@ sub set_ratio_mode_on {
     my $prev_val = $self->{ratio_mode};
     $self->{ratio_mode} = 1;
     if (!$prev_val) {  #  update legend colours
-        $self->make_rect;
-        $self->reposition($self->{width_px}, $self->{height_px});  #  trigger a redisplay of the legend
+        $self->refresh_legend;
     }
     return 1;
 }
@@ -1341,12 +1340,9 @@ sub set_ratio_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{ratio_mode};
     $self->{ratio_mode} = 0;
-    foreach my $mark (@{$self->{marks}{current}}) {
-        $mark->hide;
-    }
+    $self->hide_current_marks;
     if ($prev_val) {  #  give back our colours
-        $self->make_rect;
-        $self->reposition($self->{width_px}, $self->{height_px})  #  trigger a redisplay of the legend
+        $self->refresh_legend;
     }
     return 0;
 }
@@ -1371,8 +1367,7 @@ sub set_prank_mode_on {
     my $prev_val = $self->{prank_mode};
     $self->{prank_mode} = 1;
     if (!$prev_val) {  #  update legend colours
-        $self->make_rect;
-        $self->reposition($self->{width_px}, $self->{height_px});  #  trigger a redisplay of the legend
+        $self->refresh_legend;
     }
     return 1;
 }
@@ -1381,12 +1376,9 @@ sub set_prank_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{prank_mode};
     $self->{prank_mode} = 0;
-    foreach my $mark (@{$self->{marks}{current}}) {
-        $mark->hide;
-    }
+    $self->hide_current_marks;
     if ($prev_val) {  #  give back our colours
-        $self->make_rect;
-        $self->reposition($self->{width_px}, $self->{height_px})  #  trigger a redisplay of the legend
+        $self->refresh_legend;
     }
     return 0;
 }

From f38c5ad8ec1c15a31dee36880acf7a4340f98b88 Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Fri, 22 Dec 2023 14:00:23 +1100
Subject: [PATCH 09/19] GUI legends: generate mark arrays as needed

This greatly simplifies the code.
---
 lib/Biodiverse/GUI/Legend.pm | 42 +++++++++++-------------------------
 1 file changed, 12 insertions(+), 30 deletions(-)

diff --git a/lib/Biodiverse/GUI/Legend.pm b/lib/Biodiverse/GUI/Legend.pm
index 0b36c0c61..dc47a500c 100644
--- a/lib/Biodiverse/GUI/Legend.pm
+++ b/lib/Biodiverse/GUI/Legend.pm
@@ -111,26 +111,7 @@ sub new {
     foreach my $i (reverse 0..3) {
         $self->{marks}{default}[$i] = $self->make_mark($self->{legend_marks}[$i]);
     }
-    #  clunky that we need to do it here
-    my @anchors = ('nw', ('w') x 3, 'sw');
-    foreach my $i (reverse 0..4) {
-        $self->{marks}{canape}[$i]    = $self->make_mark($anchors[$i]);
-        $self->{marks}{divergent}[$i] = $self->make_mark($anchors[$i]);
-        $self->{marks}{ratio}[$i]     = $self->make_mark($anchors[$i]);
-    }
-    @anchors = ('nw', ('w') x 5, 'sw');
-    foreach my $i (reverse 0..6) {
-        $self->{marks}{zscore}[$i] = $self->make_mark($anchors[$i]);
-        $self->{marks}{prank}[$i]  = $self->make_mark($anchors[$i]);
-    }
     $self->{marks}{current} = $self->{marks}{default};
-    #  generic
-    # foreach my $n (2..7) {
-    #     @anchors = ('nw', ('w') x $n-1, 'sw');
-    #     foreach my $i (reverse 0 .. $n) {
-    #         $self->{marks}{$n+1}[$i] = $self->make_mark($anchors[$i]);
-    #     }
-    # }
 
     #  debug stuff
     #my $sub = sub {
@@ -1018,14 +999,14 @@ sub set_text_marks_canape {
     my $self = shift;
 
     my @strings = qw /super mixed palaeo neo non-sig/;
-    return $self->set_text_marks_for_labels (\@strings, $self->{marks}{canape});
+    return $self->set_text_marks_for_labels (\@strings);
 }
 
 sub set_text_marks_zscore {
     my $self = shift;
 
     my @strings = ('<-2.58', '[-2.58,-1.96)', '[-1.96,-1.65)', '[-1.65,1.65]', '(1.65,1.96]', '(1.96,2.58]', '>2.58');
-    return $self->set_text_marks_for_labels (\@strings, $self->{marks}{zscore});
+    return $self->set_text_marks_for_labels (\@strings);
 }
 
 #  refactor needed
@@ -1065,7 +1046,7 @@ sub set_text_marks_divergent {
     }
     # say join ' ', @strings;
 
-    $self->set_text_marks_for_labels (\@strings, $self->{marks}{divergent});
+    $self->set_text_marks_for_labels (\@strings);
 }
 
 sub set_text_marks_ratio {
@@ -1097,13 +1078,13 @@ sub set_text_marks_ratio {
         $strings[-1] = ">=$strings[-1]";
     }
 
-    $self->set_text_marks_for_labels (\@strings, $self->{marks}{ratio});
+    $self->set_text_marks_for_labels (\@strings);
 }
 
 sub set_text_marks_prank {
     my $self = shift;
     my @strings = ('<0.01', '<0.025', '<0.05', '[0.05,0.95]', '>0.95', '>0.975', '>0.99');
-    $self->set_text_marks_for_labels (\@strings, $self->{marks}{prank});
+    $self->set_text_marks_for_labels (\@strings);
 }
 
 #  generalises z-score version - need to simplify it
@@ -1115,17 +1096,18 @@ sub set_text_marks_for_labels {
 
     $mark_arr //= [];
 
-    carp "Mark count does not match label count"
-        if scalar(@strings) != scalar @$mark_arr;
-
     $self->{marks}{current} //= $self->{marks}{default};
 
     $self->hide_current_marks;
 
     if (!@$mark_arr) {
-        foreach my $i (0 .. $#strings) {
-            my $anchor_loc = $i == 0 ? 'nw' : $i == $#strings ? 'sw' : 'w';
-            $mark_arr->[$i] = $self->make_mark($anchor_loc);
+        my $n = scalar @strings;
+        $mark_arr = $self->{marks}{$n} //= [];
+        if (!@$mark_arr) {  #  populate if needed
+            foreach my $i (0 .. $#strings) {
+                my $anchor_loc = $i == 0 ? 'nw' : $i == $#strings ? 'sw' : 'w';
+                $mark_arr->[$i] = $self->make_mark($anchor_loc);
+            }
         }
     }
 

From 900fc5be79aec82cc8405155a8dca6b9f619c545 Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Fri, 22 Dec 2023 14:12:05 +1100
Subject: [PATCH 10/19] GUI legends: Start using factory generation of some
 methods

---
 lib/Biodiverse/GUI/Legend.pm | 43 +++++++++++++++++++-----------------
 1 file changed, 23 insertions(+), 20 deletions(-)

diff --git a/lib/Biodiverse/GUI/Legend.pm b/lib/Biodiverse/GUI/Legend.pm
index dc47a500c..aebf5c66b 100644
--- a/lib/Biodiverse/GUI/Legend.pm
+++ b/lib/Biodiverse/GUI/Legend.pm
@@ -1200,6 +1200,29 @@ sub get_colour_method {
     return $method;
 }
 
+#  a few factory methods
+sub _make_nonbasic_methods {
+    my ($pkg) = shift || __PACKAGE__;
+    my @methods = _get_nonbasic_plot_modes();
+    print "Calling _make_access_methods for $pkg";
+    no strict 'refs';
+    foreach my $key (@methods) {
+        my $method = "get_${key}_mode";
+        # next if $pkg->can($method);  #  do not override
+        say STDERR "==== Building $method in package $pkg";
+        *{"${pkg}::${method}"} =
+            do {
+                sub {
+                    $_[0]->{"${key}_mode"};
+                };
+            };
+    }
+
+    return;
+}
+
+_make_nonbasic_methods();
+
 sub set_canape_mode_on {
     my ($self) = @_;
     my $prev_val = $self->{canape_mode};
@@ -1221,10 +1244,6 @@ sub set_canape_mode_off {
     return 0;
 }
 
-sub get_canape_mode {
-    $_[0]->{canape_mode};
-}
-
 sub set_canape_mode {
     my ($self, $bool) = @_;
     if ($bool) {
@@ -1257,10 +1276,6 @@ sub set_zscore_mode_off {
     return 0;
 }
 
-sub get_zscore_mode {
-    $_[0]->{zscore_mode};
-}
-
 sub set_zscore_mode {
     my ($self, $bool) = @_;
     if ($bool) {
@@ -1293,10 +1308,6 @@ sub set_divergent_mode_off {
     return 0;
 }
 
-sub get_divergent_mode {
-    $_[0]->{divergent_mode};
-}
-
 sub set_divergent_mode {
     my ($self, $bool) = @_;
     if ($bool) {
@@ -1329,10 +1340,6 @@ sub set_ratio_mode_off {
     return 0;
 }
 
-sub get_ratio_mode {
-    $_[0]->{ratio_mode};
-}
-
 sub set_ratio_mode {
     my ($self, $bool) = @_;
     if ($bool) {
@@ -1365,10 +1372,6 @@ sub set_prank_mode_off {
     return 0;
 }
 
-sub get_prank_mode {
-    $_[0]->{prank_mode};
-}
-
 sub set_prank_mode {
     my ($self, $bool) = @_;
     if ($bool) {

From 6ec73774eda0b752ab9e5f7b6bb89168a0ab0515 Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Fri, 22 Dec 2023 14:17:04 +1100
Subject: [PATCH 11/19] GUI legend: factory generation of *mode_on methods

---
 lib/Biodiverse/GUI/Legend.pm | 69 +++++++++---------------------------
 1 file changed, 17 insertions(+), 52 deletions(-)

diff --git a/lib/Biodiverse/GUI/Legend.pm b/lib/Biodiverse/GUI/Legend.pm
index aebf5c66b..906761d38 100644
--- a/lib/Biodiverse/GUI/Legend.pm
+++ b/lib/Biodiverse/GUI/Legend.pm
@@ -1207,15 +1207,30 @@ sub _make_nonbasic_methods {
     print "Calling _make_access_methods for $pkg";
     no strict 'refs';
     foreach my $key (@methods) {
-        my $method = "get_${key}_mode";
+        my $method   = "get_${key}_mode";
+        my $mode_key = "${key}_mode";
         # next if $pkg->can($method);  #  do not override
+        *{"${pkg}::${method}"} =
+            do {
+                sub {
+                    $_[0]->{$mode_key};
+                };
+            };
+        $method = "set_${key}_mode_on";
         say STDERR "==== Building $method in package $pkg";
         *{"${pkg}::${method}"} =
             do {
                 sub {
-                    $_[0]->{"${key}_mode"};
+                    my ($self) = @_;
+                    my $prev_val = $self->{$mode_key};
+                    $self->{$mode_key} = 1;
+                    if (!$prev_val) {  #  update legend colours
+                        $self->refresh_legend;
+                    }
+                    return 1;
                 };
             };
+
     }
 
     return;
@@ -1223,16 +1238,6 @@ sub _make_nonbasic_methods {
 
 _make_nonbasic_methods();
 
-sub set_canape_mode_on {
-    my ($self) = @_;
-    my $prev_val = $self->{canape_mode};
-    $self->{canape_mode} = 1;
-    if (!$prev_val) {  #  update legend colours
-        $self->refresh_legend;
-    }
-    return 1;
-}
-
 sub set_canape_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{canape_mode};
@@ -1255,16 +1260,6 @@ sub set_canape_mode {
     return $self->{canape_mode};
 }
 
-sub set_zscore_mode_on {
-    my ($self) = @_;
-    my $prev_val = $self->{zscore_mode};
-    $self->{zscore_mode} = 1;
-    if (!$prev_val) {  #  update legend colours
-        $self->refresh_legend;
-    }
-    return 1;
-}
-
 sub set_zscore_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{zscore_mode};
@@ -1287,16 +1282,6 @@ sub set_zscore_mode {
     return $self->{zscore_mode};
 }
 
-sub set_divergent_mode_on {
-    my ($self) = @_;
-    my $prev_val = $self->{divergent_mode};
-    $self->{divergent_mode} = 1;
-    if (!$prev_val) {  #  update legend colours
-        $self->refresh_legend;
-    }
-    return 1;
-}
-
 sub set_divergent_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{divergent_mode};
@@ -1319,16 +1304,6 @@ sub set_divergent_mode {
     return $self->{divergent_mode};
 }
 
-sub set_ratio_mode_on {
-    my ($self) = @_;
-    my $prev_val = $self->{ratio_mode};
-    $self->{ratio_mode} = 1;
-    if (!$prev_val) {  #  update legend colours
-        $self->refresh_legend;
-    }
-    return 1;
-}
-
 sub set_ratio_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{ratio_mode};
@@ -1351,16 +1326,6 @@ sub set_ratio_mode {
     return $self->{ratio_mode};
 }
 
-sub set_prank_mode_on {
-    my ($self) = @_;
-    my $prev_val = $self->{prank_mode};
-    $self->{prank_mode} = 1;
-    if (!$prev_val) {  #  update legend colours
-        $self->refresh_legend;
-    }
-    return 1;
-}
-
 sub set_prank_mode_off {
     my ($self) = @_;
     my $prev_val = $self->{prank_mode};

From 6f6ce14de5577a91a1e806557d01dec1072fcfb0 Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Fri, 22 Dec 2023 14:20:06 +1100
Subject: [PATCH 12/19] GUI legend: factory generation of *mode_off methods

---
 lib/Biodiverse/GUI/Legend.pm | 72 ++++++++----------------------------
 1 file changed, 16 insertions(+), 56 deletions(-)

diff --git a/lib/Biodiverse/GUI/Legend.pm b/lib/Biodiverse/GUI/Legend.pm
index 906761d38..91c4faf42 100644
--- a/lib/Biodiverse/GUI/Legend.pm
+++ b/lib/Biodiverse/GUI/Legend.pm
@@ -1217,7 +1217,7 @@ sub _make_nonbasic_methods {
                 };
             };
         $method = "set_${key}_mode_on";
-        say STDERR "==== Building $method in package $pkg";
+        # say STDERR "==== Building $method in package $pkg";
         *{"${pkg}::${method}"} =
             do {
                 sub {
@@ -1230,6 +1230,21 @@ sub _make_nonbasic_methods {
                     return 1;
                 };
             };
+        $method = "set_${key}_mode_off";
+        say STDERR "==== Building $method in package $pkg";
+        *{"${pkg}::${method}"} =
+            do {
+                sub {
+                    my ($self) = @_;
+                    my $prev_val = $self->{$mode_key};
+                    $self->{$mode_key} = 0;
+                    $self->hide_current_marks;
+                    if ($prev_val) {  #  give back our colours
+                        $self->refresh_legend;
+                    }
+                    return 0;
+                };
+            };
 
     }
 
@@ -1238,17 +1253,6 @@ sub _make_nonbasic_methods {
 
 _make_nonbasic_methods();
 
-sub set_canape_mode_off {
-    my ($self) = @_;
-    my $prev_val = $self->{canape_mode};
-    $self->{canape_mode} = 0;
-    $self->hide_current_marks;
-    if ($prev_val) {  #  give back our colours
-        $self->refresh_legend;
-    }
-    return 0;
-}
-
 sub set_canape_mode {
     my ($self, $bool) = @_;
     if ($bool) {
@@ -1260,17 +1264,6 @@ sub set_canape_mode {
     return $self->{canape_mode};
 }
 
-sub set_zscore_mode_off {
-    my ($self) = @_;
-    my $prev_val = $self->{zscore_mode};
-    $self->{zscore_mode} = 0;
-    $self->hide_current_marks;
-    if ($prev_val) {  #  give back our colours
-        $self->refresh_legend;
-    }
-    return 0;
-}
-
 sub set_zscore_mode {
     my ($self, $bool) = @_;
     if ($bool) {
@@ -1282,17 +1275,6 @@ sub set_zscore_mode {
     return $self->{zscore_mode};
 }
 
-sub set_divergent_mode_off {
-    my ($self) = @_;
-    my $prev_val = $self->{divergent_mode};
-    $self->{divergent_mode} = 0;
-    $self->hide_current_marks;
-    if ($prev_val) {  #  give back our colours
-        $self->refresh_legend;
-    }
-    return 0;
-}
-
 sub set_divergent_mode {
     my ($self, $bool) = @_;
     if ($bool) {
@@ -1304,17 +1286,6 @@ sub set_divergent_mode {
     return $self->{divergent_mode};
 }
 
-sub set_ratio_mode_off {
-    my ($self) = @_;
-    my $prev_val = $self->{ratio_mode};
-    $self->{ratio_mode} = 0;
-    $self->hide_current_marks;
-    if ($prev_val) {  #  give back our colours
-        $self->refresh_legend;
-    }
-    return 0;
-}
-
 sub set_ratio_mode {
     my ($self, $bool) = @_;
     if ($bool) {
@@ -1326,17 +1297,6 @@ sub set_ratio_mode {
     return $self->{ratio_mode};
 }
 
-sub set_prank_mode_off {
-    my ($self) = @_;
-    my $prev_val = $self->{prank_mode};
-    $self->{prank_mode} = 0;
-    $self->hide_current_marks;
-    if ($prev_val) {  #  give back our colours
-        $self->refresh_legend;
-    }
-    return 0;
-}
-
 sub set_prank_mode {
     my ($self, $bool) = @_;
     if ($bool) {

From 0239cb6d288a7e42e09a6fb19737aaddcc8b4221 Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Fri, 22 Dec 2023 14:26:48 +1100
Subject: [PATCH 13/19] GUI legend: factory generation of *mode methods

---
 lib/Biodiverse/GUI/Legend.pm | 72 +++++++-----------------------------
 1 file changed, 14 insertions(+), 58 deletions(-)

diff --git a/lib/Biodiverse/GUI/Legend.pm b/lib/Biodiverse/GUI/Legend.pm
index 91c4faf42..8485d2bcd 100644
--- a/lib/Biodiverse/GUI/Legend.pm
+++ b/lib/Biodiverse/GUI/Legend.pm
@@ -1231,7 +1231,7 @@ sub _make_nonbasic_methods {
                 };
             };
         $method = "set_${key}_mode_off";
-        say STDERR "==== Building $method in package $pkg";
+        # say STDERR "==== Building $method in package $pkg";
         *{"${pkg}::${method}"} =
             do {
                 sub {
@@ -1245,7 +1245,19 @@ sub _make_nonbasic_methods {
                     return 0;
                 };
             };
-
+        $method = "set_${key}_mode";
+        my $mode_off_method = "set_${key}_mode_off";
+        my $mode_on_method  = "set_${key}_mode_on";
+        # say STDERR "==== Building $method in package $pkg";
+        *{"${pkg}::${method}"} =
+            do {
+                sub {
+                    my ($self, $bool) = @_;
+                    my $method_name = $bool ? $mode_on_method : $mode_off_method;
+                    $self->$method_name;
+                    return $self->{$mode_key};
+                };
+            };
     }
 
     return;
@@ -1253,62 +1265,6 @@ sub _make_nonbasic_methods {
 
 _make_nonbasic_methods();
 
-sub set_canape_mode {
-    my ($self, $bool) = @_;
-    if ($bool) {
-        $self->set_canape_mode_on;
-    }
-    else {
-        $self->set_canape_mode_off;
-    }
-    return $self->{canape_mode};
-}
-
-sub set_zscore_mode {
-    my ($self, $bool) = @_;
-    if ($bool) {
-        $self->set_zscore_mode_on;
-    }
-    else {
-        $self->set_zscore_mode_off;
-    }
-    return $self->{zscore_mode};
-}
-
-sub set_divergent_mode {
-    my ($self, $bool) = @_;
-    if ($bool) {
-        $self->set_divergent_mode_on;
-    }
-    else {
-        $self->set_divergent_mode_off;
-    }
-    return $self->{divergent_mode};
-}
-
-sub set_ratio_mode {
-    my ($self, $bool) = @_;
-    if ($bool) {
-        $self->set_ratio_mode_on;
-    }
-    else {
-        $self->set_ratio_mode_off;
-    }
-    return $self->{ratio_mode};
-}
-
-sub set_prank_mode {
-    my ($self, $bool) = @_;
-    if ($bool) {
-        $self->set_prank_mode_on;
-    }
-    else {
-        $self->set_prank_mode_off;
-    }
-    return $self->{prank_mode};
-}
-
-
 
 #  dup from Tab.pm - need to inherit from single source
 sub format_number_for_display {

From d43b22eea81eacc574126e034b98ddb38d6b6177 Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Fri, 22 Dec 2023 16:27:25 +1100
Subject: [PATCH 14/19] Indices: more support for categorical indices

---
 lib/Biodiverse/Indices.pm | 58 ++++++++++++++++++++++++++++++++++++++-
 1 file changed, 57 insertions(+), 1 deletion(-)

diff --git a/lib/Biodiverse/Indices.pm b/lib/Biodiverse/Indices.pm
index 358da0309..0bb39e570 100644
--- a/lib/Biodiverse/Indices.pm
+++ b/lib/Biodiverse/Indices.pm
@@ -1275,6 +1275,24 @@ sub get_valid_region_grower_indices {
     return wantarray ? %indices : \%indices;
 }
 
+sub get_categorical_indices {
+    my $self = shift;
+    my %args = @_;
+    my $list = $args{calculations} || $self->get_calculations_as_flat_hash;
+
+    my %indices;
+    foreach my $calculations ( keys %$list ) {
+        my $meta = $self->get_metadata( sub => $calculations );
+        INDEX:
+        foreach my $index ( keys %{ $meta->get_indices } ) {
+            next INDEX if !$meta->get_index_is_categorical($index);
+            $indices{$index} = $meta->get_index_description($index);
+        }
+    }
+
+    return wantarray ? %indices : \%indices;
+}
+
 sub get_list_indices {
     my $self = shift;
     my %args = @_;
@@ -1298,13 +1316,27 @@ sub index_is_list {
     my %args = @_;
 
     croak 'argument index not defined'
-      if !defined $args{index};
+        if !defined $args{index};
 
     my $hash = $self->get_list_indices;
 
     return $hash->{$args{index} // ''};
 }
 
+sub index_is_categorical {
+    my $self = shift;
+    my %args = @_;
+
+    croak 'argument index not defined'
+        if !defined $args{index};
+
+    my $hash = $self->get_categorical_indices;
+
+    return $hash->{$args{index} // ''};
+}
+
+
+
 #  almost identical to get_list_indices except the "next INDEX" condition
 sub get_scalar_indices {
     my $self = shift;
@@ -1431,6 +1463,30 @@ sub get_index_bounds {
     return $bounds;
 }
 
+sub get_index_category_colours {
+    my ($self, %args) = @_;
+    my $index = $args{index};
+
+    my $index_source = $self->get_index_source(index => $index);
+    my $meta = $self->get_metadata( sub => $index_source );
+
+    my $result = $meta->get_index_category_colours ($index);
+
+    return $result;
+}
+
+sub get_index_category_labels {
+    my ($self, %args) = @_;
+    my $index = $args{index};
+
+    my $index_source = $self->get_index_source(index => $index);
+    my $meta = $self->get_metadata( sub => $index_source );
+
+    my $result = $meta->get_index_category_labels ($index);
+
+    return $result;
+}
+
 sub index_distribution_is_valid {
     my $self = shift;
     my %args = @_;

From c5af263f4e4b0d50fc37026320aeb02d92d4221b Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Fri, 22 Dec 2023 16:27:47 +1100
Subject: [PATCH 15/19] GUI: plot categorical indices

---
 lib/Biodiverse/GUI/Legend.pm       | 64 ++++++++++++++++++++++++++----
 lib/Biodiverse/Metadata/Indices.pm | 31 ++++++++++++++-
 2 files changed, 87 insertions(+), 8 deletions(-)

diff --git a/lib/Biodiverse/GUI/Legend.pm b/lib/Biodiverse/GUI/Legend.pm
index 8485d2bcd..66ef4b26f 100644
--- a/lib/Biodiverse/GUI/Legend.pm
+++ b/lib/Biodiverse/GUI/Legend.pm
@@ -192,6 +192,19 @@ sub make_rect {
             $self->add_row($self->{legend_colours_group}, $row, $colour);
         }
     }
+    elsif ($self->get_categorical_mode) {
+        ($width, $height) = ($self->get_width, 255);
+        $self->{legend_height} = $height;
+        my $label_hash = $self->{categorical}{labels};
+
+        my $n = (scalar keys %$label_hash) - 1;
+        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);
+            $self->add_row($self->{legend_colours_group}, $row, $colour);
+        }
+    }
     elsif ($self->get_zscore_mode) {
 
         ($width, $height) = ($self->get_width, 255);
@@ -605,6 +618,17 @@ sub get_colour {
     return $self->$method($val, $min, $max);
 }
 
+sub get_colour_categorical {
+    my ($self, $val) = @_;
+    $val //= -1;  #  avoid undef key warnings
+    my $colour_hash = $self->{categorical}{colours} //= {};
+    my $colour = $colour_hash->{$val} || COLOUR_WHITE;
+    #  should not need to do this
+    if (!blessed $colour) {
+        $colour = $colour_hash->{$val} = Gtk2::Gdk::Color->parse($colour);
+    }
+    return $colour;
+}
 
 sub get_colour_canape {
     my ($self, $val) = @_;
@@ -925,6 +949,9 @@ sub set_min_max {
     return $self->set_text_marks_canape
         if $self->get_canape_mode;
 
+    return $self->set_text_marks_categorical
+        if $self->get_categorical_mode;
+
     if ($self->get_divergent_mode) {
         my $abs_extreme = max(abs $val1, abs $val2);
         my $min = 0;
@@ -1002,6 +1029,15 @@ sub set_text_marks_canape {
     return $self->set_text_marks_for_labels (\@strings);
 }
 
+sub set_text_marks_categorical {
+    my $self = shift;
+
+    my $label_hash = $self->{categorical}{labels} // {};
+    my @strings = @$label_hash{sort {$a <=> $b} keys %$label_hash};
+
+    return $self->set_text_marks_for_labels (\@strings);
+}
+
 sub set_text_marks_zscore {
     my $self = shift;
 
@@ -1141,7 +1177,7 @@ sub get_log_mode {
 
 #  need a better name
 sub _get_nonbasic_plot_modes {
-    my @modes = qw/canape zscore prank ratio divergent/;
+    my @modes = qw/canape zscore prank ratio divergent categorical/;
     return wantarray ? @modes : \@modes;
 }
 
@@ -1165,21 +1201,35 @@ sub set_colour_mode_from_list_and_index {
     }
 
     #  check list name then index name
+    my %h = (index => $index);
     my $mode
-        = $list =~ />>z_scores>>/                               ? 'zscore'
-        : $list =~ />>p_rank>>/                                 ? 'prank'
-        : $list =~ />>CANAPE>>/ && $index =~ /^CANAPE/          ? 'canape'
-        : $indices_object->index_is_zscore (index => $index)    ? 'zscore'
-        : $indices_object->index_is_ratio (index => $index)     ? 'ratio'
-        : $indices_object->index_is_divergent (index => $index) ? 'divergent'
+        = $list =~ />>z_scores>>/                      ? 'zscore'
+        : $list =~ />>p_rank>>/                        ? 'prank'
+        : $list =~ />>CANAPE>>/ && $index =~ /^CANAPE/ ? 'canape'
+        : $indices_object->index_is_zscore (%h)        ? 'zscore'
+        : $indices_object->index_is_ratio (%h)         ? 'ratio'
+        : $indices_object->index_is_divergent (%h)     ? 'divergent'
+        : $indices_object->index_is_categorical (%h)   ? 'categorical'
         : '';
 
     #  clunky to have to iterate over these but they trigger things turning off
+    #  Update - might not be the case now but process does not take long
     foreach my $possmode (_get_nonbasic_plot_modes()) {
         my $method = "set_${possmode}_mode";
         $self->$method ($mode eq $possmode);
     }
 
+    if ($mode eq 'categorical') {
+        my $labels  = $indices_object->get_index_category_labels (index => $index) // {};
+        my $colours = $indices_object->get_index_category_colours (index => $index) // {};
+        $self->{categorical}{labels}  = $labels;
+        foreach my $key (keys %$colours) {
+            my $colour = $colours->{$key};
+            $colours->{$key} => Gtk2::Gdk::Color->parse($colour);
+        }
+        $self->{categorical}{colours} = $colours;
+    }
+
     return;
 }
 
diff --git a/lib/Biodiverse/Metadata/Indices.pm b/lib/Biodiverse/Metadata/Indices.pm
index dcab5ac17..611049dc8 100644
--- a/lib/Biodiverse/Metadata/Indices.pm
+++ b/lib/Biodiverse/Metadata/Indices.pm
@@ -219,7 +219,12 @@ sub index_distribution_is_valid {
 
 sub get_index_is_ratio {
     my ($self, $index) = @_;
-    return return $self->get_index_distribution($index) =~ /ratio$/;
+    return $self->get_index_distribution($index) =~ /ratio$/;
+}
+
+sub get_index_is_categorical {
+    my ($self, $index) = @_;
+    return $self->get_index_distribution($index) eq 'categorical';
 }
 
 sub get_index_is_nonnegative {
@@ -245,6 +250,30 @@ sub get_index_distribution {
     return $indices->{$index}{distribution} // $self->{distribution} // 'sequential';
 }
 
+sub get_index_category_labels {
+    my ($self, $index) = @_;
+
+    return if !$self->get_index_is_categorical($index);
+
+    no autovivification;
+
+    my $indices = $self->get_indices;
+    my $hash = $indices->{$index}{labels};
+    return wantarray ? %$hash : $hash;
+}
+
+sub get_index_category_colours {
+    my ($self, $index) = @_;
+
+    return if !$self->get_index_is_categorical($index);
+
+    no autovivification;
+
+    my $indices = $self->get_indices;
+    my $hash = $indices->{$index}{colours};
+    return wantarray ? %$hash : $hash;
+}
+
 __PACKAGE__->_make_distribution_methods (keys %valid_distributions);
 
 sub _make_distribution_methods {

From 4253f72f4e787045baa8a48c15499de2177b055f Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Fri, 22 Dec 2023 19:08:39 +1100
Subject: [PATCH 16/19] GUI legends: Colour the individual CANAPE indices as
 per the CANAPE_CODE

So NEO is red when 1, beige otherwise,
and so forth for the others.
---
 lib/Biodiverse/GUI/Legend.pm | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

diff --git a/lib/Biodiverse/GUI/Legend.pm b/lib/Biodiverse/GUI/Legend.pm
index 66ef4b26f..b0c6f1890 100644
--- a/lib/Biodiverse/GUI/Legend.pm
+++ b/lib/Biodiverse/GUI/Legend.pm
@@ -1229,6 +1229,23 @@ sub set_colour_mode_from_list_and_index {
         }
         $self->{categorical}{colours} = $colours;
     }
+    elsif (!$mode && $list =~ />>CANAPE>>/) {
+        #  special handling for CANAPE indices
+        my %codes = (
+            NEO => 1, PALAEO => 2, MIXED => 3, SUPER => 4,
+        );
+        #  special handling
+        my $colour = $canape_colour_hash{$codes{$index} // 0};
+        $self->{categorical}{colours} = {
+            0 => $canape_colour_hash{0},
+            1 => $colour,
+        };
+        $self->{categorical}{labels} = {
+            0 => 'other',
+            1 => lc $index,
+        };
+        $self->set_categorical_mode(1);
+    }
 
     return;
 }

From 686a50af502225fffd307b8b637f83828f392229 Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Fri, 22 Dec 2023 19:12:09 +1100
Subject: [PATCH 17/19] GUI legends: Reverse CANAPE order

Now Super is at the top.
---
 lib/Biodiverse/GUI/Legend.pm | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/lib/Biodiverse/GUI/Legend.pm b/lib/Biodiverse/GUI/Legend.pm
index b0c6f1890..09c595c0d 100644
--- a/lib/Biodiverse/GUI/Legend.pm
+++ b/lib/Biodiverse/GUI/Legend.pm
@@ -187,7 +187,7 @@ sub make_rect {
 
         my $n = (scalar keys %canape_colour_hash) - 1;
         foreach my $row (0..($height - 1)) {
-            my $class = int (0.5 + $n * $row / ($height - 1));
+            my $class = $n - int (0.5 + $n * $row / ($height - 1));
             my $colour = $self->get_colour_canape ($class);
             $self->add_row($self->{legend_colours_group}, $row, $colour);
         }
@@ -1025,7 +1025,7 @@ sub set_min_max {
 sub set_text_marks_canape {
     my $self = shift;
 
-    my @strings = qw /super mixed palaeo neo non-sig/;
+    my @strings = reverse (qw /super mixed palaeo neo non-sig/);
     return $self->set_text_marks_for_labels (\@strings);
 }
 

From c972a9b9cd01245b820e833528a18d9b67a3f6dc Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Fri, 22 Dec 2023 19:19:21 +1100
Subject: [PATCH 18/19] Ignore more nytprof files

---
 .gitignore | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.gitignore b/.gitignore
index 2359847d9..f2cbbf418 100644
--- a/.gitignore
+++ b/.gitignore
@@ -21,3 +21,4 @@ biodiverse.iml
 /biodiverseb.iml
 /.idea
 /AGS_bin
+/etc/benchmark_scripts/nytprof

From be8babc6223193c90d6b215167605e9e8262fee0 Mon Sep 17 00:00:00 2001
From: shawnlaffan <shawnlaffan@gmail.com>
Date: Thu, 28 Dec 2023 21:36:56 +1100
Subject: [PATCH 19/19] Tests: Increase categorical index tests

---
 t/23-Indices.t | 23 ++++++++++++++++++-----
 1 file changed, 18 insertions(+), 5 deletions(-)

diff --git a/t/23-Indices.t b/t/23-Indices.t
index 79a1f5882..2b5865c64 100644
--- a/t/23-Indices.t
+++ b/t/23-Indices.t
@@ -5,6 +5,7 @@ use English qw { -no_match_vars };
 use Carp;
 
 use Test2::V0;
+use Test2::Tools::Compare qw/hash/;
 use rlib;
 
 local $| = 1;
@@ -245,10 +246,21 @@ sub test_index_bounds {
         my $index_source = $indices_object->get_index_source(index => $index);
         my $metadata = $indices_object->get_metadata( sub => $index_source );
         if ($metadata->get_index_is_categorical($index)) {
-            my $todo = todo('categorical needs tests');
-            like $bounds,
-                [ $RE_bound, $RE_bound ],
-                "Bounds for scalar index $index match expected pattern";
+            #  some of these structures still need to be finalised
+            is $bounds, undef,
+                "Bounds undefined for categorical index $index";
+            my $labels  = $indices_object->get_index_category_labels (index => $index);
+            is $labels, hash {
+                all_vals D();
+                etc()
+            }, "Categorical index $index: labels all defined";
+            my $colours = $indices_object->get_index_category_colours (index => $index) // {};
+            if (keys %$colours) {
+                is $colours, hash {
+                    all_vals D();
+                    etc()
+                }, "Categorical index $index: colours all defined";
+            }
         }
         else {
             like $bounds,
@@ -257,9 +269,10 @@ sub test_index_bounds {
             my $expected
                 = $metadata->get_index_is_unit_interval($index) ? [ 0, 1 ]
                 : $metadata->get_index_is_nonnegative($index) ? [ 0, 'Inf' ]
-                : $metadata->get_index_is_categorical($index) ? []
                 : [ '-Inf', 'Inf' ];
             is $bounds, $expected, "Bounds correct for $index";
+            my $labels  = $indices_object->get_index_category_labels (index => $index);
+            is $labels, undef, "No labels defined for continuous index $index";
         }
     }
 }