From 7d736dd2c4e6c5dd3c18178051671552d8383100 Mon Sep 17 00:00:00 2001
From: drbaggy <js5@sanger.ac.uk>
Date: Wed, 21 Apr 2021 01:37:19 +0100
Subject: remove fluff from both fns

---
 challenge-109/james-smith/perl/ch-2.pl | 68 ++++++++++++----------------------
 1 file changed, 24 insertions(+), 44 deletions(-)

diff --git a/challenge-109/james-smith/perl/ch-2.pl b/challenge-109/james-smith/perl/ch-2.pl
index efbd9fa75a..672003941e 100644
--- a/challenge-109/james-smith/perl/ch-2.pl
+++ b/challenge-109/james-smith/perl/ch-2.pl
@@ -43,13 +43,16 @@ use Test::More;
 ##
 
 
+say '';
+say 'Assume uniqueness.....';
 say '';
 sep(); show( four_square( 1..7            ) );
 sep(); show( four_square( -2 .. 4 ) );
 sep(); show( four_square( 1,2,3,4,8,9,10  ) );
 sep(); show( four_square( 12,2,7,4,8,9,10 ) );
 sep();
-
+say '';
+say 'No assumptions other than integer values.....';
 say '';
 sep(); show( four_square_non_unique( 1..7            ) );
 sep(); show( four_square_non_unique( -2 .. 4         ) );
@@ -65,10 +68,6 @@ sub sep  { say '----------------------------------------------------------------
 sub show { say "@{$_}" foreach @{$_[0]}; }
 
 sub four_square {
-  my @n1 = @_;
-  my @res;
-  my $t = 0;
-     $t+=$_ foreach @n1;
 
 ## For a start we make the observation that
 ##
@@ -94,23 +93,16 @@ sub four_square {
 ## to split the next inequality info a exists & delete as we can do this in one..
 ##
 ## We push any valid results to the array
-  foreach my $b ( @n1 ) {
-    foreach my $f ( my @n2 = grep { $_ - $b } @n1 ) {
-      ## next if $b > $f; ### Check for order here so that we can get rid of dupes
-      foreach my $d ( my @n3 = grep { $_ - $f } @n2 ) {
-        my $n = $t + $b + $d + $f;  ### really 4n...
-        next if $n & 3;             ### n must be a whole number
-        $n/=4;
-        my %X = map { $_ => 1 } @n3;
-        delete $X{$d};
-        my $a = $n-$b;
-        next unless defined delete $X{$a};
-        my $g = $n-$f;
-        next unless defined delete $X{$g};
-        my $c = $a-$d;
-        next unless defined delete $X{$c};
-        my $e = $g-$d;
-        next unless exists $X{$e};
+
+  my ($t,@n1,@res) = (0,@_);
+  $t+=$_ foreach @n1;
+  foreach my $b (        @n1 ) {
+    foreach my $f (   my @n2 = grep { $_ != $b } @n1 ) {
+      foreach my $d ( my @n3 = grep { $_ != $f } @n2 ) {
+        next if (my $n = $t+$b+$d+$f) & 3; ## Really 4n, n must be int
+        my %X = map { $_ == $d ? () : ($_ => 1) } @n3;
+        next unless defined delete $X{my $a = $n/4-$b} && defined delete $X{my $g = $n/4-$f};
+        next unless defined delete $X{my $c = $a-$d}   &&         exists $X{my $e = $g-$d};
         push @res, [ $a, $b, $c, $d, $e, $f, $g ];
       }
     }
@@ -119,11 +111,6 @@ sub four_square {
 }
 
 sub four_square_non_unique {
-  my @n1 = @_;
-  my %res;
-  my $t = 0;
-     $t+=$_ foreach @n1;
-
 ## Now let us make no assumption about the numbers...
 ## We choose 3 from the list...
 ## We then compute n (and check for no remainder)
@@ -136,26 +123,19 @@ sub four_square_non_unique {
 ##            will end up with 2 entries in the list
 ##            where you swap the equivalent values...
 
-  my $check = "@{[ sort @n1 ]}";
+  my ($t,$check,@n1,%res) = (0,"@{[sort @_]}",@_);
+  $t+=$_ foreach @n1;
   foreach my $i ( 0..@n1-1 ) {
-    my $b = $n1[$i];
-    my @n2 = map { $_ == $i ? () : $n1[$_] } 0..@n1-1;
+    my @n2 = @n1;
+    my $b = splice @n2,$i,1;
     foreach my $j ( 0..@n2-1 ) {
-      my $f  = $n2[$j];
-      my @n3 = map { $_ == $i ? () : $n2[$_] } 0..@n2-1;
+      my @n3 = @n2;
+      my $f = splice @n3,$j,1;
       foreach my $k ( 0..@n3-1 ) {
-        my $d = $n3[$k];
-        my $n = $t + $b + $d + $f;
-        next if $n & 3;
-        $n/=4;
-        my $a = $n-$b;
-        my $g = $n-$f;
-        my $c = $a-$d;
-        my $e = $g-$d;
-        my $val =  "@{[ sort $a,$b,$c,$d,$e,$f,$g ]}";
-        next unless $check eq $val;
-        my $key =  "@{[ $a,$b,$c,$d,$e,$f,$g ]}";
-        next if exists $res{$key};
+        next if (my $n = $t + $b + (my $d = $n3[$k]) + $f) & 3;
+        my ( $c, $e ) = ( (my $a = $n/4-$b) - $d, (my $g = $n/4-$f) - $d );
+        next if $check ne "@{[ sort $a,$b,$c,$d,$e,$f,$g ]}" ||
+                exists $res{ my $key = "@{[ $a,$b,$c,$d,$e,$f,$g ]}" };
         $res{$key} = [ $a, $b, $c, $d, $e, $f, $g ];
       }
     }
-- 
cgit