PERL WEEKLY CHALLENGE – 043

This is my 13th week participating into the weekly challenge.

---

Easy Challenge

Olympic Rings

There are 5 rings in the Olympic Logo as shown below. They are color coded as in Blue, Black, Red, Yellow and Green.

We have allocated some numbers to these rings as below:

Blue: 8
Yellow: 7
Green: 5
Red: 9

The Black ring is empty currently. You are given the numbers 1, 2, 3, 4 and 6. Write a script to place these numbers in the rings so that the sum of numbers in each ring is exactly 11.

---

Edit: I misread the problem, and entered an incorrect solution not realizing that the numbers are subsets of multiple rings, I’ve fixed the problem now.

In perl 5 and Raku we can brute force this by calculating the possible permutations then validating the answers of the permutations.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch1.pl
use strict;
use warnings;
use feature qw /say/;
use Algorithm::Combinatorics qw(permutations);

my @numbers = (1, 2, 3, 4, 6);
my $rings = {
	blue   => 8,	yellow => 7,
	green  => 5,	red    => 9,
};

my $iter = permutations(\@numbers);
while (my $p = $iter->next) {
	my $slots = {
		redgreen     => $p->[0],
		greenblack   => $p->[1],
		black        => $p->[2],
		blackyellow  => $p->[3],
		yellowblue   => $p->[4]
	};

	if (validate_answer($rings, $slots)) {
		for my $key (keys %$slots) {
			say 'Slot: ' . $key .
			    ' value: ' . $slots->{$key};
		}
	}
}

sub validate_answer {
	my ($r, $s) = @_; # rings and slots

	return
	( $s->{redgreen} + $r->{red} == 11 &&
	  $s->{redgreen} + $r->{green} + $s->{greenblack} == 11 &&
	  $s->{greenblack} + $s->{black} + $s->{blackyellow} == 11 &&
	  $s->{blackyellow} + $r->{yellow} + $s->{yellowblue} == 11 &&
	  $r->{blue} + $s->{yellowblue} == 11 );
}

Output

Slot: greenblack value: 4
Slot: black value: 6
Slot: yellowblue value: 3
Slot: redgreen value: 2
Slot: blackyellow value: 1

Raku solution

# Test: perl6 ch1.p6
use v6.d;

my @numbers = (1, 2, 3, 4, 6);
my %rings = (
	blue   => 8, yellow => 7,
	green  => 5, red    => 9,
);

sub MAIN() {
	my @perms = @numbers.permutations;

	for @perms -> $perm {
		my %slots = (
			redgreen     => $perm[0],
			greenblack   => $perm[1],
			black        => $perm[2],
			blackyellow  => $perm[3],
			yellowblue   => $perm[4]
		);

		if (validate-answer(%rings, %slots)) {
			for (%slots.keys) -> $key {
				say 'Slot: ' ~ $key ~
				    ' value: ' ~ %slots.{$key};
			}
		}
	}
}


sub validate-answer(%r, %s) { # rings and slots

	return
	( %s.<redgreen> + %r.<red> == 11 &&
	  %s.<redgreen> + %r.<green> + %s.<greenblack> == 11 &&
	  %s.<greenblack> + %s.<black> + %s.<blackyellow> == 11 &&
	  %s.<blackyellow> + %r.<yellow> + %s.<yellowblue> == 11 &&
	  %r.<blue> + %s.<yellowblue> == 11 );
}

Output

Slot: redgreen value: 2
Slot: blackyellow value: 1
Slot: greenblack value: 4
Slot: yellowblue value: 3
Slot: black value: 6

---

Hard Challenge

Self-descriptive Numbers
Contributed by Laurent Rosenfeld

Write a script to generate Self-descriptive Numbers in a given base.

In mathematics, a self-descriptive number is an integer m that in a given base b is b digits long in which each digit d at position n (the most significant digit being at position 0 and the least significant at position b – 1) counts how many instances of digit n are in m.

For example, if the given base is 10, then script should print 6210001000. For more information, please checkout wiki page.

---

There were two parts to this solution one is to displace the self-descriptive number in its base form and the other is to display it in base 10.

Displaying the numbers in the base form is just a matter of analyzing the string pattern which I approximated using this perl code

$NUMS[($b – 4)] . ‘2’ . 1 . 0 x ($b – 7) . ‘1000’;

where NUMS is just a lookup array so we can display numbers over 10 with 1 character. (It’s only populate with 36 numbers which was enough to show base 1 – 36)

Displaying the numbers in base 10 was just a matter of following this formula

Perl 5 solution

#!/usr/bin/perl
# test: ./ch2.pl
use strict;
use warnings;
use feature qw /say/;
use bignum;

our @NUMS = (0..9,'A' .. 'Z');

for my $i (1..36) {
	say $i . ': ' .
		self_descriptive_x($i) . ' - ' .
		self_descriptive_10($i);
}

sub self_descriptive_x {
	my $b = shift;

	return 'no solution' if
		( $b == 1 || $b == 2 ||
		  $b == 3 || $b == 6);

	return 1210 if ($b == 4);
	return 21200 if ($b == 5);

	return
		$NUMS[($b - 4)] . '2' . 1 . 0 x ($b - 7) . '1000';
}

sub self_descriptive_10 {
	my $b = shift;

	return 'no solution' if
		( $b == 1 || $b == 2 ||
		  $b == 3 || $b == 6);

	return 100 if ($b == 4);
	return 1425 if ($b == 5);

	return
		($b - 4) * $b ** ($b - 1) +
		2 * $b ** ($b - 2) +
		$b ** ($b - 3) +
		$b ** 3;
}

Output

1: no solution – no solution
2: no solution – no solution
3: no solution – no solution
4: 1210 – 100
5: 21200 – 1425
6: no solution – no solution
7: 3211000 – 389305
8: 42101000 – 8946176
9: 521001000 – 225331713
10: 6210001000 – 6210001000
11: 72100001000 – 186492227801
12: 821000001000 – 6073061476032
13: 9210000001000 – 213404945384449
14: A2100000001000 – 8054585122464440
15: B21000000001000 – 325144322753909625
16: C210000000001000 – 13983676842985394176
17: D2100000000001000 – 638488718313248327681
18: E21000000000001000 – 30852387539151417415368
19: F210000000000001000 – 1573159469597805848539033
20: G2100000000000001000 – 84423475200000000000008000
21: H21000000000000001000 – 4756841174671235094613299201
22: I210000000000000001000 – 280793005454401827960409041304
23: J2100000000000000001000 – 17329741584816652890845493751865
24: K21000000000000000001000 – 1116173987440750653627851819988480
25: L210000000000000000001000 – 74896888691000640392303466796890625
26: M2100000000000000000001000 – 5227587888859343585778354788027614376
27: N21000000000000000000001000 – 378972737144966791955974967549425386585
28: O210000000000000000000001000 – 28496513197723712818027291377812964922816
29: P2100000000000000000000001000 – 2219734095422156527988092421968458895869953
30: Q21000000000000000000000001000 – 178904142595280007000000000000000000000027000
31: R210000000000000000000000001000 – 14902796788966847950168266428983007512494526201
32: S2100000000000000000000000001000 – 1281713029540349034436623872002191929194718461952
33: T21000000000000000000000000001000 – 113701047630505078583859757780901667383168967385089
34: U210000000000000000000000000001000 – 10394144242892683639849044394210094269474324837603720
35: V2100000000000000000000000000001000 – 978332368989572974604820213309628888964653015136761625
36: W21000000000000000000000000000001000 – 94732999538876093602890439603390793851493346239336986176

