Perl Weekly Challenge 138.

My solutions (task 1, and task 2 ) to the The Weekly Challenge - 138.

Task 1: Workdays

Submitted by: Mohammad S Anwar
You are given a year, $year in 4-digits form.

Write a script to calculate the total number of workdays in
the given year.

For the task, we consider, Monday - Friday as workdays.

Example 1
Input: $year = 2021
Output: 261
Example 2
Input: $year = 2020
Output: 262

The program I made to solve the previous challenge included code to get the first day of the week and to test if a given year is or not a leap year. Each year has 51 full weeks and 8 or 9 days overlapping two weeks. Those additional days may overlap one weekend, one weekend an one Saturday or one Sunday or two full weekends, dependening on when they start. There are two full weekends for leap years starting on Saturday, one and a half weekends for leap years starting on Friday or Sunday and ordinary years starting in Saturday or Sunday and one weekend for all other cases, as verified with the following table.

M T W T F S S M T W T F S S M
1 2 3 4 5 6 7 8 9            
  1 2 3 4 5 6 7 8 9          
    1 2 3 4 5 6 7 8 9        
      1 2 3 4 5 6 7 8 9      
        1 2 3 4 5 6 7 8 9    
          1 2 3 4 5 6 7 8 9  
            1 2 3 4 5 6 7 8 9

Thus, I can make a table

Leap Days Start Weekends Workdays
yes 366 M-Th 52 262
    F,Sun 52.5 261
    Sat 53 260
no 365 M-F 52 261
    Sat,Sun 52.5 260

I can incorporate this table in an array indexed by leapness and day of the week. Thus a compact solution would be:

perl -Minteger -E ' @w=([(1)x5,0,0],[(2)x4,1,0,1]);foreach(@ARGV){
   $x=$_-1;say "y: $_ wd: ", 260
   +$w[!!(!($_%400)||!($_%4)&&$_%100)][($x+$x/4-$x/100+$x/400)%7]}' 2021 2020

Results:

y: 2021 wd: 261
y: 2020 wd: 262

Of course, I’m ignoring holidays.

A full more readable solution would be:

# Perl weekly challenge 138
# Task 1: Workdays
#
# See https://wlmb.github.io/2021/11/09/PWC138/#task-1-workdays
use v5.12;
use warnings;
use integer;
my @workdays=([261, 261, 261, 261, 261, 260, 260],
              [262, 262, 262, 262, 261, 260, 261]);
foreach(@ARGV){
    my $first_weekday=(($_-1)+($_-1)/4-($_-1)/100+($_-1)/400)%7; # 0=Monday
    my $leap=$_%400==0||$_%4==0&&$_%100!=0;
    say "Year: $_ Workdays: $workdays[$leap][$first_weekday]"
}

Example:

./ch-1.pl 2021 2020

Results:

Year: 2021 Workdays: 261
Year: 2020 Workdays: 262

Task 2: Split Number

Submitted by: Mohammad S Anwar
You are given a perfect square.

Write a script to figure out if the square root the given
number is same as sum of 2 or more splits of the given
number.

Example 1
Input: $n = 81
Output: 1

Since, sqrt(81) = 8 + 1
Example 2
Input: $n = 9801
Output: 1

Since, sqrt(9801) = 98 + 0 + 1
Example 3
Input: $n = 36
Output: 0

Since, sqrt(36) != 3 + 6

I need a routine to split a number in all possible ways. One way to generate all splits is to use a counter and interpret the 1’s of its binary representation as indicators for where to cut the number. Thus, I make two routines, one to obtain all possible ways to split a number and another to return a given split. The rest of the code is simply verifying that the sum of the splits equals the square root.

# Perl weekly challenge 138
# Task 2: Split number
#
# See https://wlmb.github.io/2021/11/09/PWC138/#task-2-split-number
use v5.12;
use warnings;
use integer;
use List::Util qw(sum0);
use POSIX qw(floor);
foreach(@ARGV){
    my $sqrt=floor sqrt($_);
    say("$_ is not a perfect square"),next unless $sqrt**2==$_;
    my @good_splits=grep {sum0(@$_)==$sqrt} splits($_);
    say "Input: $_ Output: ",
        @good_splits
        ?"1 as ".join("=", (map {join "+", @$_} @good_splits), $sqrt)
        :0;
}
sub splits { # array of all possible ways to split a string
    my $string=shift;
    my $counter=0;
    my @splits=();
    while(defined (my $split=one_split($string, $counter++))){
        push @splits, $split;
    }
    return @splits;
}
sub one_split { # produce the n-th way to split a string
    my ($string, $counter)=@_;
    my $length=length $string;
    return if $counter>=2**($length-1);
    my @split=();
    my @binary_counter=split "", sprintf "%0${length}b", $counter;
    my @chars=split "", $string;
    my @current=();
    for(0..$#chars){
        unshift @current, pop @chars;
        if(pop @binary_counter){
            unshift @split, join '', @current;
            @current=();
        }
    }
    unshift @split, join '', @current if @current;
    return [@split];
}

Examples:

./ch-2.pl 81 9801 36

Results:

Input: 81 Output: 1 as 8+1=9
Input: 9801 Output: 1 as 98+01=98+0+1=99
Input: 36 Output: 0

Other examples:

./ch-2.pl  8281 893025 3175524 15

Results:

Input: 8281 Output: 1 as 82+8+1=8+2+81=91
Input: 893025 Output: 1 as 8+930+2+5=945
Input: 3175524 Output: 1 as 3+1755+24=1782
15 is not a perfect square

I can shorten the code if I don’t care about giving explanations for the positive results and by using markers at the positions where the string is to be split, based on the binary bits of the counter, and then using join and split to get the fragments of the number. Thuscode becomes:

# Perl weekly challenge 138
# Task 2: Split number
#
# See https://wlmb.github.io/2021/11/09/PWC138/#task-2-split-number
use v5.12;
use warnings;
use integer;
use List::Util qw(sum0);
use List::MoreUtils qw(pairwise);
use POSIX qw(floor);
N:
    foreach my $N(@ARGV){
        my $sqrt=floor sqrt($N);
        say("$_ is not a perfect square"),next unless $sqrt**2==$N;
        foreach(0..2**(length($N)-1)-1){
            say("Input: $N Output: 1"), next N if sum0(one_split($N,$_))==$sqrt;
        }
        say "Input: $N Output: 0";
}

sub one_split { # produce the n-th way to split a string
    my ($string, $counter)=@_;
    my @binary_counter=map {$_?"-":""}
         split "", sprintf "%0".length($string)."b", $counter;
    my @chars=split "", $string;
    return split "-", join "", pairwise {"$a$b" }@binary_counter, @chars;
}

Example:

./ch-2a.pl 81 9801 36

Results:

Input: 81 Output: 1
Input: 9801 Output: 1
Input: 36 Output: 0

That code is short enough that it can be converted into a five-liner, not quite a one-liner, not quite comprehensible.

perl -d -MList::Util=sum0 -MList::MoreUtils=pairwise -E '@p=("","-");
 N:foreach $N(@ARGV){$s=sqrt $N;foreach(0..2**(length($N)-1)-1){
 $l=length $N;@bc=map {$p[$_]} split "", sprintf "%0${l}b",$_;@c=split "", $N;
 say("N: $N Out: 1"), next N if sum0(split "-", join "",
 pairwise {"$a$b" }@bc, @c)==$s;}say "N: $N Out: 0"}' 81 9801 36

Results:

N: 81 Out: 1
N: 9801 Out: 1
N: 36 Out: 0
Written on November 9, 2021