Solution for ch55, hope everyone's doing alright

2 files changed, 95 insertions, 0 deletions

diff --git a/challenge-055/yet-ebreo/perl/ch-1.pl b/challenge-055/yet-ebreo/perl/ch-1.pl
new file mode 100644
index 0000000000..4884215370
--- /dev/null
+++ b/challenge-055/yet-ebreo/perl/ch-1.pl
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use feature 'say';
+
+my $bin_str = $ARGV[0] || '010';
+my $len = length $bin_str;
+my $num = oct "b$bin_str";
+my @res;
+
+
+for my $L (0..$len-1) {
+    for my $R ($L..$len-1) {
+        my $bin = $num;
+        for my $n ($L..$R) {
+            $bin ^= 1 << $len-$n-1;
+        }
+        push @{$res[(sprintf "%b", $bin)=~y/1//]} , [$L,$R];
+    }
+}
+
+say "Pair of L-R (one's = $#res):";
+for my $pairs (@{$res[-1]}) {
+    say "@{$pairs}";
+}
+
+=begin
+perl .\ch-1.pl 010     
+Pair of L-R (one's = 2):
+0 0
+0 2
+2 2
+
+perl .\ch-1.pl 0101101101
+Pair of L-R (one's = 7):
+0 0
+0 2
+2 2
+5 5
+8 8
+=cut
\ No newline at end of file
diff --git a/challenge-055/yet-ebreo/perl/ch-2.pl b/challenge-055/yet-ebreo/perl/ch-2.pl
new file mode 100644
index 0000000000..37257708ab
--- /dev/null
+++ b/challenge-055/yet-ebreo/perl/ch-2.pl
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+use feature 'say';
+
+
+my @n       = @ARGV ? @ARGV : (1, 2, 3, 4) ;
+
+sub wave {  
+    my ($a,$l,$r) = @_;
+ 
+    if ($l == $r) {
+        if ($a->[1]<=$a->[0]) {
+            #This filter assumes numbers in array @n are unique. 
+            #So, combinations like [2, 2, 1, 4, 3] will not be
+            #generated/printed when given @n = [1, 2, 2, 3, 4]
+            (!grep { 
+                (
+                    ($a->[$_]   >= $a->[$_-1]) && 
+                    ($a->[$_-1] >= $a->[$_-2])
+                ) or (
+                    ($a->[$_]   <= $a->[$_-1]) && 
+                    ($a->[$_-1] <= $a->[$_-2])
+                ) 
+            } 2..$#{$a}) && say "@{$a}";
+        }
+    } else {  
+        for my $i ($l..$r) {  
+            ($a->[$l], $a->[$i]) = ($a->[$i],$a->[$l]);
+            wave($a, $l+1, $r);  
+            ($a->[$l], $a->[$i]) = ($a->[$i],$a->[$l]);
+        }  
+    }  
+}  
+  
+wave(\@n, 0, $#n); 
+=begin
+perl .\ch-2.pl 
+2 1 4 3
+3 2 4 1
+3 1 4 2
+4 2 3 1
+4 1 3 2
+
+perl .\ch-2.pl 1 2 2 3 4
+2 1 3 2 4
+2 1 4 2 3
+2 1 3 2 4
+2 1 4 2 3
+3 2 4 1 2
+3 2 4 1 2
+4 2 3 1 2
+4 2 3 1 2
+=cut