Raku solution

# Test: perl6 ./ch2.p6
use v6.d;

# Don't know how to do this in Raku :(
our @NUMS =
<0 1 2 3 4 5 6 7 8 9 A B C D E F G H
 I J K L M N O P Q R S T U V W X Y Z>;

sub MAIN () {
	say @NUMS;
	for (1..36) -> $i {
		say $i ~ ': ' ~
			self-descriptive-x($i) ~ ' - ' ~
			self-descriptive($i);
	}
}

sub self-descriptive-x(Int $b) {
	return 'no solution' if
		( $b == 1 || $b == 2 ||
		  $b == 3 || $b == 6);

	return 1210 if ($b == 4);
	return 21200 if ($b == 5);

	return
		@NUMS[($b - 4)] ~ '2' ~ 1 ~ 0 x ($b - 7) ~ '1000';
}

sub self-descriptive(Int $b) {
	return 'no solution' if
		( $b == 1 || $b == 2 ||
		  $b == 3 || $b == 6);

	return 100 if ($b == 4);
	return 1425 if ($b == 5);

	return
		($b - 4) * $b ** ($b - 1) +
		2 * $b ** ($b - 2) +
		$b ** ($b - 3) +
		$b ** 3;
}

Output

1: no solution – no solution
2: no solution – no solution
3: no solution – no solution
4: 1210 – 100
5: 21200 – 1425
6: no solution – no solution
7: 3211000 – 389305
8: 42101000 – 8946176
9: 521001000 – 225331713
10: 6210001000 – 6210001000
11: 72100001000 – 186492227801
12: 821000001000 – 6073061476032
13: 9210000001000 – 213404945384449
14: A2100000001000 – 8054585122464440
15: B21000000001000 – 325144322753909625
16: C210000000001000 – 13983676842985394176
17: D2100000000001000 – 638488718313248327681
18: E21000000000001000 – 30852387539151417415368
19: F210000000000001000 – 1573159469597805848539033
20: G2100000000000001000 – 84423475200000000000008000
21: H21000000000000001000 – 4756841174671235094613299201
22: I210000000000000001000 – 280793005454401827960409041304
23: J2100000000000000001000 – 17329741584816652890845493751865
24: K21000000000000000001000 – 1116173987440750653627851819988480
25: L210000000000000000001000 – 74896888691000640392303466796890625
26: M2100000000000000000001000 – 5227587888859343585778354788027614376
27: N21000000000000000000001000 – 378972737144966791955974967549425386585
28: O210000000000000000000001000 – 28496513197723712818027291377812964922816
29: P2100000000000000000000001000 – 2219734095422156527988092421968458895869953
30: Q21000000000000000000000001000 – 178904142595280007000000000000000000000027000
31: R210000000000000000000000001000 – 14902796788966847950168266428983007512494526201
32: S2100000000000000000000000001000 – 1281713029540349034436623872002191929194718461952
33: T21000000000000000000000000001000 – 113701047630505078583859757780901667383168967385089
34: U210000000000000000000000000001000 – 10394144242892683639849044394210094269474324837603720
35: V2100000000000000000000000000001000 – 978332368989572974604820213309628888964653015136761625
36: W21000000000000000000000000000001000 – 94732999538876093602890439603390793851493346239336986176

PERL WEEKLY CHALLENGE – 042

This is my 12th week participating into the weekly challenge.

---

Easy Challenge

Octal Number System
Write a script to print decimal number 0 to 50 in Octal Number System.

For example:

Decimal 0 = Octal 0
Decimal 1 = Octal 1
Decimal 2 = Octal 2
Decimal 3 = Octal 3
Decimal 4 = Octal 4
Decimal 5 = Octal 5
Decimal 6 = Octal 6
Decimal 7 = Octal 7
Decimal 8 = Octal 10
and so on.

In perl 5 and Raku we can display octals using printf or sprintf.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch1.pl
use strict;
use warnings;
use feature qw /say/;

for my $i (1..50) {
	say 'Decimal '  . $i .
	    ' = Octal ' . to_octal($i);
}

sub to_octal {
	return sprintf('%o', shift);
}

Output

Decimal 1 = Octal 1
Decimal 2 = Octal 2
Decimal 3 = Octal 3
Decimal 4 = Octal 4
Decimal 5 = Octal 5
Decimal 6 = Octal 6
Decimal 7 = Octal 7
Decimal 8 = Octal 10
Decimal 9 = Octal 11
Decimal 10 = Octal 12
Decimal 11 = Octal 13
Decimal 12 = Octal 14
Decimal 13 = Octal 15
Decimal 14 = Octal 16
Decimal 15 = Octal 17
Decimal 16 = Octal 20
Decimal 17 = Octal 21
Decimal 18 = Octal 22
Decimal 19 = Octal 23
Decimal 20 = Octal 24
Decimal 21 = Octal 25
Decimal 22 = Octal 26
Decimal 23 = Octal 27
Decimal 24 = Octal 30
Decimal 25 = Octal 31
Decimal 26 = Octal 32
Decimal 27 = Octal 33
Decimal 28 = Octal 34
Decimal 29 = Octal 35
Decimal 30 = Octal 36
Decimal 31 = Octal 37
Decimal 32 = Octal 40
Decimal 33 = Octal 41
Decimal 34 = Octal 42
Decimal 35 = Octal 43
Decimal 36 = Octal 44
Decimal 37 = Octal 45
Decimal 38 = Octal 46
Decimal 39 = Octal 47
Decimal 40 = Octal 50
Decimal 41 = Octal 51
Decimal 42 = Octal 52
Decimal 43 = Octal 53
Decimal 44 = Octal 54
Decimal 45 = Octal 55
Decimal 46 = Octal 56
Decimal 47 = Octal 57
Decimal 48 = Octal 60
Decimal 49 = Octal 61
Decimal 50 = Octal 62

Raku solution

# Test: perl6 ch1.p6
use v6.d;

sub MAIN() {
	for (1..50) -> $i {
		say 'Decimal '  ~ $i ~
		    ' = Octal ' ~ to-octal($i);
	}
}

