PERL WEEKLY CHALLENGE – 053

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

---

Task 1

Rotate Matrix

Write a script to rotate the following matrix by given 90/180/270 degrees clockwise.

[ 1, 2, 3 ]
[ 4, 5, 6 ]
[ 7, 8, 9 ]

For example, if you rotate by 90 degrees then expected result should be like below

[ 7, 4, 1 ]
[ 8, 5, 2 ]
[ 9, 6, 3 ]

For Perl and Raku, I generated he matrix as a list of lists and and rotated the matrix from the outside in using an algorithm I found here:

https://www.geeksforgeeks.org/inplace-rotate-square-matrix-by-90-degrees/

This algorithm is quite cheap on space only requiring an extra variable to store the number and scales to any matix size.

The problem with this is that the matrix rotated the wrong way, so I needed to change some of the indices of the matrix to get it to rotate the correct way.

Perl 5 solution

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

# 3 x 3 matrix
my $three = [
	[1,2,3],
	[4,5,6],
	[7,8,9],
];

say 'Original ';
print_matrix($three);

for (my $i = 1; $i < 4; $i++) {
	say 'Rotate ' . 90 * $i;
	rotate_matrix($three);
	print_matrix($three);
}

# Rotate the matrix
sub rotate_matrix {
	my $m = shift;

	# Size of the matrix
	my $n = scalar(@$m);

	for (my $i = 0; $i < int($n / 2); $i++) {
		for (my $j = $i; $j < $n - $i - 1; $j++) {
			my $temp = $m->[$i]->[$j];
			$m->[$i]->[$j]           = $m->[$n-$j-1]->[$i];
			$m->[$n-$j-1]->[$i]      = $m->[$n-$i-1]->[$n-$j-1];
			$m->[$n-$i-1]->[$n-$j-1] = $m->[$j]->[$n-$i-1];
			$m->[$j]->[$n-$i-1]      = $temp;
		}
	}
}

# Print the matrix
sub print_matrix {
	my $m = shift;

	# Max length of the attributes
	my $length = length(scalar(@$m)**2) + 1;

	for my $row (@$m) {
		say map { sprintf ( " %${length}d", $_ ) } @$row;
	}
}

Output

Original
  1  2  3
  4  5  6
  7  8  9
Rotate 90
  7  4  1
  8  5  2
  9  6  3
Rotate 180
  9  8  7
  6  5  4
  3  2  1
Rotate 270
  3  6  9
  2  5  8
  1  4  7

Raku solution

#!/usr/bin/perl
# Test: ./ch-6.p6

multi MAIN() {

	# 3 x 3 matrix
	my @three = (
		[1,2,3],
		[4,5,6],
		[7,8,9]
	);

	say 'Original ';
	print-matrix(@three);

	loop (my $i = 1; $i < 4; $i++) {
		say 'Rotate ' ~ 90 * $i;
		rotate-matrix(@three);
		print-matrix(@three) ;
	}
}

# Rotate the matrix
sub rotate-matrix(@m) {
	my $n = @m.elems;

	loop (my $i = 0; $i < Int($n / 2); $i++) {
		loop (my $j = $i; $j < $n - $i - 1; $j++) {
			my $temp = @m[$i; $j];
			@m[$i; $j]           = @m[$n-$j-1; $i];
			@m[$n-$j-1; $i]      = @m[$n-$i-1; $n-$j-1];
			@m[$n-$i-1; $n-$j-1] = @m[$j; $n-$i-1];
			@m[$j; $n-$i-1]      = $temp;
		}
	}
}

# Print the matrix
sub print-matrix(@m) {
	for (@m) -> $row {
		say $row.map(->
			$value {
				sprintf("%3d", $value)
			}
		).join;
	}
}

Output

Original
  1  2  3
  4  5  6
  7  8  9
Rotate 90
  7  4  1
  8  5  2
  9  6  3
Rotate 180
  9  8  7
  6  5  4
  3  2  1
Rotate 270
  3  6  9
  2  5  8
  1  4  7

