## Perl Weekly Challenge 138: Workdays and Split Number

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.

## Leave a comment