laurent_r

These are some answers to the Week 138 of the Perl Weekly Challenge organized by Mohammad S. Anwar.

Spoiler Alert: This weekly challenge deadline is due in a few days from now (on November 14, 2021 at 24:00). This blog post offers some solutions to this challenge, please don’t read on if you intend to complete the challenge on your own.

Task 1: Workdays

*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

A year has 52 weeks, plus one or two days (when the year is leap). So, we will have 5 * 52 = 260 work days, plus 0, 1, or 2 days. So we basically start with 260 work days and add one if Dec. 31 falls on a week day, plus another work day if the year is leap and if Dec. 30 falls on a week day.

Workdays in Raku

In Raku, we start with Jan. 1 of the input year and add 52 weeks to it. The later of the Dateish role will happily compute the date 52 weeks after Jan. 1 and accurately take care of leap years, so that it will return Dec. 30 on leap years and Dec. 31 on other years. It is then only a matter to find out is these dates fall on week days.

sub work-days (UInt $y) {
    my $new-year-day = Date.new("$y-01-01");
    my $fifty-two-weeks-later = $new-year-day.later(:52weeks);
    my $count = 52 * 5;
    $count++ if 1 <= $fifty-two-weeks-later.day-of-week < 6;
    return $count if $fifty-two-weeks-later.day == 31;
    $count++ if 1 <= $fifty-two-weeks-later.later(:1days).day-of-week < 6;
    return $count;
}
say "$_ -> ", work-days $_ for 2000..2021;

This program displays the following output:

$ raku ./working-days.raku
2000 -> 260
2001 -> 261
2002 -> 261
2003 -> 261
2004 -> 262
2005 -> 260
2006 -> 260
2007 -> 261
2008 -> 262
2009 -> 261
2010 -> 261
2011 -> 260
2012 -> 261
2013 -> 261
2014 -> 261
2015 -> 261
2016 -> 261
2017 -> 260
2018 -> 261
2019 -> 261
2020 -> 262
2021 -> 261

Workdays in Perl

In Perl, we’ll use the core Time::Piece module. We’ll use a slightly different strategy: we start with 5 * 52 = 260 work days, add one if Dec. 31 is a week day, and add one more if the year is leap and if Dec. 30 is a week day.

use warnings;
use feature qw/say/;
use Time::Piece;

sub work_days {
    my $y = shift;
    my $count = 52 * 5;
    my $t = Time::Piece->strptime("$y Dec 31", '%Y %b %e');
    my $last_d = $t->day_of_week;
    $count++ if $last_d > 0 and $last_d < 6;
    if ($t->is_leap_year) {
        my $thirtieth = ($last_d - 1) % 7;
        $count++ if $thirtieth > 0 and $thirtieth < 6;
    }
    return $count;
}
say "$_ -> ", work_days $_ for 2000..2021;

This script displays the following output:

$ perl ./working-days.pl
2000 -> 260
2001 -> 261
2002 -> 261
2003 -> 261
2004 -> 262
2005 -> 260
2006 -> 260
2007 -> 261
2008 -> 262
2009 -> 261
2010 -> 261
2011 -> 260
2012 -> 261
2013 -> 261
2014 -> 261
2015 -> 261
2016 -> 261
2017 -> 260
2018 -> 261
2019 -> 261
2020 -> 262
2021 -> 261

Task 2: Split Number

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

Split Number in Raku

I first thought I could use some combination of the combinations and permutations methods to solve the problem, but this turned out to be more complicated than expected. So I decided to write a recursive partition subroutine to build the various partitions of the input square number and add the various parts. The split-square subroutine checks that the input number is a perfect square and calls the partition subroutine, passing to it a list of the input number digits. Note that we are using dynamic variables ($*found and $*root) to avoid passing them back and forth in the recursive subroutine calls.

use v6;

sub partition (Int $sum is copy, @in) {
    if @in.elems == 0 {
        $*found = 1 if $sum == $*root;
        return;
    }
    for 1..@in.elems -> $i {
        my $new-sum = $sum + join "", @in[0..($i-1)];
        last if $new-sum > $*root;
        partition $new-sum, @in[$i..@in.end];
    }
}

sub split-square (UInt $sq) {
    my $*root = sqrt($sq).Int;
    say "$sq is not a perfect square\n" and return 0 if $*root² != $sq;
    my $*found = 0;
    partition(0, $sq.comb);
    return $*found;
}
for <1 27 81 100 225 1296 6561 9801> -> $test {
    say $test.fmt("%5d\t") , split-square $test;
}

This program displays the following output:

raku ./split-squares.raku 1 1 27 is not a perfect square

   27   0
   81   1
  100   1
  225   0
 1296   1
 6561   0
 9801   1

Split Number in Perl

This is essentially a Perl port of the Raku solution above. We also implement a recursive partition subroutine to build the various partitions of the input square number and add the various parts. The split_square subroutine checks that the input number is a perfect square and calls the partition subroutine, passing to it a list of the input number digits.

use strict;
use warnings;
use feature "say";

my ($found, $root);

sub partition {
    my ($sum, @in) = @_;    
    if (scalar @in == 0) {
        $found = 1 if $sum == $root;
        return;
    }
    for my $i (1..(scalar @in)) {
        my $new_sum = $sum + join "", @in[0..($i-1)];
        last if $new_sum > $root;
        partition ($new_sum, @in[$i..$#in]);
    }
}

sub split_square {
    my $sq = shift;
    $root = int sqrt($sq);
    say "$sq is not a perfect square\n" and return 0 if $root ** 2 != $sq;
    $found = 0;
    partition(0, split //, $sq);
    return $found;
}
for my $test (qw<1 27 81 100 225 1296 6561 9801>) {
    printf "%5d\t%d\n", $test , split_square $test;
}

This program displays the following output:

$ perl  ./split-squares.pl
    1   1
27 is not a perfect square

   27   0
   81   1
  100   1
  225   0
 1296   1
 6561   0
 9801   1

## Wrapping up

The next week Perl Weekly Challenge will start soon. If you want to participate in this challenge, please check https://perlweeklychallenge.org/ and make sure you answer the challenge before 23:59 BST (British summer time) on November 21, 2021. And, please, also spread the word about the Perl Weekly Challenge if you can.