sub to-octal(Int $i) {
	return sprintf('%o', $i);
}

Output

Decimal 1 = Octal 1
Decimal 2 = Octal 2
Decimal 3 = Octal 3
Decimal 4 = Octal 4
Decimal 5 = Octal 5
Decimal 6 = Octal 6
Decimal 7 = Octal 7
Decimal 8 = Octal 10
Decimal 9 = Octal 11
Decimal 10 = Octal 12
Decimal 11 = Octal 13
Decimal 12 = Octal 14
Decimal 13 = Octal 15
Decimal 14 = Octal 16
Decimal 15 = Octal 17
Decimal 16 = Octal 20
Decimal 17 = Octal 21
Decimal 18 = Octal 22
Decimal 19 = Octal 23
Decimal 20 = Octal 24
Decimal 21 = Octal 25
Decimal 22 = Octal 26
Decimal 23 = Octal 27
Decimal 24 = Octal 30
Decimal 25 = Octal 31
Decimal 26 = Octal 32
Decimal 27 = Octal 33
Decimal 28 = Octal 34
Decimal 29 = Octal 35
Decimal 30 = Octal 36
Decimal 31 = Octal 37
Decimal 32 = Octal 40
Decimal 33 = Octal 41
Decimal 34 = Octal 42
Decimal 35 = Octal 43
Decimal 36 = Octal 44
Decimal 37 = Octal 45
Decimal 38 = Octal 46
Decimal 39 = Octal 47
Decimal 40 = Octal 50
Decimal 41 = Octal 51
Decimal 42 = Octal 52
Decimal 43 = Octal 53
Decimal 44 = Octal 54
Decimal 45 = Octal 55
Decimal 46 = Octal 56
Decimal 47 = Octal 57
Decimal 48 = Octal 60
Decimal 49 = Octal 61
Decimal 50 = Octal 62

---

Hard Challenge

Balanced Brackets

Write a script to generate a string with random number of ( and ) brackets. Then make the script validate the string if it has balanced brackets.

For example:

() – OK
(()) – OK
)( – NOT OK
())() – NOT OK

---

For this challenge I first decided to implement some recursive regex and event used https://metacpan.org/pod/Regexp::Common but it was failing to match correct on some edge cases where a parenthsis block was complete like ()((.

I didn’t want to spend too much time trying to figure the perfect regex so I validated using a cheap and efficient open parenthesis counter.

I did the same thing for Raku.

Perl 5 solution

#!/usr/bin/perl
# test: ./ch2.pl
use strict;
use warnings;
use feature qw /say/;
use constant {
	MAX_STRING_LENGTH => 4
};

for my $i ( 1 .. 20 ) {
	my $string = generate_random_string();
	my $ok = (validate_string($string)) ? 'OK ' : 'NOT OK';
	say $string . ' - ' . $ok;
}

sub generate_random_string {
	my $length = int(rand(MAX_STRING_LENGTH - 1) + 2);
	my $string;

	for my $i (1 .. $length ) {
		$string .= (int(rand(2))) ? '(' : ')';
	}

	return $string;
}

sub validate_string {
	my $open_p;

	for my $char (split('', shift)) {
		$open_p++ if ($char eq '(');
		$open_p-- if ($char eq ')');

		return 0 if ($open_p < 0);
	}

	return ($open_p == 0);
}

