Merge pull request #3708 from boblied/master

Bob Lied solutions for PWC 103

7 files changed, 530 insertions, 2 deletions

diff --git a/challenge-102/bob-lied/c/ch-1.c b/challenge-102/bob-lied/c/ch-1.c
new file mode 100644
index 0000000000..1ff39d59ec
--- /dev/null
+++ b/challenge-102/bob-lied/c/ch-1.c
@@ -0,0 +1,82 @@
+/* vim:set ts=4 sw=4 sts=4 et ai wm=0 nu syntax=c: */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <math.h>
+
+int verbose = 1;
+
+int mightBeRare[10]   = { 1, 0, 1, 1, 0, 1, 0, 1, 1, 0 };
+
+int mightBeSquare[10] = { 1, 1, 0, 0, 1, 1, 1, 0, 0, 1 };
+
+long
+reverse(long r)
+{
+    long r1 = 0;
+    while ( r )
+    {
+        r1 = r1 * 10 + r%10;
+        r /= 10;
+    }
+    return r1;
+}
+
+
+int
+main(int argc, char **argv)
+{
+    int N;
+
+    N = atoi(argv[1]);
+
+    int isNodd = N % 2;
+
+    long scale = pow(10, (N-1));
+    long endOfRange = pow(10, N);
+
+    for ( long r = scale ; r < endOfRange ; r++ )
+    {
+        // Rare numbers can never start with an odd digit.
+        if ( (r / scale ) % 2 )
+        {
+            r += scale;
+        }
+
+// if ( r % 10000000 == 0 ) printf("%ld\n", r);
+
+        if ( ! mightBeRare[ r % 10 ] )
+        {
+            continue;
+        }
+
+        long r1 = reverse(r);
+
+        long y2 = r - r1;
+        if ( y2 < 0 ) continue; // Can't be a square
+
+        long x2 = r + r1;
+
+        if ( !( mightBeSquare[ x2%10]  &&  mightBeSquare[ y2%10 ] ) )  continue;
+
+        if ( isNodd )
+        {
+            if ( y2 % 1089 ) continue;
+        }
+        else
+        {
+            if ( x2 % 121 ) continue;
+        }
+
+        double x = sqrt(x2);
+        if ( x != (long)(x) ) continue;
+
+        double y = sqrt(y2);
+        if ( y != (long)(y) ) continue;
+
+        printf("N=%d R=%ld\n", N, r);
+    }
+
+
+    exit(0);
+}
diff --git a/challenge-102/bob-lied/perl/ch-1.pl b/challenge-102/bob-lied/perl/ch-1.pl
new file mode 100755
index 0000000000..4b9007cd1d
--- /dev/null
+++ b/challenge-102/bob-lied/perl/ch-1.pl
@@ -0,0 +1,154 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl
+#=============================================================================
+# Copyright (c) 2021, Bob Lied
+#=============================================================================
+# Perl Weekly Challenge 102, Task #1, Rare Numbers
+#
+# You are given a positive integer $N.
+# Write a script to generate all Rare numbers of size $N if exists.
+# http://www.shyamsundergupta.com/rare.htm
+# The web site lists several constraints that can be used to limit the search.
+# Also discussed at https://rosettacode.org/wiki/Talk:Rare_numbers
+# Examples
+# (a) 2 digits: 65
+# (b) 6 digits: 621770
+# (c) 9 digits: 281089082
+#
+# From the reference web site:
+# The numbers, which gives a perfect square on adding as well as subtracting
+# its reverse are rare and hence termed as Rare Numbers.
+# 
+# If R is a positive integer and R1 is the integer obtained from R by writing
+# its decimal digits in reverse order, then if R + R1 and R - R1 both are
+# perfect square then R is termed as Rare Number.
+# 
+# So for R to be a Rare Number we must have
+# R + R1 = X^2 and R - R1 = Y^2
+# 
+# For example: For R=65, R1=56
+# R+R1 = 65+56 = 121 = 11^2   AND    R-R1 = 65 - 56 = 9 = 3^2
+#
+#=============================================================================
+
+use strict;
+use warnings;
+use 5.020;
+
+use experimental qw/ signatures /;
+
+use Getopt::Long;
+
+my $doTest = 0;
+my $verbose = 0;
+GetOptions("test" => \$doTest, "verbose" => \&verbose);
+
+my $N = shift;
+
+# On my MacBook M1, perl 5.32, 8 takes about 7 seconds and 9 takes about 1:15
+# 10 is probably feasible, maybe 11 for the giftedly patient, but beyond that
+# needs some kind of parallelism or an algorithm I wasn't able to think of.
+die Usage() unless defined $N && $N > 1 && $N < 20;
+warn "Expect this to take a long time ..." if $N > 8;
+
+# The last digit can never be 1,4,6,9
+my @mightBeRare   = ( 1, 0, 1, 1, 0, 1, 0, 1, 1, 0 );
+
+# A perfect square can never end in 2,3,7,8
+my @mightBeSquare = ( 1, 1, 0, 0, 1, 1, 1, 0, 0, 1 );
+
+my $isNodd = $N % 2;    # Optimization possible for even or odd digits.
+
+# Cache results of square root test here.
+my %knownSquare;
+
+# For example, if N = 3, max is 1000, but we want 100 at a time.
+my $scale = 10**($N-1);
+
+# Rare numbers can never start with an odd digit, so work on
+# only groups that start with an even digit.
+# Creates pairs of start and end.
+my @boundary = map { [ $_ * 2 * $scale, $_ * 2 * $scale + $scale - 1 ] } 1..4;
+
+# Use faster integer math everywhere except where we need the square root.
+use integer;
+
+for my $bound ( @boundary )
+{
+    my $endOfRange = $bound->[1];   # Hoist array access out of loop processing.
+    R: for ( my $r = $bound->[0] ; $r <= $endOfRange ; $r++ )
+    {
+        # say "$r ", scalar(time()) if $r % 10000000 == 0; # Progress mark
+
+        # The last digit can never be 1,4,6,9
+        next unless $mightBeRare[ $r%10 ];
+
+        my $r1;
+        $r1 = reverse($r);   # String beats math
+       ##{   use integer;
+       ##    my $n = $r; $r1 = 0;
+       ##    while ( $n )
+       ##    {
+       ##        $r1 = $r1 * 10 + $n%10;
+       ##        $n /= 10;
+       ##    }
+       ##}
+
+        my $y2 = $r - $r1;
+        next if $y2 < 0;    # No imaginary numbers.
+        next unless $mightBeSquare[ $y2 % 10];
+
+        my $x2 = $r + $r1;
+        next unless $mightBeSquare[ $x2 % 10];
+
+        # If R consist of odd number of digits, then R-R1 must be divisible by 11.
+        # Since R-R1 is always divisible by 9, So 1089 (33^2) must be a factor of Y2.
+        # 
+        # If R consist of even number of digits, then R+R1 must be divisible by 11,
+        # So 121 must be a factor of X2.
+        if ( $isNodd )
+        {
+            next if $y2 % 1089;
+        }
+        else
+        {
+            next if $x2 % 121;
+        }
+
+        # Save the expensive square root computation for last.
+
+        # Caching wasn't effective.  Either the overhead of hash lookup was not
+        # much better than the cost of the sqrt function, or there aren't many
+        # cache hits.  And memory could blow up for large N.
+      # if ( exists $knownSquare{$x2} )
+      # {
+      #     next unless $knownSquare{$x2};
+      # }
+      # else
+      # {
+      #     my $x = sqrt($x2);
+      #     next unless ($knownSquare{$x2} = (int($x) == $x));
+      # }
+
+      # if ( exists $knownSquare{$y2} )
+      # {
+      #     next unless $knownSquare{$y2};
+      # }
+      # else
+      # {
+      #     my $y = sqrt($y2);
+      #     next unless ($knownSquare{$y2} = (int($y) == $y));
+      # }
+
+        { no integer;
+            my $x = sqrt($x2);
+            next R unless int($x) == $x;
+            my $y = sqrt($y2);
+            next R unless int($y) == $y;
+        }
+
+        say "R: $r";
+    }
+}
diff --git a/challenge-103/bob-lied/README b/challenge-103/bob-lied/README
index 5d63db13d1..8417e3a7f7 100644
--- a/challenge-103/bob-lied/README
+++ b/challenge-103/bob-lied/README
@@ -1,3 +1,3 @@
-Solutions to weekly challenge 102 by Bob Lied.
+Solutions to weekly challenge 103 by Bob Lied.
 
