Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Add CANAPE super class #892

Merged
merged 2 commits into from
Dec 2, 2023
Merged

Add CANAPE super class #892

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
ffea075
Add the super category to CANAPE
shawnlaffan Dec 1, 2023
1c6452d
GUI: plot the CANAPE super category
shawnlaffan Dec 1, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 3 additions & 1 deletion lib/Biodiverse/Common.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2562,6 +2562,7 @@ sub assign_canape_codes_from_p_rank_results {
= $PE_sig_obs <= 0.95 && $PE_sig_alt <= 0.95 ? 0 # non-sig
: $RPE_sig < 0.025 ? 1 # neo
: $RPE_sig > 0.975 ? 2 # palaeo
: $PE_sig_obs > 0.99 && $PE_sig_alt > 0.99 ? 4 # super
: 3; # mixed
#say '';
}
Expand All @@ -2570,9 +2571,10 @@ sub assign_canape_codes_from_p_rank_results {
$results_list_ref->{NEO} = 0 + ($canape_code == 1);
$results_list_ref->{PALAEO} = 0 + ($canape_code == 2);
$results_list_ref->{MIXED} = 0 + ($canape_code == 3);
$results_list_ref->{SUPER} = 0 + ($canape_code == 4);
}
else { # clear any pre-existing values
@$results_list_ref{qw /NEO PALAEO MIXED/} = (undef) x 3;
@$results_list_ref{qw /NEO PALAEO MIXED SUPER/} = (undef) x 4;
}