Output

)(( – NOT OK
()() – OK
)(( – NOT OK
)) – NOT OK
()( – NOT OK
)( – NOT OK
(( – NOT OK
(() – NOT OK
()() – OK
)( – NOT OK
(() – NOT OK
)) – NOT OK
)( – NOT OK
)(() – NOT OK
(()) – OK
)))) – NOT OK
)) – NOT OK
() – OK
)() – NOT OK
)((( – NOT OK

Raku solution

# Test: perl6 ./ch2.p6
use v6.d;
constant $MAX_STRING_LENGTH = 4;

sub MAIN () {
	for ( 1 .. 20 ) {
		my $string = generate-random-string();
		my $ok = (validate-string($string)) ?? 'OK ' !! 'NOT OK';
		say $string ~ ' - ' ~ $ok;
	}
}

sub generate-random-string {
	return <( )>.roll(
		Int((2 .. $MAX_STRING_LENGTH + 1).rand)
	).join;
}

sub validate-string(Str $word) {
	my $open_p;

	for $word.comb -> $letter {
		$open_p++ if ($letter eq '(');
		$open_p-- if ($letter eq ')');
		return 0 if ($open_p < 0);
	}

	return ($open_p == 0);
}

Output

()( – NOT OK
)(( – NOT OK
()) – NOT OK
((( – NOT OK
)() – NOT OK
)()( – NOT OK
(() – NOT OK
() – OK
)))) – NOT OK
(() – NOT OK
(( – NOT OK
() – OK
(((( – NOT OK
(()) – OK
)))) – NOT OK
)()) – NOT OK
)( – NOT OK
() – OK
()() – OK
((( – NOT OK

PERL WEEKLY CHALLENGE – 041

This is my 11th week participating into the weekly challenge.

---

Easy Challenge

Write a script to display attractive number between 1 and 50.

A number is an attractive number if the number of its prime factors is also prime number.

The number 20 is an attractive number, whose prime factors are 2, 2 and 5. The total prime factors is 3 which is also a prime number.

This is just factoring a number is checking if it’s prime.

Perl has a good module for this and will do all the heavy lifting for this task
https://metacpan.org/pod/Math::Prime::Util

In Raku, the is-prime method is already built in, but not the factoring. I googled factoring numbers in Raku because I was a bit tired and didn’t really want to think of an algorithm so I blatantly copied the first piece of code that looked like it would work. Did some minor tweaks to get it to work in a function.

Factorization code copied from:
https://andrewshitov.com/2019/09/09/finding-prime-factors-using-perl-6/

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch1.pl
use strict;
use warnings;
use Math::Prime::Util qw /factor is_prime/;
use feature qw /say/;

for my $i (1..50) {
	my @factors = factor($i);
	say $i if (is_prime(scalar(@factors)));
}

Output

4
6
8
9
10
12
14
15
18
20
21
22
25
26
27
28
30
32
33
34
35
38
39
42
44
45
46
48
49
50

Raku solution

# Test: perl6 ch1.p6
use v6.d;

sub MAIN() {
	for (1..50) -> $i {
		my @factors = factors($i);
		say $i if @factors.elems.is-prime;
	}
}

# This was blatantly copied
sub factors (Int $n) {
	my @list;
	my @prime = grep {.is-prime}, 1..*;
	my $pos = 0;
	my $check = $n;

	while $check > 1 {
		my $factor = @prime[$pos];
		$pos++;
		next unless $check %% $factor;

		$pos = 0;
		$check /= $factor;
		push @list, $factor;
	}

	return @list;
}

Output

4
6
8
9
10
12
14
15
18
20
21
22
25
26
27
28
30
32
33
34
35
38
39
42
44
45
46
48
49
50

---

Hard Challenge

Write a script to display first 20 Leonardo Numbers. Please checkout wiki page for more information.

For example:

L(0) = 1
L(1) = 1
L(2) = L(0) + L(1) + 1 = 3
L(3) = L(1) + L(2) + 1 = 5
and so on.

---

Leonardo numbers look surprisingly similar to Fibonacci numbers.

In perl 5 we just use recursion to calculate Leonardo’s number just like we did when we first learned about Fibonacci numbers in Perl or any other computer science course.

In Raku, I used the powerful sequence operator and generated a lazy infinite list.

Perl 5 solution

#!/usr/bin/perl
# test: ./ch2.pl
use strict;
use warnings;
use feature qw /say/;

for my $i (1..20) {
	say "L($i) = " . leonardo($i);
}

# Leonardo
sub leonardo {
	my $n = shift;
	return 1 if ($n == 0 or $n == 1);

	# Recursive
	return (
		leonardo($n-1) +  # l(n-1)
		leonardo($n-2) +  # l(n-2)
		1                 # 1
	);
}

Output

L(1) = 1
L(2) = 3
L(3) = 5
L(4) = 9
L(5) = 15
L(6) = 25
L(7) = 41
L(8) = 67
L(9) = 109
L(10) = 177
L(11) = 287
L(12) = 465
L(13) = 753
L(14) = 1219
L(15) = 1973
L(16) = 3193
L(17) = 5167
L(18) = 8361
L(19) = 13529
L(20) = 21891

Raku solution

# Test: perl6 ./ch2.p6
use v6.d;

sub MAIN () {
	my @leonardo = 1, 1, * + * + 1 ... *;
	say "L($_) = " ~ @leonardo[$_]
		for (1 .. 20);
}

Output

L(1) = 1
L(2) = 3
L(3) = 5
L(4) = 9
L(5) = 15
L(6) = 25
L(7) = 41
L(8) = 67
L(9) = 109
L(10) = 177
L(11) = 287
L(12) = 465
L(13) = 753
L(14) = 1219
L(15) = 1973
L(16) = 3193
L(17) = 5167
L(18) = 8361
L(19) = 13529
L(20) = 21891

PERL WEEKLY CHALLENGE – 040

This is my tenth week participating into the weekly challenge.

---

Easy Challenge

Show multiple arrays content

Show multiple arrays content

You are given two or more arrays. Write a script to display values of each list at a given index.

For example:
Array 1: [ I L O V E Y O U ]
Array 2: [ 2 4 0 3 2 0 1 9 ]
Array 3: [ ! ? £ $ % ^ & * ]

---

In perl5, I solved this by first calculating the size of the largest array and looping through each element with a for loop. Then using the map function to display the elements of each array.

In Raku, I pretty much did the same thing.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch1.pl
use strict;
use warnings;
use feature qw /say/;

my $arrays = [
	[ qw (I L O V E Y O U) ],
	[ qw (2 4 0 3 2 0 1 9) ],
	[ qw (! ? £ $ % ^ & *) ],
];

# Sizes of the array
my @sizes =
	sort { $b <=> $a }
	map { scalar(@$_) } @$arrays;

# Loop through each array
for my $i (0 .. $sizes[0] - 1) {
	say join ' ',
	    map { $_->[$i] // ' ' }
	    @$arrays;
}

Output

I 2 !
L 4 ?
O 0 £
V 3 $
E 2 %
Y 0 ^
O 1 &
U 9 *

Raku solution

# Test: perl6 ch1.p6
use v6.d;

sub MAIN() {
	my @arrays = (
		<I L O V E Y O U>,
		<2 4 0 3 2 0 1 9>,
		<! ? £ $ % ^ & *>,
	);

	my $max = @arrays.sort({$^b.elems <=> $^a.elems})
	                 .first
	                 .elems;

	for (0 .. $max - 1) ->$i {
		say @arrays.map({$_[$i] // ' '})
		           .join(" ");
	}
}

Output

I 2 !
L 4 ?
O 0 £
V 3 $
E 2 %
Y 0 ^
O 1 &
U 9 *

---

Hard Challenge

Sort SubList
You are given a list of numbers and set of indices belong to the list. Write a script to sort the values belongs to the indices.

For example,
List: [ 10, 4, 1, 8, 12, 3 ]
Indices: 0,2,5
We would sort the values at indices 0, 2 and 5 i.e. 10, 1 and 3.

Final List would look like below:
List: [ 1, 4, 3, 8, 12, 10 ]

---

In perl 5, I used an array slice to generate a sublist, then I sorted the sublist and overrode the values in the correct position of the original list.

In Raku, I pretty much did the same thing.

Perl 5 solution

#!/usr/bin/perl
# test: ./ch2.pl
use strict;
use warnings;
use feature qw /say/;

my @list = (10, 4, 1, 8, 12, 3);
my @indices = (0, 2, 5);

# Create a sublist
my @sublist =
	sort {$a <=> $b} @list[@indices];

# Override the original array
my $i = 0;
for my $index (@indices) {
	$list[$index] = $sublist[$i++];
}

say join ',', @list;

Output
1,4,3,8,12,10

Raku solution

# Test: perl6 ./ch2.p6
use v6.d;

sub MAIN () {
	my @list = (10, 4, 1, 8, 12, 3);
	my @indices = (0, 2, 5);

	my @sublist = @list[@indices].sort;

	# Override the original array
	my $i = 0;
	for (@indices) -> $index {
		@list[$index] = @sublist[$i++];
	}

	say @list;
}

Output
[1 4 3 8 12 10]

PERL WEEKLY CHALLENGE – 039

This is my ninth week participating into the weekly challenge.

---

Easy Challenge

A guest house had a policy that the light remain ON as long as the at least one guest is in the house. There is guest book which tracks all guest in/out time. Write a script to find out how long in minutes the light were ON.

1) Alex    IN: 09:10 OUT: 09:45
2) Arnold  IN: 09:15 OUT: 09:33
3) Bob     IN: 09:22 OUT: 09:55
4) Charlie IN: 09:25 OUT: 10:05
5) Steve   IN: 09:33 OUT: 10:01
6) Roger   IN: 09:44 OUT: 10:12
7) David   IN: 09:57 OUT: 10:23
8) Neil    IN: 10:01 OUT: 10:19
9) Chris   IN: 10:10 OUT: 11:00

---

I solved this by converting the hh::mm timestamp into absolute minutes and iterating through each minute that the light is on and storing that into a hash. The hash is sampled per minute and the last minute isn’t sampled.

For example: 10:10 – 10:11 will only store the absolute minute 610 into the hash and not 610 and 611.

In Raku, I pretty much did the same thing.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch1.pl
use strict;
use warnings;
use feature qw /say/;

my $minutes_on = calculate_lights_on();

say 'Lights on for: ' .
    $minutes_on . ' minutes';

# Calculate the minutes lights were on
sub calculate_lights_on {
	my %time_on; # Sample in minutes
	my $time_re = qr/\d{2}\:\d{2}/;

	while (my $line = <DATA>) {
		next unless $line =~
			/.*?($time_re).*?($time_re)/;

		# Get the time in absolute minutes
		my $t1 = absolute_minutes($1);
		my $t2 = absolute_minutes($2);

		# Populate the time on hash
		for my $minute ($t1 .. ($t2 - 1)) {
			$time_on{$minute} = 1;
		}
	}

	return scalar(keys %time_on);
}

# Convert to absolute mins.
sub absolute_minutes {
	my ($hh, $mm) = split(':', shift);
	return $hh * 60 + $mm;
}


__DATA__
1) Alex    IN: 09:10 OUT: 09:45
2) Arnold  IN: 09:15 OUT: 09:33
3) Bob     IN: 09:22 OUT: 09:55
4) Charlie IN: 09:25 OUT: 10:05
5) Steve   IN: 09:33 OUT: 10:01
6) Roger   IN: 09:44 OUT: 10:12
7) David   IN: 09:57 OUT: 10:23
8) Neil    IN: 10:01 OUT: 10:19
9) Chris   IN: 10:10 OUT: 11:00