-https://perlweeklychallenge.org/blog/perl-weekly-challenge-102/
+https://perlweeklychallenge.org/blog/perl-weekly-challenge-103/
diff --git a/challenge-103/bob-lied/perl/ch-1.pl b/challenge-103/bob-lied/perl/ch-1.pl
new file mode 100755
index 0000000000..80ea20934b
--- /dev/null
+++ b/challenge-103/bob-lied/perl/ch-1.pl
@@ -0,0 +1,41 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-1.pl
+#=============================================================================
+# Copyright (c) 2021, Bob Lied
+#=============================================================================
+# Perl Weekly Challenge 103, TASK #1 › Chinese Zodiac
+#
+# You are given a year $year.
+# Write a script to determine the Chinese Zodiac for the given year $year.
+# Please check out wikipage for more information about it.
+#
+# The animal cycle: Rat, Ox, Tiger, Rabbit, Dragon, Snake, Horse, Goat, Monkey,
+# Rooster, Dog, Pig.
+# The element cycle: Wood, Fire, Earth, Metal, Water.
+#
+# Example 1: Input: 2017    Output: Fire Rooster
+# Example 2: Input: 1938    Output: Earth Tiger
+#=============================================================================
+
+use strict;
+use warnings;
+use 5.020;
+
+use experimental qw/signatures/;
+
+my @AnimalCycle = qw( Rat Ox Tiger Rabbit Dragon Snake Horse Goat Monkey Rooster Dog Pig );
+my @ElementCycle = qw( Wood Wood Fire Fire Earth Earth Metal Metal Water Water );
+
+my $BaseYear = 1924;
+
+my $year = shift;
+die "Usage: $0 YEAR\n" unless $year;
+
+my $relativeYear = $year - $BaseYear;
+
+my  $animal = $relativeYear % @AnimalCycle;
+my $element = $relativeYear % @ElementCycle;
+
+say "$ElementCycle[$element] $AnimalCycle[$animal]";
diff --git a/challenge-103/bob-lied/perl/ch-2.pl b/challenge-103/bob-lied/perl/ch-2.pl
new file mode 100755
index 0000000000..3b3ce8ee66
--- /dev/null
+++ b/challenge-103/bob-lied/perl/ch-2.pl
@@ -0,0 +1,160 @@
+#!/usr/bin/env perl
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# ch-2.pl
+#=============================================================================
+# Copyright (c) 2021, Bob Lied
+#=============================================================================
+# Perl Weekly Challeng 103, Task #2, What's playing?
+#
+# Working from home, you decided that on occasion you wanted some background
+# noise while working. You threw together a network streamer to continuously
+# loop through the files and launched it in a tmux (or screen) session, giving
+# it a directory tree of files to play. During the day, you connected an audio
+# player to the stream, listening through the workday, closing it when done.
+#
+# For weeks you connect to the stream daily, slowly noticing a gradual drift
+# of the media. After several weeks, you take vacation. When you return, you
+# are pleasantly surprised to find the streamer still running. Before
+# connecting, however, if you consider the puzzle of determining which track
+# is playing.
+#
+# After looking at a few modules to read info regarding the media, a quick bit
+# of coding gave you a file list. The file list is in a simple CSV format,
+# each line containing two fields: the first the number of milliseconds in
+# length, the latter the media’s title
+#
+# For this script, you can assume to be provided the following information:
+#    * the value of $^T ($BASETIME) of the streamer script,
+#    * the value of time(), and
+#    * a CSV file containing the media to play consisting of the length in
+#      milliseconds and an identifier for the media (title, filename, or other).
+#
+# Write a program to output which file is currently playing. For purposes of
+# this script, you may assume gapless playback, and format the output as you
+# see fit.
+# Optional: Also display the current position in the media as a time-like value.
+#
+# Example: Input starttime   currenttime  filelist.csv
+#                1606134123  1614591276   episode.csv
+# Output:
+# "Les Miserables Episode 1: The Bishop (broadcast date: 1937-07-23)"
+# 00:10:24
+# 
+#=============================================================================
+
+use strict;
+use warnings;
+use v5.32;
+
+use experimental qw/signatures/;
+no warnings qw/experimental::signatures/;
+
+use Getopt::Long;
+my $verbose = 0;
+my $doTest = 0;
+
+use FindBin qw($Bin);
+use lib "$FindBin::Bin";
+use lib "$FindBin::Bin/lib";
+
+# Using this as an excuse to use Moo
+use PlayList;
+
+GetOptions("test" => \$doTest, "verbose" => \$verbose);
+
+exit(!runTest()) if $doTest;
+
+sub Usage() { "Usage: $0 startTS endTS file.csv" }
+
+my $startTS = shift;
+my $endTS   = shift;
+my $file    = shift;
+die Usage() unless defined $startTS && defined $endTS && defined $file;
+die Usage(), " start > end" if $startTS > $endTS;
+
+my $playList = PlayList->new( fileName  => $file );
+use Data::Dumper;
+# say Dumper($playList);
+
+# Because the time is in seconds and track time is in millisconds, there's
+# a possibility that we could switch tracks in that second.  Specifications
+# are ambiguous, so do the simplest that works -- use the start of the second.
+my $playTime = ($endTS - $startTS) * 1000; # In milliseconds
+
+my ($track, $timeIntoTrack, $timeIntoCycle) = $playList->playingAt($playTime);
+# time is in millisconds
+
+# Turn a time in milliseconds into format "HH:MM:SS", dropping fractional seconds.
+sub posFormat($pos)
+{
+    use integer;
+    my ($hours, $minutes, $seconds) = (0, 0, 0);
+    $pos /= 1000; # Now in seconds
+    $hours = $pos / 3600;
+    $pos %= 3600;
+    $minutes = $pos / 60;
+    $seconds = $pos % 60;
+
+    return sprintf("%02d:%02d:%02d", $hours, $minutes, $seconds);
+}
+
+say $track;
+say posFormat($timeIntoTrack), " in episode";
+say posFormat($timeIntoCycle), " in cycle of ", posFormat($playList->length);
+
+sub runTest()
+{
+    use Test::More;
+
+    my $pl = PlayList->new(fileName => "episode.csv");
+    is( $pl->length(), 11910604, "Total length");
+
+    my ($track, $songTime, $cycleTime) = $pl->playingAt(0);
+    is( $track, "Les Miserables Episode 1: The Bishop (broadcast date: 1937-07-23)", , "track at 0 ms");
+    is( posFormat($songTime), "00:00:00", "Time at 0 ms");
+    is( posFormat($cycleTime), "00:00:00", "Cycle at 0 ms");
+
+    ($track, $songTime, $cycleTime) = $pl->playingAt(1);
+    is( $track, "Les Miserables Episode 1: The Bishop (broadcast date: 1937-07-23)", , "track at 1 ms");
+    is( posFormat($songTime), "00:00:00", "Time at 1 ms");
+    is( posFormat($cycleTime), "00:00:00", "Cycle at 1 ms");
+
+    ($track, $songTime, $cycleTime) = $pl->playingAt(1000);
+    is( $track, "Les Miserables Episode 1: The Bishop (broadcast date: 1937-07-23)", , "track at 1 sec");
+    is( posFormat($songTime), "00:00:01", "Time at 1 sec");
+    is( posFormat($cycleTime), "00:00:01", "Cycle at 1 sec");
+
+    ($track, $songTime, $cycleTime) = $pl->playingAt(1709000);
+    is( $track, "Les Miserables Episode 1: The Bishop (broadcast date: 1937-07-23)", , "track at 1709 sec");
+    is( posFormat($songTime), "00:28:29", "Time at 1709 sec");
+    is( posFormat($cycleTime), "00:28:29", "Cycle at 1 sec");
+
+    ($track, $songTime, $cycleTime) = $pl->playingAt(1709362);
+    is( $track, "Les Miserables Episode 1: The Bishop (broadcast date: 1937-07-23)", , "track at 1709.362 sec");
+    is( posFormat($songTime), "00:28:29", "Time at 1709.362 sec");
+
+    ($track, $songTime, $cycleTime) = $pl->playingAt(1709363);
+    is( $track, "Les Miserables Episode 2: Javert (broadcast date: 1937-07-30)", , "track at 1709.363 sec");
+    is( posFormat($songTime), "00:00:00", "Time at 1710 sec");
+
+    ($track, $songTime, $cycleTime) = $pl->playingAt(1709363);
+    is( $track, "Les Miserables Episode 2: Javert (broadcast date: 1937-07-30)", , "track at 1709.363 sec");
+    is( posFormat($songTime), "00:00:00", "Time at 1709.363 sec");
+
+    ($track, $songTime, $cycleTime) = $pl->playingAt(1800000);
+    is( $track, "Les Miserables Episode 2: Javert (broadcast date: 1937-07-30)", , "track at 1800 sec");
+    is( posFormat($songTime), "00:01:30", "Time at 1800 sec");
+
+    ($track, $songTime, $cycleTime) = $pl->playingAt(24*3600*1000);
+    is( $track, "Les Miserables Episode 2: Javert (broadcast date: 1937-07-30)", , "track at 1 day");
+    is( posFormat($songTime), "00:21:56", "Time at 1 day");
+    is( posFormat($cycleTime), "00:50:25", "Cycle at 1 day");
+
+    ($track, $songTime, $cycleTime) = $pl->playingAt(30*24*3600*1000);
+    is( $track, "Les Miserables Episode 5: The Grave (broadcast date: 1937-08-20)", , "track at 30 day");
+    is( posFormat($songTime), "00:09:23", "Time at 30 day");
+    is( posFormat($cycleTime), "02:03:18", "Cycle at 30 day");
+
+    done_testing;
+}
diff --git a/challenge-103/bob-lied/perl/episode.csv b/challenge-103/bob-lied/perl/episode.csv
new file mode 100644
index 0000000000..9428b93004
--- /dev/null
+++ b/challenge-103/bob-lied/perl/episode.csv
@@ -0,0 +1,7 @@
+1709363,"Les Miserables Episode 1: The Bishop (broadcast date: 1937-07-23)"
+1723781,"Les Miserables Episode 2: Javert (broadcast date: 1937-07-30)"
+1723781,"Les Miserables Episode 3: The Trial (broadcast date: 1937-08-06)"
+1678356,"Les Miserables Episode 4: Cosette (broadcast date: 1937-08-13)"
+1646043,"Les Miserables Episode 5: The Grave (broadcast date: 1937-08-20)"
+1714640,"Les Miserables Episode 6: The Barricade (broadcast date: 1937-08-27)"
+1714640,"Les Miserables Episode 7: Conclusion (broadcast date: 1937-09-03)"
diff --git a/challenge-103/bob-lied/perl/lib/PlayList.pm b/challenge-103/bob-lied/perl/lib/PlayList.pm
new file mode 100644
index 0000000000..3ee27cb770
--- /dev/null
+++ b/challenge-103/bob-lied/perl/lib/PlayList.pm
@@ -0,0 +1,84 @@
+# vim:set ts=4 sw=4 sts=4 et ai wm=0 nu:
+#=============================================================================
+# PlayList.pm
+#=============================================================================
+# Copyright (c) 2021, Bob Lied
+#=============================================================================
+
+use strict;
+use warnings;
+use v5.32;
+
+no warnings qw/experimental::signatures/;
+use feature qw/signatures/;
+
+
+package PlayList;
+{
+    use Moo;
+    use Carp qw/confess/;
+    use Data::Dumper;
+
+    has fileName => (
+        is  => 'ro',
+        required => 1,
+        isa => sub { my $f = shift;
+            -r $f || confess "Can't read file $f: $!" },
+    );
+
+    has list => (
+        is => 'rw',
+        default => sub { [] },
+    );
+
+    has length => (
+        is => 'rw',
+        default => 0,
+    );
+
+no warnings qw/experimental::signatures/;
+    sub BUILD($self, $args)
+    {
+        $self->_loadFile();
+        $self->_calcLength();
+    }
+
+no warnings qw/experimental::signatures/;
+    sub _loadFile($self)
+    {
+        use Text::CSV qw/csv/;
+
+        $self->list( csv(in => $self->fileName, headers => [ qw(time title) ]) );
+
+    }
+
+    no warnings qw/experimental::signatures/;
+    sub _calcLength($self)
+    {
+        my $len = 0;
+        for my $track ( $self->list->@* )
+        {
+            $len += $track->{time};
+        }
+        $self->length($len);
+    }
+
+    sub playingAt($self, $cycleTime)
+    {
+        my $len = 0;
+        $cycleTime %= $self->length;
+        for my $track ( $self->list->@* )
+        {
+            if ( $cycleTime >= $len && $cycleTime < $len + $track->{time} )
+            {
+                my $trackTitle = $track->{title};
+                my $intoTrack = $cycleTime - $len;
+
+                return ( $trackTitle, $intoTrack, $cycleTime);
+            }
+            $len += $track->{time};
+        }
+    }
+}
+
+1;