Merge pull request #10020 from jacoby/master

DAJ 267

2 files changed, 98 insertions, 0 deletions

diff --git a/challenge-267/dave-jacoby/perl/ch-1.pl b/challenge-267/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..1096692c0c
--- /dev/null
+++ b/challenge-267/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,33 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ fc postderef say signatures state };
+
+use List::Util qw{ any product };
+
+my @examples = (
+
+    [ -1, -2, -3, -4, 3, 2, 1 ],
+    [ 1,  2,  0,  -2, -1 ],
+    [ -1, -1, 1,  -1, 2 ],
+);
+
+for my $example (@examples) {
+    my $output = product_sign(@$example);
+    my $input  = join ', ', @$example;
+    say <<"END";
+    Input:  \@ints = ($input)
+    Output: $output
+END
+}
+
+sub product_sign (@ints) {
+    if ( any { $_ == 0 } @ints ) {
+        return 0;
+    }
+    if ( ( scalar grep { $_ < 0 } @ints ) % 2 == 0 ) {
+        return 1;
+    }
+    return -1;
+}
diff --git a/challenge-267/dave-jacoby/perl/ch-2.pl b/challenge-267/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..c8d8ffeecc
--- /dev/null
+++ b/challenge-267/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,65 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use experimental qw{ fc say postderef signatures state };
+
+use List::Util qw{sum0};
+
+my @examples = (
+
+    {
+        str    => "abcdefghijklmnopqrstuvwxyz",
+        widths => [
+            10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
+            10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10
+        ]
+    },
+    {
+        str    => "bbbcccdddaaa",
+        widths => [
+            4,  10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10,
+            10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10
+        ]
+    },
+);
+
+for my $example (@examples) {
+    my $str    = $example->{str};
+    my @widths = $example->{widths}->@*;
+    my $widths = join ',', @widths;
+    my @output = line_counts($example);
+    my $output = join ', ', @output;
+
+    say <<"END";
+        Input:  \$str = "$str"
+                \@widths = ($widths) 
+        Output: ($output)
+END
+}
+
+sub line_counts ($obj) {
+    my $str    = $obj->{str};
+    my @widths = $obj->{widths}->@*;
+    my $sub    = make_weight_function(@widths);
+    my $c      = 1;
+    my $line   = '';
+    for my $ch ( split //, $str ) {
+        my $cv = $sub->($ch);
+        my $lv = $sub->($line);
+        if ( $lv + $cv > 100 ) { $line = ''; $lv = $sub->($line); $c++; }
+        $line .= $ch;
+    }
+    return ( $c, $sub->($line) );
+}
+
+sub make_weight_function (@widths) {
+    my @alpha = 'a' .. 'z';
+    state $aw;
+    $aw->%* = map { $alpha[$_] => $widths[$_] } 0 .. 25;
+    return sub ($str) {
+        return sum0 map { $aw->{$_} } split //, $str;
+    };
+    return sub ($str) { return 1 };
+}
+