Output

Lights on for: 110 minutes

Raku solution

# Test: perl6 ch1.p6
use v6.d;

sub MAIN() {
	my $minutes_on = calculate-lights-on();

	say 'Lights on for: ' ~
	    $minutes_on ~
	    ' minutes';
}

# Calculate the minutes lights were on
sub calculate-lights-on {
	my %time_on; # Sample in minutes
	my $time_re = /\d\d\:\d\d/;

	for data().lines -> $line {
		next unless $line ~~
			/.*?($time_re).*?($time_re)/;

		# Get the time in absolute minutes
		my $t1 = absolute-minutes($0);
		my $t2 = absolute-minutes($1);

		%time_on{$t1 .. ($t2 -1)} = 1;
	}

	return %time_on.elems;
}

# Convert to absolute mins.
sub absolute-minutes($hh_mm) {
	my ($hh, $mm) = $hh_mm.split(':');
	return $hh * 60 + $mm;
}

# The data
sub data {
	return q:to/END/;
1) Alex    IN: 09:10 OUT: 09:45
2) Arnold  IN: 09:15 OUT: 09:33
3) Bob     IN: 09:22 OUT: 09:55
4) Charlie IN: 09:25 OUT: 10:05
5) Steve   IN: 09:33 OUT: 10:01
6) Roger   IN: 09:44 OUT: 10:12
7) David   IN: 09:57 OUT: 10:23
8) Neil    IN: 10:01 OUT: 10:19
9) Chris   IN: 10:10 OUT: 11:00
END
}

Output

Lights on for: 110 minutes

---

Hard Challenge

Write a script to demonstrate Reverse Polish notation(RPN). Checkout the wiki page for more information about RPN.

---

For this challenge I just followed the algorithm shown below. I used a dispatch table for the operations and made it a bit more utf-8 friendly.

for each token in the postfix expression:
  if token is an operator:
    operand_2 ← pop from the stack
    operand_1 ← pop from the stack
    result ← evaluate token with operand_1 and operand_2
    push result back onto the stack
  else if token is an operand:
    push token onto the stack
result ← pop from the stack

Perl 5 solution

#!/usr/bin/perl
# test: ./ch2.pl "15 7 1 1 + − ÷ 3 × 2 1 1 + + −"
use strict;
use warnings;
use feature qw /say/;

say evaluate_stack($ARGV[0]);

# Evaluate the stack
sub evaluate_stack {
	my @tokens = split(/\s/, shift);
	my @stack;

	# Some utf-8 friendly operations
	my $operations = {
		'+' => \&add,
		'-' => \&subtract,
		'−' => \&subtract,
		'*' => \&multiply,
		'×' => \&multiply,
		'÷' => \&divide,
		'/' => \&divide,
	};

	for my $token (@tokens) {
		if ($operations->{$token}) {
			push @stack, $operations->{$token}->(\@stack);
		} elsif ($token =~ /\d+/) {
			push @stack, $token;
		}
	}

	return pop(@stack);
}

# Operations
sub add      { my $s = shift; return pop(@$s) + pop(@$s) }
sub subtract { my $s = shift; return - pop(@$s) + pop(@$s) }
sub multiply { my $s = shift; return pop(@$s) * pop(@$s) }
sub divide   { my $s = shift; return (1 / pop(@$s)) * pop(@$s) }

Test like this
./ch2.pl “15 7 1 1 + − ÷ 3 × 2 1 1 + + −”

Output
5

Raku solution

# Test: perl6 ./ch2.p6 "15 7 1 1 + − ÷ 3 × 2 1 1 + + −"
use v6.d;

sub MAIN (Str $tokens) {
	say evaluate-stack($tokens.split(/\s/));
}

# Evaluate the stack
sub evaluate-stack(@tokens) {
	my @stack;

	# Some utf-8 friendly operations
	my %operations = (
		'+' => &add,
		'-' => &subtract,
		'−' => &subtract,
		'*' => &multiply,
		'×' => &multiply,
		'÷' => &divide,
		'/' => &divide,
	);

	# Process each token
	for (@tokens) -> $token {
		if (%operations.{$token}) {
			push @stack, %operations.{$token}(@stack);
		} elsif ($token ~~ /\d+/) {
			push @stack, $token;
		}
	}

	# Return the answer
	return pop(@stack);
}

# Operations
sub add(@s)      { return @s.pop + @s.pop }
sub subtract(@s) { return - @s.pop + @s.pop }
sub multiply(@s) { return @s.pop * @s.pop }
sub divide(@s)   { return (1 / @s.pop) * @s.pop }

Test like this
perl6 ./ch2.p6 “15 7 1 1 + − ÷ 3 × 2 1 1 + + −”

Output
5

PERL WEEKLY CHALLENGE – 038

This is my eight week participating into the weekly challenge.

---

Easy Challenge

Date Finder
Create a script to accept a 7 digits number, where the first number can only be 1 or 2. The second and third digits can be anything 0-9. The fourth and fifth digits corresponds to the month i.e. 01,02,03…,11,12. And the last 2 digits respresents the days in the month i.e. 01,02,03….29,30,31. Your script should validate if the given number is valid as per the rule and then convert into human readable format date.

