Add a transpose option to add_elements_collated

This saves randomisations transposing the data, only for it to again be transposed inside the add method.
shawnlaffan · Feb 12, 2024 · 190022a · 190022a
1 parent 9ac1121
commit 190022a
Show file tree

Hide file tree

Showing 3 changed files with 42 additions and 32 deletions.
diff --git 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
@@ -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
@@ -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,