From 9e3df2a3d9e9a407c1aec237af1569f5519d9d5b Mon Sep 17 00:00:00 2001
From: "E. Choroba" <choroba@matfyz.cz>
Date: Tue, 5 May 2020 01:42:20 +0200
Subject: Add E. Choroba's solutions to 059: Linked List & Bit Sum

---
 challenge-059/e-choroba/perl/ch-1.pl | 124 +++++++++++++++++++++++++++++++++++
 challenge-059/e-choroba/perl/ch-2.pl |  45 +++++++++++++
 2 files changed, 169 insertions(+)
 create mode 100755 challenge-059/e-choroba/perl/ch-1.pl
 create mode 100755 challenge-059/e-choroba/perl/ch-2.pl

(limited to 'challenge-059')

diff --git a/challenge-059/e-choroba/perl/ch-1.pl b/challenge-059/e-choroba/perl/ch-1.pl
new file mode 100755
index 0000000000..6cfaa7da3f
--- /dev/null
+++ b/challenge-059/e-choroba/perl/ch-1.pl
@@ -0,0 +1,124 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+{   package My::Node;
+
+    sub new {
+        my ($class, $value) = @_;
+        bless [ $value, undef ], $class
+    }
+
+    sub Next { $_[0][1] }
+
+    sub value { $_[0][0] }
+
+    sub disconnect {
+        my ($self) = @_;
+        my $next = $self->Next;
+        undef $self->[1];
+        return $next
+    }
+
+    sub attach {
+        my ($self, $new_next) = @_;
+        die "Already attached" if defined $self->Next;
+
+        $self->[1] = $new_next;
+    }
+
+    sub Last {
+        my ($self) = @_;
+        my $node = $self;
+        $node = $node->Next while $node->Next;
+        return $node
+    }
+
+    sub append {
+        my ($self, $new) = @_;
+        if (defined $new) {
+            $new->Last->attach($self);
+        } else {
+            $_[1] = $self;
+        }
+    }
+
+}
+
+{   package My::LinkedList;
+
+    sub new {
+        my ($class, @list) = @_;
+        my $top;
+        while (@list) {
+            my $value = pop @list;
+            my $node = 'My::Node'->new($value);
+            $node->attach($top) if $top;
+            $top = $node;
+        }
+        bless { head => $top }, $class
+    }
+
+    sub head {
+        my ($self, $head) = @_;
+        $self->{head} = $head if @_ > 1;
+        return $self->{head}
+    }
+
+    sub Values {
+        my ($self) = @_;
+        my $node = $self->head;
+        my @values;
+        while ($node) {
+            push @values, $node->value;
+            $node = $node->Next;
+        }
+        return \@values
+    }
+
+    sub partition {
+        my ($self, $k) = @_;
+        my $node = $self->head;
+        my ($head, $tail);
+        while ($node) {
+            my $next = $node->disconnect;
+            $node->append($node->value >= $k ? $tail : $head);
+            $node = $next;
+        }
+        $tail->append($head) if $head && $tail;
+        $_[0]{head} = $head || $tail;
+    }
+}
+
+use Test::More;
+
+my $head = 'My::Node'->new(2);
+my $body = 'My::Node'->new(1);
+my $list = 'My::LinkedList'->new;
+$list->head($head);
+$head->attach($body);
+
+is_deeply $list->Values, [2, 1], 'values';
+$list->partition(2);
+is_deeply $list->Values, [1, 2], 'pair partition';
+
+
+my $ll = 'My::LinkedList'->new(1, 4, 3, 2, 5, 2);
+is_deeply $ll->Values, [1, 4, 3, 2, 5, 2], 'constructor args';
+
+
+$ll->partition(3);
+is_deeply $ll->Values, [1, 2, 2, 4, 3, 5], 'sample partition';
+
+my $repeated = 'My::LinkedList'->new(1, 2, 3, 1, 2, 3);
+$repeated->partition(2);
+is_deeply $repeated->Values, [1, 1, 2, 3, 2, 3], 'repeated';
+
+my $short = 'My::LinkedList'->new(1);
+$short->partition(1);
+is_deeply $short->Values, [1], 'short';
+
+$short->partition(2);
+is_deeply $short->Values, [1], 'short over';
+
+done_testing();
diff --git a/challenge-059/e-choroba/perl/ch-2.pl b/challenge-059/e-choroba/perl/ch-2.pl
new file mode 100755
index 0000000000..6eee2084c1
--- /dev/null
+++ b/challenge-059/e-choroba/perl/ch-2.pl
@@ -0,0 +1,45 @@
+#!/usr/bin/perl
+use warnings;
+use strict;
+
+sub diff_bits {
+    my ($x, $y) = @_;
+    my ($bx, $by) = map { pack 'N', $_ } $x, $y;
+    return unpack '%32b*', $bx ^ $by
+}
+
+sub chain_diff_bits {
+    my (@list) = @_;
+    my $s = 0;
+    for my $i (0 .. $#list - 1) {
+        for my $j ($i + 1 .. $#list) {
+            $s += diff_bits($list[$i], $list[$j]);
+        }
+    }
+    return $s
+}
+
+use Test::More;
+
+is diff_bits(0, 0), 0, 'd 0 0';
+is diff_bits(0, 1), 1, 'd 0 1';
+is diff_bits(0, 2), 1, 'd 0 2';
+is diff_bits(0, 3), 2, 'd 0 3';
+is diff_bits(0, 255), 8, 'd 0 255';
+is diff_bits(255, 256), 9, 'd 255 256';
+is diff_bits(113, 68), 4, 'd 113 68';
+
+is chain_diff_bits(2, 3, 4), 6, 'chain 2 3 4';
+is chain_diff_bits(89, 106, 116), 12, 'chain 89, 106, 116';
+
+=heading1 Last test explained
+
+   89 | 1 1 1 0 1 0 0
+  106 | 1 1 0 1 0 1 0
+  116 | 1 0 1 1 0 0 1
+   ---+--------------
+        0+2+2+2+2+2+2 = 12
+
+=cut
+
+done_testing();
-- 
cgit