RULES
1) If 1st digit is 1, then prepend 20 otherwise 19 to the 2nd and 3rd digits to make it 4-digits year.

2) The 4th and 5th digits together should be a valid month.

3) The 6th and 7th digits together should be a valid day for the above month.

---

In perl 5, I used checked the formatting of the date using regex and I checked the validity of the date using use Date::Manip to make sure dates like 2230231 don’t sneak by (Feb 31, 1923).

In Raku, I used the same Regex to check the date format and used the Date object to check if the date is valid, catching the exception if the date is invalid but correctly passes the format regex like (2230231)

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch1.pl 2230120
use strict;
use warnings;
use feature qw /say/;
use Date::Manip;

say parse_date($ARGV[0]);

sub parse_date {
	my $date = shift;

	# Regex to test date format
	return "Invalid date format"
		unless $date && $date =~ /
			^                     # start string
			([12])                # 1 or 2
			(\d\d)                # year 00-99
			(0[1-9]|1[0-2])       # month 1-12
			(0[1-9]|[12]\d|3[01]) # day 1-31
			$                     # end string
		/x;

	# The date string
	my $date_string =
		( ($1 == 1) ? '20' . $2  : '19' . $2 )
		. '-' . $3 . '-' . $4;

	# Make sure the date is valid
	# even if it passed the format check
	# using Date::Manip
	return "Invalid date"
		unless (ParseDate($date_string));

	return $date_string;
}

Output

1923-01-20

Raku solution

# Test: perl6 ch1.p6 2230120
use v6.d;

sub MAIN(Int $date) {
	say parse-date($date);
}

sub parse-date(Int $date) {
	# Regex to test date format
	return "Invalid date format"
		unless ($date ~~ /
			^^            # Start of string
			(<[12]>)      # 1 or 2
			(\d\d)        # year 00-99
			(0<[1..9]> || # month 1-12
			 1<[0..2]>)
			(0<[1..9]> || # day 1-31
			 <[1..2]>\d||
			 3<[01]>)
			$$            # End of string
		/);

	# The date string
	my $date_string =
		( ($0 == 1) ?? '20' ~ $1  !! '19' ~ $1 )
		~ '-' ~ $2 ~ '-' ~ $3;

	# Make sure the date is valid
	# even if it passed the format check
	try {
		my $date_check = Date.new($date_string);

		CATCH {
			return "Invalid date";
		}
	}

	return $date_string;
}

Output

1923-01-20

---

Hard Challenge

Word Game
Lets assume we have tiles as listed below, with an alphabet (A..Z) printed on them. Each tile has a value, e.g. A (1 point), B (4 points) etc. You are allowed to draw 7 tiles from the lot randomly. Then try to form a word using the 7 tiles with maximum points altogether. You don’t have to use all the 7 tiles to make a word. You should try to use as many tiles as possible to get the maximum points.

For example, A (x8) means there are 8 tiles with letter A.

1 point
A (x8), G (x3), I (x5), S (x7), U (x5), X (x2), Z (x5)

2 points
E (x9), J (x3), L (x3), R (x3), V (x3), Y (x5)

3 points
F (x3), D (x3), P (x5), W (x5)

4 points
B (x5), N (x4)

5 points
T (x5), O (x3), H (x3), M (x4), C (x4)

10 points
K (x2), Q (x2)

---

This was quite an interesting and fun challenge.

First I needed to generate a list of valid words. Most flavours of unix have a dictionary file and mine was located at /usr/share/dict/words. I loaded this file and stored it into a global hash called %valid_words.

To generate the tilesets, I create a shuffled list of indexes in perl 5 and retrieved the first x tiles from them. Raku had a convenient method called pick which allows you to pick x items from the array.

To generate the combinations, In the perl5 solution I used Algorithm::Combinatorics to generate the different permutations of the 7 tiles using the variations method. For Raku I used used the combination and permutation methods of the Array Class to generate all the possible permutations from 1 to 7 tiles.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch2.pl
use strict;
use warnings;
use feature qw /say/;
use Algorithm::Combinatorics qw(variations);
use List::Util qw(shuffle);

# Store valid words
our %valid_words;

# Tiles metadata
our %tiles_metadata =  (
	A => { points => 1,  amount => 8 },
	B => { points => 4,  amount => 5 },
	C => { points => 5,  amount => 4 },
	D => { points => 3,  amount => 3 },
	E => { points => 2,  amount => 9 },
	F => { points => 3,  amount => 3 },
	G => { points => 1,  amount => 3 },
	H => { points => 5,  amount => 3 },
	I => { points => 1,  amount => 5 },
	J => { points => 2,  amount => 3 },
	K => { points => 10, amount => 2 },
	L => { points => 2,  amount => 3 },
	M => { points => 5,  amount => 4 },
	N => { points => 4,  amount => 4 },
	O => { points => 5,  amount => 3 },
	P => { points => 3,  amount => 5 },
	Q => { points => 10, amount => 2 },
	R => { points => 2,  amount => 3 },
	S => { points => 1,  amount => 7 },
	T => { points => 5,  amount => 5 },
	U => { points => 1, amount  => 5 },
	V => { points => 2,  amount => 3 },
	W => { points => 3,  amount => 5 },
	X => { points => 1,  amount => 2 },
	Y => { points => 2,  amount => 5 },
	Z => { points => 1,  amount => 5 },
);

# Load the dictionary
load_words('/usr/share/dict/words');

# Grab 7 times
my @tiles = get_tiles(7);
say 'Picked tiles: ' . join ', ', @tiles;

# Find the word with the most points
my ($word, $score) = find_best_word(\@tiles);
say 'Best word: ' . $word .
    ' with score: ' . $score;

# Load the dictionary into memory
sub load_words {
	my $filename = shift;

	open(my $fh, '<:encoding(UTF-8)', $filename) || die "$@";
	while (my $row = <$fh>) {
		chomp $row;
		$valid_words{uc($row)} = 1;
	}
}