---

Task 2

Vowel Strings

Write a script to accept an integer 1 <= N <= 5 that would print all possible strings of size N formed by using only vowels (a, e, i, o, u).

The string should follow the following rules:

1. ‘a’ can only be followed by ‘e’ and ‘i’.
2. ‘e’ can only be followed by ‘i’.
3. ‘i’ can only be followed by ‘a’, ‘e’, ‘o’, and ‘u’.
4. ‘o’ can only be followed by ‘a’ and ‘u’.
5. ‘u’ can only be followed by ‘o’ and ‘e’.

For example, if the given integer N = 2 then script should print the following strings:

ae
ai
ei
ia
io
iu
ie
oa
ou
uo
ue

---

For this task I just generated all the possible variations of the string and checked it against the rules.

I just use perl5 https://metacpan.org/pod/Algorithm::Combinatorics variations_with_repetition method to generate the combinations.

In Raku a just generated a @vowels list based on the number of letters and generated all possible combinations. Then I checked the combinations if it followed the rules and de-duplicated the output.

Perl 5 solution

#!/usr/bin/perl
# Test: ./ch-2.pl 3
use strict;
use warnings;
use feature qw /say/;
use Algorithm::Combinatorics qw(variations_with_repetition);

my $size = $ARGV[0] || 5;
my @vowels = ('a', 'e', 'i', 'o', 'u');

my $iter = variations_with_repetition(\@vowels,$size);
while (my $v = $iter->next) {
	say join '', @$v
		if (valid_combination($v));
}

# IS valid combination
sub valid_combination {
	my $word = shift;

	# Faster than a regex
	for (my $i = 0; $i < scalar(@$word) - 1; $i++) {
		return 0 unless
		_check_letters($word, $i, 'a', 'e', 'i') &&
		_check_letters($word, $i, 'e', 'i') &&
		_check_letters($word, $i, 'i', 'a', 'e', 'o', 'u') &&
		_check_letters($word, $i, 'o', 'a', 'u') &&
		_check_letters($word, $i, 'u', 'o', 'e');
	}

	return 1;
}

# Check the folowing letters
sub _check_letters {
	my ($word, $i, $letter, @checks) = @_;
	my $valid = 1;

	if ($word->[$i] eq $letter) {
		$valid = 0;
		for my $check (@checks) {
			$valid = 1
				if ($word->[$i + 1] eq $check);
		}
	}

	return $valid;
}

Output

ae
ai
ei
ia
ie
io
iu
oa
ou
ue
uo

Raku solution

# Test: perl6 ch-2.p6
multi MAIN { MAIN(2) };

multi MAIN(Int $size) {
	# Generate the possible combinations
	my @vowels;
	push @vowels, 'a', 'e', 'i', 'o', 'u'
		for (1 .. $size);
	my @combos = @vowels.combinations: $size;

	# Check each combination
	my @solutions;
	for @combos.unique -> @combo {
		push @solutions, @combo.join
			if (valid-combination(@combo));
	}

	# Print the solutions
	.say for @solutions.unique.sort;
}

# IS valid combination
sub valid-combination(@word) {
	# Faster than a regex
	loop (my $i = 0; $i < @word.elems - 1; $i++) {
		return 0 unless
			_check-letters(@word, $i, 'a', ['e','i']) &&
			_check-letters(@word, $i, 'e', ['i']) &&
			_check-letters(@word, $i, 'i', ['a', 'e', 'o', 'u']) &&
			_check-letters(@word, $i, 'o', ['a', 'u']) &&
			_check-letters(@word, $i, 'u', ['o', 'e']);
	}

	return 1;
}

# Check the folowing letters
sub _check-letters(@word, Int $i, $letter, @checks) {
	my $valid = True;

	if (@word[$i] eq $letter) {
		$valid = False;
		for (@checks) -> $check {
			$valid = True
				if (@word[$i + 1] eq $check);
		}
	}

	return $valid;
}

Output

ae
ai
ei
ia
ie
io
iu
oa
ou
ue
uo