Merge pull request #5269 from jacoby/master

Did 140

3 files changed, 89 insertions, 0 deletions

diff --git a/challenge-140/dave-jacoby/blog.txt b/challenge-140/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..c4e4dd81ca
--- /dev/null
+++ b/challenge-140/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2021/11/22/table-it-yes-or-no-the-weekly-challenge-140.html
diff --git a/challenge-140/dave-jacoby/perl/ch-1.pl b/challenge-140/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..87d78894d8
--- /dev/null
+++ b/challenge-140/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,55 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say state postderef signatures };
+no warnings qw{ experimental };
+
+my @examples;
+push @examples, [ 11,  1,  100 ];
+push @examples, [ 101, 1,  110 ];
+push @examples, [ 100, 11, 111 ];
+
+for my $example (@examples) {
+    my ( $a, $b, $solution ) = $example->@*;
+    my $c = add_binary( $a, $b );
+    my $d = real_add_binary( $a, $b );
+    say <<"END";
+    Input: \$a = $a; \$b = $b
+    Output: $c
+    We know by:  $d 
+    And also by: $solution
+END
+}
+
+sub add_binary ( $a, $b ) {
+    my @output;
+    my $r = 0;
+    my @a = split //, $a;
+    my @b = split //, $b;
+
+    while ( @a || @b ) {
+        my $wa = pop @a;
+        my $wb = pop @b;
+        $wa //= 0;
+        $wb //= 0;
+        my $sum = $wa + $wb + $r;
+        $r = $sum > 1 ? 1 : 0 ;
+        unshift @output, $sum % 2? 0 : 1;
+    }
+    unshift @output, 1 if $r;
+    return join '', @output;
+}
+
+sub real_add_binary ( $a, $b ) {
+
+    # convert from binary to decimal
+    my $ra = oct( '0b' . $a );
+    my $rb = oct( '0b' . $b );
+
+    # decimal addition?
+    my $rc = $ra + $rb;
+
+    # reconversion and return
+    return sprintf '%b', $rc;
+}
diff --git a/challenge-140/dave-jacoby/perl/ch-2.pl b/challenge-140/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..514b95b321
--- /dev/null
+++ b/challenge-140/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use feature qw{ say postderef signatures state };
+no warnings qw{ experimental };
+
+my @examples;
+push @examples, [ 2, 3, 4 ];
+push @examples, [ 3, 3, 6 ];
+
+for my $example (@examples) {
+    my $element = solve_task_2( $example->@* );
+    say <<"END";
+    Input:  \$i = $example->[0]; \$j = $example->[1]; \$k = $example->[2] 
+    Output: $element
+END
+}
+
+sub solve_task_2 ( $i, $j, $k ) {
+    my @table;
+    for my $x ( 1 .. $i ) {
+        for my $y ( 1 .. $j ) {
+            $table[ $x - 1 ][ $y - 1 ] = $x * $y;
+        }
+    }
+    my @array = sort { $a <=> $b } flatten(@table);
+    return $array[ $k - 1 ] || -1;
+}
+
+sub flatten ( @two_d_array ) {
+    return map { $_->@* } @two_d_array;
+}