# Get tiles
sub get_tiles {
	my $no_tiles = shift;

	# Generate the set of tiles
	my @tileset;
	for my $key (keys %tiles_metadata) {
		for my $i (1 .. $tiles_metadata{$key}->{amount}) {
			push @tileset, $key;
		}
	}

	# Get Seven tiles
	my @shuffled_indexes = shuffle(0..$#tileset);
	my @my_tiles =
		@tileset[
			@shuffled_indexes[ 0 .. $no_tiles -1 ]
		];
	return @my_tiles;
}

# Find the best word
sub find_best_word {
	my $tiles_ref = shift;
	my $top_score = 0;
	my $top_word;

	# Generate the possible combinations
	for my $i (1..7) {
		my $iter = variations($tiles_ref,$i);

		# Loop through each variation
		while (my $v = $iter->next) {
			my $word = join '', @{$v};
			if ($valid_words{$word}) {
				my $score = calculate_score($v);

				# If this is the best word store it
				if ($score > $top_score) {
					$top_score = $score;
					$top_word  = $word;
				}
			}
		}
	}

	return $top_word, $top_score;
}

# Calculate score
sub calculate_score {
	my $word_ref = shift;
	my $score = 0;

	for my $letter (@${word_ref}) {
		$score += $tiles_metadata{$letter}->{points};
	}

	return $score;
}

Output

Picked tiles: S, V, A, O, Q, S, F
Best word: FOSSA with score: 11

Raku solution

# Test: perl6 ch2.p6
use v6.d;

# Store valid words
our %valid_words;

# Tiles metadata
our %tiles_metadata =  (
	A => { points => 1,  amount => 8 },
	B => { points => 4,  amount => 5 },
	C => { points => 5,  amount => 4 },
	D => { points => 3,  amount => 3 },
	E => { points => 2,  amount => 9 },
	F => { points => 3,  amount => 3 },
	G => { points => 1,  amount => 3 },
	H => { points => 5,  amount => 3 },
	I => { points => 1,  amount => 5 },
	J => { points => 2,  amount => 3 },
	K => { points => 10, amount => 2 },
	L => { points => 2,  amount => 3 },
	M => { points => 5,  amount => 4 },
	N => { points => 4,  amount => 4 },
	O => { points => 5,  amount => 3 },
	P => { points => 3,  amount => 5 },
	Q => { points => 10, amount => 2 },
	R => { points => 2,  amount => 3 },
	S => { points => 1,  amount => 7 },
	T => { points => 5,  amount => 5 },
	U => { points => 1, amount  => 5 },
	V => { points => 2,  amount => 3 },
	W => { points => 3,  amount => 5 },
	X => { points => 1,  amount => 2 },
	Y => { points => 2,  amount => 5 },
	Z => { points => 1,  amount => 5 },
);

# Box configurations
sub MAIN () {
	# Load the dictionary
	load-words('/usr/share/dict/words');

	# Grab 7 tiles
	my @tiles = get-tiles(7);
	say 'Picked tiles: ' ~ @tiles;

	# Find the word with the most points
	my ($word, $score) = find-best-word(@tiles);
	say 'Best word: ' ~ $word ~
	    ' with score: ' ~ $score;
}

# Find the best word
sub find-best-word(@tiles) {
	my $top_score = 0;
	my $top_word;

	my @combos = @tiles.combinations: 1..7;
	for @combos -> $combo {
		for $combo.permutations -> $perms {
			my $word = $perms.join;

			if %valid_words.{$word} {
				my $score = calculate-score($word);

				# If this is the best word store it
				if ($score > $top_score) {
					$top_score = $score;
					$top_word  = $word;
				}
			}
		};
	}

	return $top_word, $top_score;
}

# Calculate score
sub calculate-score(Str $word) {
	my $score = 0;

	for $word.comb -> $letter {
		$score += %tiles_metadata.{$letter}.{'points'};
	}

	return $score;
}

# Get tiles
sub get-tiles(Int $number_of_tiles) {
	my @tileset;

	# Generate the set of tiles
	for %tiles_metadata.keys() -> $key {
		for 1 .. %tiles_metadata.{$key}.{"amount"} -> $i {
			@tileset.push($key);
		}
	}

	return @tileset.pick($number_of_tiles)
}

# Load the dictionary into memory
sub load-words(Str $filename) {
	for $filename.IO.lines -> $line {
		%valid_words{$line.uc} = 1;
	}
}

Output

Picked tiles: M W A H C R Q
Best word: MARCH with score: 18

PERL WEEKLY CHALLENGE – 037

This is my seventh week participating into the weekly challenge.

---

Easy Challenge

“Write a script to calculate the total number of weekdays (Mon-Fri) in each month of the year 2019.”

In perl 5, I used Datetime and DateTime::Event::Recurrence to do the heavy lifting for this task, looping through each month and have DateTime::Event::Recurrence calculate the weekdays.

https://metacpan.org/pod/DateTime

https://metacpan.org/pod/DateTime::Event::Recurrence

In Raku I just looped through all the days in a year and stored the value in a hash using the Date objects day-of-week method to find if the day is a weekday.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch1.pl 2019
use strict;
use warnings;
use feature qw /say/;
use DateTime;
use DateTime::Event::Recurrence;

show_weekdays_per_year($ARGV[0]);

sub show_weekdays_per_year {
	my $year = shift || 2019;
	for my $month (1..12) {
		show_weekdays_per_month($month, $year);
	}
}

sub show_weekdays_per_month {
	my ($month, $year) = @_;

	my $working_days =
		DateTime::Event::Recurrence->weekly(
			days => [1 .. 5]
		);

	# Start of the month
	my $start = DateTime->new(
		year  => $year,
		month => $month,
		day   => 1
	);

	# End of the month
	my $end = $start->clone;
	$end->add( months => 1 )
	    ->subtract( days => 1 );

	my $num_days = $working_days->as_list(
		start => $start,
		end => $end
	);

	say $start->month_abbr() . ": $num_days days";
}

Output

Jan: 23 days
Feb: 20 days
Mar: 21 days
Apr: 22 days
May: 23 days
Jun: 20 days
Jul: 23 days
Aug: 22 days
Sep: 21 days
Oct: 23 days
Nov: 21 days
Dec: 22 days

Raku solution

# Test: perl6 ch1.p6 2019
use v6.d;

sub MAIN(Int $year = 2019) {
	show-weekdays-per-year($year);
}

# Weekdays per year
sub show-weekdays-per-year(Int $year) {
	my $current = Date.new($year, 1, 1);
	my %months{Int};

	my @mon = (
		'Jan', 'Feb', 'Mar', 'Apr',
		'May', 'Jun', 'Jul', 'Aug',
		'Sep', 'Oct', 'Nov', 'Dec'
	);

	while ($current.year == $year) {
		%months{$current.month}++
			if ($current.day-of-week == (1 .. 5).any);
		$current++;
	}

	for %months.keys.sort -> $key {
		say @mon[$key - 1] ~ ': ' ~
		    %months{$key} ~ ' days';
	}
}

Output

Jan: 23 days
Feb: 20 days
Mar: 21 days
Apr: 22 days
May: 23 days
Jun: 20 days
Jul: 23 days
Aug: 22 days
Sep: 21 days
Oct: 23 days
Nov: 21 days
Dec: 22 days

---

Hard Challenge

Write a script to find out the DayLight gain/loss in the month of December 2019 as compared to November 2019 in the city of London. You can find out sunrise and sunset data for November 2019 and December 2019 for London.

For the perl5 solution I used DateTime to model the two months and Web::Scraper to scrape the daylight data for each of these month. Then I converted the daylight data from hh::mm::ss into seconds and calculated the difference between the two months. Then I used Time::Seconds to output the data in a readable format.

The reason I decided to scrape the data was that I didn’t want to bother with the api, not figuring out how to cut and paste the data out of the table.

The Raku solution is basically the same, except I don’t Scrape or use Time::Piece.

EDIT: I fixed a bug where the convert_time_to seconds wasn’t calculated correct. It was adding 60 rather than the number of seconds in the hh:mm:ss string.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch2.pl
use strict;
use warnings;
use URI;
use Web::Scraper;
use feature qw /say/;
use String::Util qw /trim/;
use DateTime;
use Time::Seconds;

my $nov = DateTime->new(
	year  => 2019,
	month => 11,
	day   => 1
);

my $dec = DateTime->new(
	year  => 2019,
	month => 12,
	day   => 1
);

compare_lengths($nov, $dec);

# Compare the daylight lengths of 2 months
sub compare_lengths {
	my ($date1, $date2) = @_;

	# Get the data from the web
	my $date1_data =
		get_data($date1->month, $date1->year);
	my $date2_data =
		get_data($date2->month, $date2->year);

	# Calculate totals
	my $date1_total = calculate_daylight_total($date1_data);
	my $date2_total = calculate_daylight_total($date2_data);
	my $difference = $date1_total - $date2_total;

	# Print the output
	say $date1->month_abbr . ' ' . $date1->year . ' has ' .
		Time::Seconds->new($date1_total)->pretty .
		' of daylight.';

	say $date2->month_abbr . ' ' . $date2->year . ' has ' .
		Time::Seconds->new($date2_total)->pretty .
		' of daylight.';

	say "The difference is: " .
		Time::Seconds->new($difference)->pretty . '.';
}

# Calculates the total daylight hours from data
sub calculate_daylight_total {
	my ($data) = @_;
	my $total = 0;

	for my $time_string (@{$data}) {
		$total += convert_time_to_seconds($time_string);
	}

	return $total;
}

# Convert hh::mm::ss to seconds
sub convert_time_to_seconds {
	my ($hh, $mm, $ss) = split(':', shift);
	return $hh * 3600 + $mm * 60 + $ss;
}

# Get the data from the web
sub get_data {
	my ($month, $year) = @_;
	my @data;

	# Scrape the date
	my $url = 'https://www.timeanddate.com/sun/uk/london?' .
		"month=$month&year=$year";

	my $times = scraper {
		process 'table[id="as-monthsun"] td', "times[]" => {
			td_text => 'TEXT',
		}
	};

	my $res = $times->scrape( URI->new( $url ) );

	# Parse the times
	for my $time (@{$res->{times}}) {
		my $e_time = trim($time->{td_text});
		push @data, $e_time
			if ($e_time =~ /^(\d)+\:(\d)+\:(\d)+$/);
	}

	# Output the data
	return \@data;
}

Output

Nov 2019 has 11 days, 3 hours, 0 minutes, 40 seconds of daylight.
Dec 2019 has 10 days, 5 hours, 45 minutes, 1 second of daylight.
The difference is: 21 hours, 15 minutes, 39 seconds.

Raku solution

# Test: perl6 ch2.p6
use v6.d;

# Box configurations
sub MAIN () {
	my $date1 = Date.new(2019,11,1);
	my $date2 = Date.new(2019,12,1);
	compare_lengths($date1, $date2);
}

sub compare_lengths(Date $date1, Date $date2) {
	# Months
	my @mon = (
		'Jan', 'Feb', 'Mar', 'Apr',
		'May', 'Jun', 'Jul', 'Aug',
		'Sep', 'Oct', 'Nov', 'Dec'
	);

	# Get the data from the web
	my @date1_data =
		get-data($date1);
	my @date2_data =
		get-data($date2);

	# Calculate totals
	my $date1_total = calculate-daylight-total(@date1_data);
	my $date2_total = calculate-daylight-total(@date2_data);
	my $difference = $date1_total - $date2_total;

	# Print the output
	say @mon[$date1.month - 1] ~ ' ' ~ $date1.year ~ ' has ' ~
		convert-seconds-to-string($date1_total) ~
		' of daylight.';

	# Print the output
	say @mon[$date2.month - 1] ~ ' ' ~ $date2.year ~ ' has ' ~
		convert-seconds-to-string($date2_total) ~
		' of daylight.';

	say "The difference is: " ~
		convert-seconds-to-string($difference) ~ '.';
}

# Calculates the total daylight hours from data
sub calculate-daylight-total(@data) {
	my $total = 0;
	for (@data) -> $daylight {
		$total += convert-time-to-seconds($daylight).Int;
	}
	return $total
}

# Convert seconds to readable string
sub convert-seconds-to-string (Int $seconds) {
	return ( $seconds.polymod(60, 60, 24) Z
	         ('seconds', 'minutes', 'hours', 'days')
	     	 ).reverse.join(", ");
}

# Convert hh::mm::ss to seconds
sub convert-time-to-seconds(Str $time_string) {
	my ($hh, $mm, $ss) = $time_string.split(':');
	return $hh * 3600 + $mm * 60 + $ss;
}

# A bit of a cheat, I built the Scraper
# in perl5 so don't reinvent the wheel
# Gets the daytime data
sub get-data(Date $date) {
	my %data = (
		'2019-11-01' => (
			'9:40:44', '9:37:10', '9:33:37', '9:30:07',
			'9:26:38', '9:23:11', '9:19:45', '9:16:22',
			'9:13:01', '9:09:42', '9:06:25', '9:03:11',
			'8:59:59', '8:56:50', '8:53:44', '8:50:40',
			'8:47:39', '8:44:42', '8:41:48', '8:38:57',
			'8:36:09', '8:33:25', '8:30:45', '8:28:09',
			'8:25:36', '8:23:08', '8:20:44', '8:18:24',
			'8:16:09', '8:13:59'
		),
		'2019-12-01' => (
			'8:11:53', '8:09:53', '8:07:57', '8:06:07',
			'8:04:22', '8:02:42', '8:01:08', '7:59:40',
			'7:58:17', '7:57:00', '7:55:50', '7:54:45',
			'7:53:46', '7:52:54', '7:52:07', '7:51:27',
			'7:50:54', '7:50:27', '7:50:06', '7:49:52',
			'7:49:44', '7:49:43', '7:49:48', '7:50:00',
			'7:50:19', '7:50:44', '7:51:15', '7:51:53',
			'7:52:37', '7:53:27', '7:54:24'
		),
	);

	return @(%data.{$date});
}

Output

Nov 2019 has 11 days, 3 hours, 0 minutes, 40 seconds of daylight.
Dec 2019 has 10 days, 5 hours, 45 minutes, 1 seconds of daylight.
The difference is: 0 days, 21 hours, 15 minutes, 39 seconds.