Solve 068: Zero Matrix & Reorder List by E. Choroba

2 files changed, 80 insertions, 0 deletions

diff --git a/challenge-068/e-choroba/perl5/ch-1.pl b/challenge-068/e-choroba/perl5/ch-1.pl
new file mode 100755
index 0000000000..da15d2f5ef
--- /dev/null
+++ b/challenge-068/e-choroba/perl5/ch-1.pl
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+use PDL;
+
+sub zero_matrix {
+    my ($matrix) = @_;
+    my $pdl = pdl($matrix);
+    return unpdl(andover($pdl->xchg(0,1)) * transpose(andover($pdl)))
+}
+
+use Test::More tests => 2;
+
+is_deeply zero_matrix([[1, 0, 1], [1, 1, 1], [1, 1, 1]]),
+          [[0, 0, 0],[1, 0, 1],[1, 0, 1]];
+
+is_deeply zero_matrix([[1, 0, 1], [1, 1, 1], [1, 0, 1]]),
+          [[0, 0, 0], [1, 0, 1], [0, 0, 0]];
diff --git a/challenge-068/e-choroba/perl5/ch-2.pl b/challenge-068/e-choroba/perl5/ch-2.pl
new file mode 100755
index 0000000000..7e81ecbccc
--- /dev/null
+++ b/challenge-068/e-choroba/perl5/ch-2.pl
@@ -0,0 +1,61 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+use feature qw{ say };
+
+{   package My::Node;
+    sub new { bless { value => $_[1] }, $_[0] }
+    sub set_next { $_[0]->{next} = $_[1] }
+
+    sub serialize {
+        my ($self) = @_;
+        my $n = $self;
+        my @s;
+        while (defined $n) {
+            push @s, $n->{value};
+            $n = $n->{next}
+        }
+        @s
+    }
+
+    sub new_from_list {
+        my ($class, @values) = @_;
+        my $self = bless { value => shift @values }, $class;
+        my $last = $self;
+        for (@values) {
+            my $next = $class->new($_);
+            $last->set_next($next);
+            $last = $next;
+        }
+        return $self
+    }
+
+    sub reorder {
+        my ($self) = @_;
+        my $current = $self;
+        while ($current) {
+            my $last = $current;
+            my $last_but_one;
+            while ($last->{next}) {
+                $last_but_one = $last;
+                $last = $last->{next};
+            }
+
+            undef $last_but_one->{next};
+            my $next = $current->{next};
+            $current->set_next($last);
+            $last->set_next($next);
+            $current = $next;
+        }
+    }
+}
+
+use Test::More tests => 2;
+
+my $list = 'My::Node'->new_from_list(1 .. 4);
+$list->reorder;
+is_deeply [$list->serialize], [1, 4, 2, 3];
+
+my $list2 = 'My::Node'->new_from_list(1 .. 5);
+$list2->reorder;
+is_deeply [$list2->serialize], [1, 5, 2, 4, 3];