diff --git a/lib/Biodiverse/BaseData.pm b/lib/Biodiverse/BaseData.pm index e78180b41..b0c140eef 100644 --- a/lib/Biodiverse/BaseData.pm +++ b/lib/Biodiverse/BaseData.pm @@ -1361,26 +1361,44 @@ sub add_elements_collated { # simplified array args version for speed sub add_elements_collated_simple_aa { - my ( $self, $gp_lb_hash, $csv_object, $allow_empty_groups ) = @_; + my ( $self, $gp_lb_hash, $csv_object, $allow_empty_groups, $transpose ) = @_; croak "csv_object arg not passed\n" if !$csv_object; # blank slate so set directly - return $self->_set_elements_collated_simple_aa($gp_lb_hash, $csv_object, $allow_empty_groups) - if (!$self->get_group_count && !$self->get_label_count); + return $self->_set_elements_collated_simple_aa($gp_lb_hash, $csv_object, $allow_empty_groups, $transpose) + if !$self->get_group_count && !$self->get_label_count; # now add the collated data - foreach my $gp_lb_pair ( pairs %$gp_lb_hash ) { - my ( $gp, $lb_hash ) = @$gp_lb_pair; + # duplicated loops to avoid conditions inside them + if (!$transpose) { + foreach my $gp_lb_pair (pairs % $gp_lb_hash) { + my ($gp, $lb_hash) = @$gp_lb_pair; - if ( $allow_empty_groups && !scalar %$lb_hash ) { - $self->add_element_simple_aa ( undef, $gp, 0, $csv_object ); + if ($allow_empty_groups && !scalar %$lb_hash) { + $self->add_element_simple_aa(undef, $gp, 0, $csv_object); + } + else { + foreach my $lb_count_pair (pairs %$lb_hash) { + my ($lb, $count) = @$lb_count_pair; + $self->add_element_simple_aa($lb, $gp, $count, $csv_object); + } + } } - else { - foreach my $lb_count_pair ( pairs %$lb_hash ) { - my ( $lb, $count ) = @$lb_count_pair; - $self->add_element_simple_aa( $lb, $gp, $count, $csv_object ); + } + else { + foreach my $pair (pairs % $gp_lb_hash) { + my ($lb, $gp_hash) = @$pair; + + if ($allow_empty_groups && !scalar %$gp_hash) { + $self->add_element_simple_aa($lb, undef, 0, $csv_object); + } + else { + foreach my $gp_count_pair (pairs %$gp_hash) { + my ($gp, $count) = @$gp_count_pair; + $self->add_element_simple_aa($lb, $gp, $count, $csv_object); + } } } } @@ -1391,7 +1409,7 @@ sub add_elements_collated_simple_aa { # currently an internal sub as we might later take ownership of the input data # using refaliasing to squeeze a bit more speed sub _set_elements_collated_simple_aa { - my ( $self, $gp_lb_hash, $csv_object, $allow_empty_groups ) = @_; + my ( $self, $gp_lb_hash, $csv_object, $allow_empty_groups, $transpose ) = @_; croak "csv_object arg not passed\n" if !$csv_object; @@ -1400,6 +1418,9 @@ sub _set_elements_collated_simple_aa { my $groups_ref = $self->get_groups_ref; my $labels_ref = $self->get_labels_ref; + if ($transpose) { + ($groups_ref, $labels_ref) = ($labels_ref, $groups_ref); + } # now add the collated data to the groups object foreach \my @gp_lb_pair ( pairs %$gp_lb_hash ) { diff --git a/lib/Biodiverse/Randomise/CurveBall.pm b/lib/Biodiverse/Randomise/CurveBall.pm index abfa03f2f..021469ed4 100644 --- a/lib/Biodiverse/Randomise/CurveBall.pm +++ b/lib/Biodiverse/Randomise/CurveBall.pm @@ -237,23 +237,14 @@ END_PROGRESS_TEXT . "[RANDOMISE] Swapped $moved_pairs of the $non_zero_mx_cells group/label " . "elements at least once.\n"; - # transpose - my %gp_hash; - foreach my $gp (keys %lb_hash) { - foreach my $lb (keys %{$lb_hash{$gp}}) { - # should not need this check, but just in case - next if !$lb_hash{$gp}{$lb}; - $gp_hash{$lb}{$gp} = $lb_hash{$gp}{$lb}; - } - } - # now we populate a new basedata my $new_bd = $self->get_new_bd_from_gp_lb_hash ( - name => $name, + name => $name, source_basedata => $bd, - gp_hash => \%gp_hash, + gp_hash => \%lb_hash, empty_label_hash => \%empty_labels, empty_group_hash => \%empty_groups, + transpose => 1, ); # say 'Done'; diff --git a/lib/Biodiverse/Randomise/IndependentSwaps.pm b/lib/Biodiverse/Randomise/IndependentSwaps.pm index 6fe0124b5..09a472b2f 100644 --- a/lib/Biodiverse/Randomise/IndependentSwaps.pm +++ b/lib/Biodiverse/Randomise/IndependentSwaps.pm @@ -577,6 +577,7 @@ sub get_new_bd_from_gp_lb_hash { \my %gp_hash = $args{gp_hash}; \my %empty_groups = $args{empty_group_hash}; \my %empty_labels = $args{empty_label_hash}; + my $transpose = $args{transpose}; # now we populate a new basedata my $new_bd = blessed($bd)->new ($bd->get_params_hash); @@ -595,14 +596,11 @@ sub get_new_bd_from_gp_lb_hash { quote_char => $bd->get_param('QUOTES'), ); - foreach my $label (keys %gp_hash) { - \my %this_g_hash = $gp_hash{$label}; - foreach my $group (keys %this_g_hash) { - $new_bd->add_element_simple_aa ( - $label, $group, $this_g_hash{$group}, $csv, - ); - } - } + # negate the transpose arg as add_elements_collated_simple_aa + # expects a different order + $new_bd->add_elements_collated_simple_aa ( + \%gp_hash, $csv, 1, !$transpose + ); foreach my $label (keys %empty_labels) { $new_bd->add_element ( label => $label,