return wantarray ? %$results_list_ref : $results_list_ref;
Expand Down
49 changes: 34 additions & 15 deletions lib/Biodiverse/GUI/Legend.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -48,6 +48,17 @@ use constant COLOUR_WHITE => Gtk2::Gdk::Color->new(255*257, 255*257, 255*
use constant DARKEST_GREY_FRAC => 0.2;
use constant LIGHTEST_GREY_FRAC => 0.8;


# refactor as state var inside sub when we require a perl version that
# supports state on lists (5.28)
my %canape_colour_hash = (
0 => Gtk2::Gdk::Color->parse('lightgoldenrodyellow'), # non-sig, lightgoldenrodyellow
1 => Gtk2::Gdk::Color->parse('red'), # red, neo
2 => Gtk2::Gdk::Color->parse('royalblue1'), # blue, palaeo
3 => Gtk2::Gdk::Color->parse('#CB7FFF'), # purple, mixed
4 => Gtk2::Gdk::Color->parse('darkorchid'), # deep purple, super ('#6A3d9A' is too dark)
);

##########################################################
# Construction
##########################################################
Expand Down Expand Up @@ -101,7 +112,11 @@ sub new {
$self->{marks}[$i] = $self->make_mark($self->{legend_marks}[$i]);
}
# clunky that we need to do it here
my @anchors = ('nw', ('w') x 5, 'sw');
my @anchors = ('nw', ('w') x 3, 'sw');
foreach my $i (reverse 0..4) {
$self->{canape_marks}[$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]);
Expand Down Expand Up @@ -179,8 +194,9 @@ sub make_rect {
($width, $height) = ($self->get_width, 255);
$self->{legend_height} = $height;

my $n = (scalar keys %canape_colour_hash) - 1;
foreach my $row (0..($height - 1)) {
my $class = int (0.5 + 3 * $row / ($height - 1));
my $class = int (0.5 + $n * $row / ($height - 1));
my $colour = $self->get_colour_canape ($class);
$self->add_row($self->{legend_colours_group}, $row, $colour);
}
Expand Down Expand Up @@ -387,6 +403,7 @@ sub reposition {
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->{marks}};
foreach my $i (0..$#mark_arr) {
my $mark = $mark_arr[$#mark_arr - $i];
Expand Down Expand Up @@ -558,15 +575,6 @@ sub get_colour {
}


# refactor as state var inside sub when we require a perl version that
# supports state on lists (5.28)
my %canape_colour_hash = (
0 => Gtk2::Gdk::Color->parse('lightgoldenrodyellow'), # non-sig, lightgoldenrodyellow
1 => Gtk2::Gdk::Color->parse('red'), # red, neo
2 => Gtk2::Gdk::Color->parse('royalblue1'), # blue, palaeo
3 => Gtk2::Gdk::Color->parse('#CB7FFF'), # purple, mixed
);

sub get_colour_canape {
my ($self, $val) = @_;
$val //= -1; # avoid undef key warnings
Expand Down Expand Up @@ -825,12 +833,23 @@ sub set_text_marks_canape {

return if !$self->{marks};

my @strings = qw /mixed palaeo neo non-sig/;
foreach my $mark (@{$self->{marks}}) {
$mark->hide;
}

my @strings = qw /super mixed palaeo neo non-sig/;

my $mark_arr = $self->{canape_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);
}
}

# Set legend textbox markers
my @mark_arr = @{$self->{marks}};
foreach my $i (0..$#mark_arr) {
my $mark = $mark_arr[$#mark_arr - $i];
foreach my $i (0..$#strings) {
my $mark = $mark_arr->[$#$mark_arr - $i];
$mark->set( text => $strings[$i] );
$mark->raise_to_top;
}
Expand Down
76 changes: 62 additions & 14 deletions t/29-CANAPE.t
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -100,27 +100,46 @@ sub test_rand_structured_richness_same {
my @canape_list_names = grep {/>>CANAPE>>/} keys %$lists_has_canape;
is (scalar @canape_list_names, 1, 'has CANAPE list');

my @index_keys = qw /CANAPE_CODE NEO PALAEO MIXED/;
my @index_keys = qw /CANAPE_CODE NEO PALAEO MIXED SUPER/;
foreach my $element ($sp_has_canape->get_element_list_sorted) {
my $listref = $sp_has_canape->get_list_ref (element => $element, list => $canape_list_names[0], autovivify => 0);
my $listref = $sp_has_canape->get_list_ref (
element => $element,
list => $canape_list_names[0],
autovivify => 0,
);

if (!defined $listref->{CANAPE_CODE}) {
is [@$listref{@index_keys}], [undef, undef, undef, undef], "expected values undef, $element";
is [@$listref{@index_keys}],
[undef, undef, undef, undef, undef],
"expected values undef, $element";
}
elsif ($listref->{CANAPE_CODE} == 0) {
is [@$listref{@index_keys}], [0, 0, 0, 0], "expected values non-sig, $element";
is [@$listref{@index_keys}],
[0, 0, 0, 0, 0],
"expected values non-sig, $element";
}
elsif ($listref->{CANAPE_CODE} == 1) {
is [@$listref{@index_keys}], [1, 1, 0, 0], "expected values neo, $element";
is [@$listref{@index_keys}],
[1, 1, 0, 0, 0],
"expected values neo, $element";
}
elsif ($listref->{CANAPE_CODE} == 2) {
is [@$listref{@index_keys}], [2, 0, 1, 0], "expected values palaeo, $element";
is [@$listref{@index_keys}],
[2, 0, 1, 0, 0],
"expected values palaeo, $element";
}
elsif ($listref->{CANAPE_CODE} == 3) {
is [@$listref{@index_keys}], [3, 0, 0, 1], "expected values mixed, $element";
is [@$listref{@index_keys}],
[3, 0, 0, 1, 0],
"expected values mixed, $element";
}
elsif ($listref->{CANAPE_CODE} == 4) {
is [@$listref{@index_keys}],
[4, 0, 0, 0, 1],
"expected values super, $element";
}
}

return;
}

Expand All @@ -130,29 +149,58 @@ sub test_canape_classification_method {
invalid => {
p_rank_list_ref => {PHYLO_RPE2 => 0.01, PE_WE => undef, PHYLO_RPE_NULL2 => 0.94},
base_list_ref => {PE_WE => undef},
expected => {CANAPE_CODE => undef, NEO => undef, PALAEO => undef, MIXED => undef},
expected => {
CANAPE_CODE => undef, NEO => undef,
PALAEO => undef, MIXED => undef,
SUPER => undef,
},
},
non_sig => {
p_rank_list_ref => {PHYLO_RPE2 => 0.01, PE_WE => undef, PHYLO_RPE_NULL2 => 0.94},
base_list_ref => {PE_WE => 10},
expected => {CANAPE_CODE => 0, NEO => 0, PALAEO => 0, MIXED => 0},
expected => {
CANAPE_CODE => 0, NEO => 0,
PALAEO => 0, MIXED => 0,
SUPER => 0,
},
},
neo => {
p_rank_list_ref => {PHYLO_RPE2 => 0.01, PE_WE => 0.976, PHYLO_RPE_NULL2 => 0.98},
base_list_ref => {PE_WE => 10},
expected => {CANAPE_CODE => 1, NEO => 1, PALAEO => 0, MIXED => 0},
expected => {
CANAPE_CODE => 1, NEO => 1,
PALAEO => 0, MIXED => 0,
SUPER => 0,
},
},
palaeo => {
p_rank_list_ref => {PHYLO_RPE2 => 0.978, PE_WE => 0.976, PHYLO_RPE_NULL2 => 0.94},
base_list_ref => {PE_WE => 10},
expected => {CANAPE_CODE => 2, NEO => 0, PALAEO => 1, MIXED => 0},
expected => {
CANAPE_CODE => 2, NEO => 0,
PALAEO => 1, MIXED => 0,
SUPER => 0,
},
},
mixed => {
p_rank_list_ref => {PHYLO_RPE2 => undef, PE_WE => 0.98, PHYLO_RPE_NULL2 => 0.984},
base_list_ref => {PE_WE => 10},
expected => {CANAPE_CODE => 3, NEO => 0, PALAEO => 0, MIXED => 1},
expected => {
CANAPE_CODE => 3, NEO => 0,
PALAEO => 0, MIXED => 1,
SUPER => 0,
},
},
);
super => {
p_rank_list_ref => {PHYLO_RPE2 => undef, PE_WE => 0.991, PHYLO_RPE_NULL2 => 0.991},
base_list_ref => {PE_WE => 10},
expected => {
CANAPE_CODE => 4, NEO => 0,
PALAEO => 0, MIXED => 0,
SUPER => 1,
},
},
);


my $sp = Biodiverse::Spatial->new (name => 'gorb');
Expand Down
Loading