diff --git a/lib/Biodiverse/BaseData.pm b/lib/Biodiverse/BaseData.pm index a506c95f5..e78180b41 100644 --- a/lib/Biodiverse/BaseData.pm +++ b/lib/Biodiverse/BaseData.pm @@ -1591,21 +1591,23 @@ sub transfer_element_properties { my $to_bd = $args{receiver} || croak "Missing receiver argument\n"; my $remap = $args{remap} || {}; # remap hash - my $progress_bar = Biodiverse::Progress->new(); - my $type = $args{type}; croak "argument 'type => $type' is not valid (must be groups or labels)\n" if not( $type eq 'groups' or $type eq 'labels' ); my $get_ref_sub = $type eq 'groups' ? 'get_groups_ref' : 'get_labels_ref'; my $elements_ref = $self->$get_ref_sub; + + return if !$elements_ref->has_element_properties; + my $to_elements_ref = $to_bd->$get_ref_sub; my $name = $self->get_param('NAME'); my $to_name = $to_bd->get_param('NAME'); my $text = "Transferring $type properties from $name to $to_name"; - my $total_to_do = $elements_ref->get_element_count; + my $progress_bar = Biodiverse::Progress->new(); + my $total_to_do = $elements_ref->get_element_count; print "[BASEDATA] Transferring properties for $total_to_do $type\n"; my $count = 0; @@ -2052,9 +2054,9 @@ sub get_range { my $variety = $labels_ref->get_variety(@_); - my $range = max( ( $props->{RANGE} // -1 ), $variety ); - - return $range; + return defined $props + ? max( ( $props->{RANGE} // -1 ), $variety ) + : $variety; } # for backwards compatibility diff --git a/lib/Biodiverse/BaseStruct.pm b/lib/Biodiverse/BaseStruct.pm index 0cc9fdcb9..618e584d4 100644 --- a/lib/Biodiverse/BaseStruct.pm +++ b/lib/Biodiverse/BaseStruct.pm @@ -387,7 +387,6 @@ sub get_element_name_as_array_aa { $element_list_ref->[0] //= ($quote_char . $quote_char) } else { - my $quotes = $quote_char; for my $el (@$element_list_ref) { $el //= $EMPTY_STRING; } @@ -529,7 +528,7 @@ sub get_sub_element_list { no autovivification; - my $element = $args{element} // croak "argument 'element' not specified\n"; + my $element = $args{element} // croak "argument 'element' not specified in get_sub_element_list\n"; my $el_hash = $self->{ELEMENTS}{$element}{SUBELEMENTS} // return; @@ -544,7 +543,7 @@ sub get_sub_element_hash { no autovivification; my $element = $args{element} - // croak "argument 'element' not specified\n"; + // croak "argument 'element' not specified in get_sub_element_hash\n"; # Ideally we should throw an exception, but at the moment too many other # things need a result and we aren't testing for them. @@ -567,7 +566,7 @@ sub get_sub_element_hash_aa { no autovivification; - croak "argument 'element' not specified\n" + croak "argument 'element' not specified in get_sub_element_hash_aa\n" if !defined $element; # Ideally we should throw an exception, but at the moment too many other @@ -582,7 +581,7 @@ sub get_sub_element_hash_aa { sub get_sub_element_href_autoviv_aa { my ($self, $element) = @_; - croak "argument 'element' not specified\n" + croak "argument 'element' not specified in get_sub_element_href_autoviv_aa\n" if !defined $element; return $self->{ELEMENTS}{$element}{SUBELEMENTS} //= {}; @@ -907,9 +906,9 @@ sub exists_sub_element { #defined $args{element} || croak "Argument 'element' not specified\n"; #defined $args{subelement} || croak "Argument 'subelement' not specified\n"; my $element = $args{element} - // croak "Argument 'element' not specified\n"; + // croak "Argument 'element' not specified in exists_sub_element\n"; my $subelement = $args{subelement} - // croak "Argument 'subelement' not specified\n"; + // croak "Argument 'subelement' not specified in exists_sub_element\n"; no autovivification; exists $self->{ELEMENTS}{$element}{SUBELEMENTS}{$subelement}; @@ -1074,6 +1073,17 @@ sub exists_list { return; } +sub exists_list_aa { + my ($self, $element, $list) = @_; + + croak "element not specified\n" if not defined $element; + croak "list not specified\n" if not defined $list; + + no autovivification; + + return exists $self->{ELEMENTS}{$element}{$list}; +} + sub add_lists { my $self = shift; my %args = @_; @@ -1562,6 +1572,20 @@ sub get_list_ref { return $el->{$list}; } +sub get_list_ref_aa { + my ($self, $element, $list) = @_; + no autovivification; + defined $list ? $self->{ELEMENTS}{$element}{$list} : undef; +} + +sub get_list_ref_autoviv_aa { + my ($self, $element, $list) = @_; + no autovivification; + return if !exists $self->{ELEMENTS}{$element}; + $self->{ELEMENTS}{$element}{$list} //= {}; +} + + sub rename_list { my $self = shift; my %args = @_; @@ -1781,13 +1805,14 @@ sub get_base_stats { # calculate basestats for a single element sub get_element_property_keys { my $self = shift; - my $keys = $self->get_cached_value ('ELEMENT_PROPERTY_KEYS'); + state $cache_name = 'ELEMENT_PROPERTY_KEYS'; + my $keys = $self->get_cached_value ($cache_name); return wantarray ? @$keys : $keys if $keys; my @keys = $self->get_hash_list_keys_across_elements (list => 'PROPERTIES'); - $self->set_cached_value ('ELEMENT_PROPERTY_KEYS' => \@keys); + $self->set_cached_value ($cache_name => \@keys); return wantarray ? @keys : \@keys; } @@ -1869,10 +1894,20 @@ sub get_element_properties_summary_stats { sub has_element_properties { my $self = shift; - - my @keys = $self->get_element_property_keys; - - return scalar @keys; + + my $keys = $self->get_element_property_keys // []; + + return scalar @$keys; +} + +# maybe should cache +sub has_element_range_property { + my $self = shift; + + my $prop_keys = $self->get_element_property_keys // []; + my $has_range_property = grep {$_ eq 'RANGE'} @$prop_keys; + + return scalar $has_range_property; } # return true if the labels are all numeric diff --git a/lib/Biodiverse/Indices/Endemism.pm b/lib/Biodiverse/Indices/Endemism.pm index 0d6223a6f..97d5a4f81 100644 --- a/lib/Biodiverse/Indices/Endemism.pm +++ b/lib/Biodiverse/Indices/Endemism.pm @@ -127,11 +127,20 @@ sub get_label_range_hash { my $self = shift; my $bd = $self->get_basedata_ref; + my $lb = $bd->get_labels_ref; + my $has_range_property = $lb->has_element_range_property; my %range_hash; - - foreach my $label ($bd->get_labels) { - $range_hash{$label} = $bd->get_range (element => $label); + if ($has_range_property) { + foreach my $label ($bd->get_labels) { + $range_hash{$label} = $bd->get_range(element => $label); + } + } + else { + # use more direct calculation if no label property for range + foreach my $label ($bd->get_labels) { + $range_hash{$label} = $lb->get_variety_aa($label); + } } my %results = (label_range_hash => \%range_hash); diff --git a/lib/Biodiverse/Indices/HierarchicalLabels.pm b/lib/Biodiverse/Indices/HierarchicalLabels.pm index 193dab165..7b19ae97d 100644 --- a/lib/Biodiverse/Indices/HierarchicalLabels.pm +++ b/lib/Biodiverse/Indices/HierarchicalLabels.pm @@ -55,7 +55,7 @@ The number of list elements generated depends on how many axes are used in the l Axes are order from zero as the highest level in the hierarchy, so index 0 is the top level of the hierarchy. -Note that this calculation prodices lists since version 4.99_002 +Note that this calculation produces lists since version 4.99_002 so one can no longer use the SUMRAT indices for clustering. This can be re-enabled if there is a need. END_H_DESC @@ -70,8 +70,8 @@ END_H_DESC type => 'Hierarchical Labels', reference => $ref, indices => \%indices, + # these are not used any more - should get the number of label axes directly pre_calc_global => 'get_basedatas_by_label_hierarchy', - pre_calc => 'calc_abc', # we need the element lists uses_nbr_lists => 2, # how many sets of lists it must have ); diff --git a/lib/Biodiverse/Indices/Indices.pm b/lib/Biodiverse/Indices/Indices.pm index 4f9c6dcef..32328e900 100644 --- a/lib/Biodiverse/Indices/Indices.pm +++ b/lib/Biodiverse/Indices/Indices.pm @@ -6,10 +6,11 @@ use 5.010; use Carp; use Scalar::Util qw /blessed weaken/; -use List::Util 1.39 qw /min max pairs pairkeys sum/; +use List::Util 1.39 qw /min max pairs pairkeys pairmap sum/; use Ref::Util qw { :all }; use English ( -no_match_vars ); use Readonly; +use experimental qw /refaliasing/; our $VERSION = '4.99_002'; @@ -1631,14 +1632,22 @@ sub get_metadata_calc_abc { } sub calc_abc { # wrapper for _calc_abc - use the other wrappers for actual GUI stuff - my $self = shift; - #my %args = @_; + my ($self, %args) = @_; + + delete @args{qw/count_samples count_labels}/}; + + return $self->_calc_abc(%args) + if is_hashref($args{element_list1}) + || @{$args{element_list1} // []} != 1 + || defined( + $args{element_list2} + // $args{label_hash1} + // $args{label_hash2} + // $args{label_list1} + // $args{label_list2} + ); - return $self->_calc_abc ( - @_, - count_labels => 0, - count_samples => 0, - ); + return $self->_calc_abc_one_element(%args); } sub get_metadata_calc_abc2 { @@ -1655,11 +1664,22 @@ sub get_metadata_calc_abc2 { return $metadata_class->new(\%metadata); } -sub calc_abc2 { # run calc_abc, but keep a track of the label counts across groups - my $self = shift; - #my %args = @_; +sub calc_abc2 { + # run calc_abc, but keep a track of the label counts across groups + my ($self, %args) = @_; + + return $self->_calc_abc(%args, count_labels => 1) + if is_hashref($args{element_list1}) + || @{$args{element_list1} // []} != 1 + || defined( + $args{element_list2} + // $args{label_hash1} + // $args{label_hash2} + // $args{label_list1} + // $args{label_list2} + ); - return $self->_calc_abc(@_, count_labels => 1); + return $self->_calc_abc_one_element(%args, count_labels => 1); } sub get_metadata_calc_abc3 { @@ -1677,19 +1697,68 @@ sub get_metadata_calc_abc3 { return $metadata_class->new(\%metadata); } -sub calc_abc3 { # run calc_abc, but keep a track of the label counts and samples across groups - my $self = shift; - #my %args = @_; +# run calc_abc, but keep a track of the label counts and samples across groups +sub calc_abc3 { + my ($self, %args) = @_; + + return $self->_calc_abc(%args, count_samples => 1) + if is_hashref($args{element_list1}) + || @{$args{element_list1} // []} != 1 + || defined( + $args{element_list2} + // $args{label_hash1} + // $args{label_hash2} + // $args{label_list1} + // $args{label_list2} + ); - return $self->_calc_abc(@_, count_samples => 1); + return $self->_calc_abc_one_element(%args, count_samples => 1); +} + +# A simplified version of _calc_abc for a single element. +# This allows us to avoid a lot of looping and checking +# which pays off under randomisations. +sub _calc_abc_one_element { + my ($self, %args) = @_; + + # only one element passed so do it all here + my $element = $args{element_list1}[0]; + \my %labels = $self->get_basedata_ref->get_labels_in_group_as_hash_aa ($element); + my %label_list_master; + if ($args{count_samples} && !$args{count_labels}) { + %label_list_master = %labels; + } + else { + @label_list_master{keys %labels} = (1) x keys %labels; + } + # make a copy + my %label_hash1 = %label_list_master; + my $bb = keys %label_hash1; + + my %results = ( + A => 0, + B => $bb, + C => 0, + ABC => $bb, + + label_hash_all => \%label_list_master, + label_hash1 => \%label_hash1, + label_hash2 => {}, + element_list1 => {$element => 1}, + element_list2 => {}, + element_list_all => [$element], + element_count1 => 1, + element_count2 => 0, + element_count_all => 1, + ); + + return wantarray ? %results : \%results; } sub _calc_abc { # required by all the other indices, as it gets the labels in the elements my $self = shift; my %args = @_; - my $bd = $self->get_basedata_ref; - croak "At least one of element_list1, element_list2, label_list1, " . "label_list2, label_hash1, label_hash2 must be specified\n" if ! defined ( @@ -1701,8 +1770,11 @@ sub _calc_abc { # required by all the other indices, as it gets the labels in // $args{label_list2} ); + my $bd = $self->get_basedata_ref; + + # mutually exclusive options my $count_labels = $args{count_labels}; - my $count_samples = $args{count_samples}; + my $count_samples = $args{count_samples} && !$count_labels; my %label_list = (1 => {}, 2 => {}); my %label_list_master; @@ -1710,56 +1782,66 @@ sub _calc_abc { # required by all the other indices, as it gets the labels in my %element_check = (1 => {}, 2 => {}); my %element_check_master; - # loop iter variables - my ($listname, $iter, $value); - - my %hash = (element_list1 => 1, element_list2 => 2); - + my $iter = 0; LISTNAME: - while (($listname, $iter) = each (%hash)) { + foreach my $listname (qw /element_list1 element_list2/) { #print "$listname, $iter\n"; + $iter++; + my $el_listref = $args{$listname} // next LISTNAME; croak "_calc_abc argument $listname is not a list ref\n" if !is_ref($el_listref); + # hopefully no longer needed if (is_hashref($el_listref)) { # silently convert the hash to an array $el_listref = [keys %$el_listref]; } - my (@checked_elements, @label_list); + \my %label_hash_this_iter = $label_list{$iter}; ELEMENT: foreach my $element (@$el_listref) { my $sublist = $bd->get_labels_in_group_as_hash_aa ($element); - push @label_list, %$sublist; - push @checked_elements, $element; - } - if ($count_labels) { - # track the number of times each label occurs - foreach my $label (pairkeys @label_list) { - $label_list{$iter}{$label}++; - $label_list_master{$label}++; + if ($count_labels && scalar keys %label_hash_this_iter) { + # Track the number of times each label occurs. + # Use postfix loop for speed, although first assignment + # to empty hash can be direct via slice assign below. + $label_hash_this_iter{$_}++ + foreach keys %$sublist; } - } - elsif ($count_samples) { - # track the number of samples for each label - foreach my $pair (pairs @label_list) { - my ($label, $value) = @$pair; - $label_list{$iter}{$label} += $value; - $label_list_master{$label} += $value; + elsif ($count_samples) { + # track the number of samples for each label + if (scalar keys %label_hash_this_iter) { + # switch to for-list when min perl version is 5.36 + pairmap {$label_hash_this_iter{$a} += $b} %$sublist; + } + else { + # direct assign first one + %label_hash_this_iter = %$sublist; + } + } + else { + # track presence only + @label_hash_this_iter{keys %$sublist} = (1) x keys %$sublist; } } + + if ($iter == 1 || !scalar keys %label_list_master) { + %label_list_master = %label_hash_this_iter; + } + elsif ($count_labels || $count_samples) { + # switch to for-list when min perl version is 5.36 + pairmap {$label_list_master{$a} += $b} %label_hash_this_iter; + } else { - %{$label_list{$iter}} = @label_list; - @label_list_master{keys %{$label_list{$iter}}} - = (1) x scalar keys %{$label_list{$iter}}; + @label_list_master{keys %label_hash_this_iter} = values %label_hash_this_iter; } - # hash slice is faster than looping - @{$element_check{$iter}}{@checked_elements} = (1) x @checked_elements; - @element_check_master{@checked_elements} = (1) x scalar @checked_elements; + + @{$element_check{$iter}}{@$el_listref} = (1) x scalar @$el_listref; + @element_check_master{@$el_listref} = (1) x scalar @$el_listref; } # run some checks on the elements @@ -1771,51 +1853,57 @@ sub _calc_abc { # required by all the other indices, as it gets the labels in . "$element_count1 + $element_count2 > $element_count_master\n" if $element_count1 + $element_count2 > $element_count_master; - %hash = (label_list1 => 1, label_list2 => 2); - while (($listname, $iter) = each %hash) { - next if !defined $args{$listname}; + $iter = 0; + foreach my $listname (qw /label_list1 label_list2/) { + $iter++; + + \my @label_arr = $args{$listname} + // next; - my $label_listref = $args{$listname}; - croak "[INDICES] $label_listref is not an array ref\n" - if !is_arrayref($label_listref); - + \my %label_list_this_iter = $label_list{$iter}; if ($count_labels || $count_samples) { - foreach my $lbl (@$label_listref) { + foreach my $lbl (@label_arr) { $label_list_master{$lbl}++; - $label_list{$iter}{$lbl}++; + $label_list_this_iter{$lbl}++; } } else { - @label_list_master{@$label_listref} = (1) x scalar @$label_listref; - @{$label_list{$iter}}{@$label_listref} = (1) x scalar @$label_listref; + @label_list_master{@label_arr} = (1) x scalar @label_arr; + @label_list_this_iter{@label_arr} = (1) x scalar @label_arr; } } - %hash = (label_hash1 => 1, label_hash2 => 2); - while (($listname, $iter) = each %hash) { - next if ! defined $args{$listname}; + $iter = 0; + foreach my $listname (qw /label_hash1 label_hash2/) { + $iter++; - my $label_hashref = $args{$listname}; - - croak "[INDICES] $label_hashref is not a hash ref\n" - if !is_hashref($label_hashref); + # throws an exception if args is not a hashref + \my %label_hashref = $args{$listname} + // next; if ($count_labels || $count_samples) { - my $label; # clunk - while (($label, $value) = each %$label_hashref) { - $label_list_master{$label} += $value; - $label_list{$iter}{$label} += $value; + # can do direct assignment in some cases + if ($iter == 1 && !keys %label_list_master) { + %label_list_master = %label_hashref; + %{$label_list{$iter}} = %label_hashref; + } + else { + pairmap { + $label_list_master{$a} += $b; + $label_list{$iter}{$a} += $b + } + %label_hashref; } } else { # don't care about counts yet - assign using a slice - @label_list_master{keys %$label_hashref} = (1) x scalar keys %$label_hashref; - @{$label_list{$iter}}{keys %$label_hashref} = (1) x scalar keys %$label_hashref; + @label_list_master{keys %label_hashref} = (1) x scalar keys %label_hashref; + @{$label_list{$iter}}{keys %label_hashref} = (1) x scalar keys %label_hashref; } } # set the counts to one if using plain old abc, as the elements section doesn't obey it properly - if (!($count_labels || $count_samples)) { + if (0 || !($count_labels || $count_samples)) { @label_list_master{keys %label_list_master} = (1) x scalar keys %label_list_master; @{$label_list{1}}{keys %{$label_list{1}}} = (1) x scalar keys %{$label_list{1}}; @{$label_list{2}}{keys %{$label_list{2}}} = (1) x scalar keys %{$label_list{2}}; diff --git a/lib/Biodiverse/Randomise/CurveBall.pm b/lib/Biodiverse/Randomise/CurveBall.pm index 16cd3705a..6040a45d1 100644 --- a/lib/Biodiverse/Randomise/CurveBall.pm +++ b/lib/Biodiverse/Randomise/CurveBall.pm @@ -174,19 +174,19 @@ END_PROGRESS_TEXT # skip if nothing can be swapped next MAIN_ITER if !$n_labels_to_swap; - # is sort in-place optimised? - @swappable_from1 = sort @swappable_from1; - @swappable_from2 = sort @swappable_from2; - # in-place shuffle is apparently fastest (MRMA docs) - $rand->shuffle (\@swappable_from1); - $rand->shuffle (\@swappable_from2); - # curtail longer array + # Get a random subset of the longer array. + # Sort is needed to guarantee repeatability, and in-place sort is optimised by Perl. + # In-place shuffle is apparently fastest (MRMA docs) if (@swappable_from1 > $n_labels_to_swap) { + @swappable_from1 = sort @swappable_from1; + $rand->shuffle (\@swappable_from1); @swappable_from1 = @swappable_from1[0..$n_labels_to_swap-1]; } elsif (@swappable_from2 > $n_labels_to_swap) { + @swappable_from2 = sort @swappable_from2; + $rand->shuffle (\@swappable_from2); @swappable_from2 = @swappable_from2[0..$n_labels_to_swap-1]; } diff --git a/lib/Biodiverse/Spatial.pm b/lib/Biodiverse/Spatial.pm index e92703228..11a9121b9 100644 --- a/lib/Biodiverse/Spatial.pm +++ b/lib/Biodiverse/Spatial.pm @@ -13,6 +13,7 @@ use List::MoreUtils qw /firstidx lastidx/; use List::Util 1.45 qw /first uniq/; use Time::HiRes qw /time/; use Ref::Util qw { :all }; +use experimental qw /refaliasing/; our $VERSION = '4.99_002'; @@ -54,6 +55,10 @@ sub compare { croak qq{Argument 'result_list_pfx' not specified\n} if ! defined $result_list_pfx; + # drop out if no elements to compare with + my $e_list = $self->get_element_list; + return 1 if not scalar @$e_list; + my $progress = Biodiverse::Progress->new(); my $progress_text = sprintf "Comparing %s with %s\n", @@ -61,23 +66,23 @@ sub compare { $comparison->get_param ('NAME'); $progress->update ($progress_text, 0); - my $bd = $self->get_param ('BASEDATA_REF'); - - # drop out if no elements to compare with - my $e_list = $self->get_element_list; - return 1 if not scalar @$e_list; - - - my %base_list_indices = $self->find_list_indices_across_elements; - $base_list_indices{SPATIAL_RESULTS} = 'SPATIAL_RESULTS'; - - # now we need to calculate the appropriate result list name - # for example RAND25>>SPATIAL_RESULTS - foreach my $list_name (keys %base_list_indices) { + # Generate the set of result list names with this prefix, + # for example RAND25>>SPATIAL_RESULTS. + # We cannot fiddle with the cache directly as the prefix can change. + # (We could cache by prefix but it's not a huge time saving). + state $list_cache_name = 'CACHE_LIST_INDICES_ACROSS_ELEMENTS'; + my $lists_across_elements = $self->get_cached_value ($list_cache_name); + if (!$lists_across_elements) { + $lists_across_elements = $self->find_list_indices_across_elements; + $self->set_cached_value ($list_cache_name => $lists_across_elements); + } + my %base_list_indices = ( + SPATIAL_RESULTS => $result_list_pfx . '>>SPATIAL_RESULTS', + ); + foreach my $list_name (keys %$lists_across_elements) { $base_list_indices{$list_name} = $result_list_pfx . '>>' . $list_name; } - my $to_do = $self->get_element_count; my $i = 0; @@ -100,7 +105,7 @@ sub compare { } COMP_BY_ELEMENT: - foreach my $element ($self->get_element_list) { + foreach my $element (@$e_list) { $i++; $progress->update ( @@ -110,32 +115,24 @@ sub compare { # now loop over the list indices BY_LIST: - while (my ($list_name, $result_list_name) = each %base_list_indices) { + foreach my $list_name (keys %base_list_indices) { + my $result_list_name = $base_list_indices{$list_name}; next BY_LIST if $recycled_results && $done_base{$list_name}{$element} && $done_comp{$list_name}{$element}; - my $base_ref = $self->get_list_ref ( - element => $element, - list => $list_name, - autovivify => 0, - ); - my $comp_ref = $comparison->get_list_ref ( - element => $element, - list => $list_name, - autovivify => 0, - ); - - next BY_LIST if ! $base_ref || ! $comp_ref; # nothing to compare with... + my $comp_ref + = $comparison->get_list_ref_aa ($element, $list_name); + next BY_LIST if !$comp_ref; # nothing to compare with... - next BY_LIST if (is_arrayref($base_ref)); + my $base_ref + = $self->get_list_ref_aa ($element, $list_name); + next BY_LIST if !$base_ref || is_arrayref($base_ref); - my $results_ref = $self->get_list_ref ( - element => $element, - list => $result_list_name, - ); + my $results_ref + = $self->get_list_ref_autoviv_aa ($element, $result_list_name); $self->compare_lists_by_item ( base_list_ref => $base_ref, @@ -1222,18 +1219,13 @@ sub get_nbrs_for_element { # where we set all the results in one go. # Should only be triggered when results recycling is off but we still recycle nbrs, # as we don't double handle when recycling results - if ($self->exists_list ( - element => $element, - list => $nbr_list_name - )) { - + if ($self->exists_list_aa ($element, $nbr_list_name)) { my $nbrs = $self->get_list_values ( element => $element, list => $nbr_list_name, - ) - || []; - $nbr_list[$i] = $nbrs; + ); + $nbr_list[$i] = $nbrs || []; push @exclude, @$nbrs; } else { diff --git a/t/28-Randomisation.t b/t/28-Randomisation.t index b501a86cd..cccb862dc 100644 --- a/t/28-Randomisation.t +++ b/t/28-Randomisation.t @@ -1031,7 +1031,8 @@ sub test_group_properties_reassigned_subset_rand { sub test_group_properties_reassigned { my %args = @_; - my $bd = get_basedata_object_from_site_data(CELL_SIZES => [100000, 100000]); + my $c = 100000; + my $bd = get_basedata_object_from_site_data(CELL_SIZES => [$c, $c]); my $rand_func = 'rand_csr_by_group'; my $object_name = 't_g_p_r'; @@ -1046,6 +1047,8 @@ sub test_group_properties_reassigned { note $e if $e; ok (!$e, 'Group properties assigned without eval error'); + $bd->build_spatial_index(resolutions => [$c, $c]); + # name is short for sub name my $sp = $bd->add_spatial_output (name => 't_g_p_r');