Streaming Basketball Scores

3 files changed, 92 insertions, 0 deletions

diff --git a/challenge-122/dave-jacoby/blog.txt b/challenge-122/dave-jacoby/blog.txt
new file mode 100644
index 0000000000..5d7ade87b0
--- /dev/null
+++ b/challenge-122/dave-jacoby/blog.txt
@@ -0,0 +1 @@
+https://jacoby.github.io/2021/07/19/streams-and-scores-the-weekly-challenge-121.html
diff --git a/challenge-122/dave-jacoby/perl/ch-1.pl b/challenge-122/dave-jacoby/perl/ch-1.pl
new file mode 100644
index 0000000000..1094bd54ab
--- /dev/null
+++ b/challenge-122/dave-jacoby/perl/ch-1.pl
@@ -0,0 +1,56 @@
+#!/usr/bin/env perl
+
+use feature qw{say state signatures};
+use strict;
+use warnings;
+use utf8;
+no warnings qw{ experimental };
+
+use Carp;
+use Getopt::Long;
+use List::Util qw{sum0};
+
+my ( $start, $end, $leap ) = ( 1, 2, 1 );
+GetOptions(
+    'start=i' => \$start,
+    'end=i'   => \$end,
+    'leap=i'  => \$leap,
+);
+croak 'Bad input' if $start >= $end || $start < 1 || $leap < 1;
+
+my $streamer = factory( $start, $end, $leap );
+my $z        = 0;
+while ( $z = $streamer->() ) {
+    last unless defined $z;
+    stream_avg($z);
+}
+
+sub stream_avg ($n) {
+    state $arr = [];
+    push $arr->@*, $n;
+    my $cnt = scalar $arr->@*;
+    if ( $cnt == 1 ) {
+        say qq{Average of first number is $n};
+    }
+    else {
+        my $sum = sum0 $arr->@*;
+        my $str = join '+', $arr->@*;
+        my $avg = ($sum) / $cnt;
+        say qq{Average of first $cnt numbers ($str)/$cnt = $avg};
+    }
+}
+
+sub factory ( $start, $end, $input ) {
+    say <<"END";
+    START   $start
+    END     $end
+    LEAP    $leap
+END
+    return sub {
+        state $c = $start;
+        my $d = $c;
+        $c += $leap;
+        return undef if $d > $end;
+        return $d;
+    }
+}
diff --git a/challenge-122/dave-jacoby/perl/ch-2.pl b/challenge-122/dave-jacoby/perl/ch-2.pl
new file mode 100644
index 0000000000..cf5c730134
--- /dev/null
+++ b/challenge-122/dave-jacoby/perl/ch-2.pl
@@ -0,0 +1,35 @@
+#!/usr/bin/env perl
+
+use feature qw{say state signatures};
+use strict;
+use warnings;
+use utf8;
+no warnings qw{ experimental };
+
+use JSON;
+my $json = JSON->new->pretty->canonical;
+
+use List::Util qw{  sum0 };
+for my $s ( 1 .. 10 ) {
+    my @x = bball($s);
+    say qq{INPUT:\t\$s = $s};
+    say join "\t", "OUTPUT:", map { qq{$_\n}} @x;
+}
+
+sub bball ( $n = 5, $s = [] ) {
+    my $sum = sum0 $s->@*;
+    return undef if $sum > $n;
+    return join ' ', $s->@* if $sum == $n;
+    my @output;
+    for my $i ( 1 .. 3 ) {
+        my $x->@* = $s->@*;
+        push $x->@*, $i;
+        my @local = bball( $n, $x );
+        for my $l (@local) {
+            next unless defined $l;
+            next if ref $l eq 'ARRAY';
+            push @output, $l;
+        }
+    }
+    return @output;
+}