Continues from previous week.
Welcome to the Perl review for Week 053 of the Weekly Challenge! For a quick overview, go through the original tasks and recap of the weekly challenge.
Getting in Touch
Email › Email me (Ryan) with any feedback about this review.
GitHub › Submit a pull request for any issues you may find with this page.
Twitter › Join the discussion on Twitter!
We’d greatly appreciate any feedback you’d like to give.
Table of Contents
Task 1 › Rotate Matrix
[ Alicia Bielsa  Andrezgz  Athanasius  CheokYin Fung  Colin Crain  Cristina Heredia  Dave Cross  Dave Jacoby  Duncan C. White  E. Choroba  Jaldhar H. Vyas  Javier Luque  Laurent Rosenfeld  Lubos Kolouch  Mohammad S Anwar  Roger Bell West  Ruben Westerberg  Ryan Thompson  Saif Ahmed  User Person  Wanderdoc  Yet Ebreo ]
Task 2 › Vowel Strings
[ Alicia Bielsa  Andrezgz  Athanasius  CheokYin Fung  Colin Crain  Dave Cross  Dave Jacoby  Duncan C. White  E. Choroba  Jaldhar H. Vyas  Javier Luque  Laurent Rosenfeld  Lubos Kolouch  Markus Holzer  Mohammad S Anwar  Pete Houston  Roger Bell West  Ruben Westerberg  Ryan Thompson  Saif Ahmed  User Person  Wanderdoc  Yet Ebreo ]
Blogs
Task #1 › Rotate Matrix
The original task description:
Write a script to rotate the following matrix by given 90/180/270 degrees clockwise
[[ 1, 2, 3 ],
[ 4, 5, 6 ],
[ 7, 8, 9 ]]
Since the task asks us to rotate the matrix clockwise, what we have isn’t quite the same as a matrix transposition (where rows and columns are swapped), but it’s also not that far off, and can be solved in much the same way, looping over each cell and placing it in its correct position in the new array.
Most hackers wrote just one rotation subroutine, and then called it one, two, or three times, corresponding to 90, 180, or 270 degrees of rotation. While this is a bit slower, it avoids nearduplicated code.
Supported Inputs
There was some variation in what shapes of matrices are supported. There were solutions with the following:
 Task matrix only: Some solutions only support the specific matrix as given by the task description, meaning, the values are hardcoded.
 3x3 matrices: Some solutions support any 3x3 matrix, but other sizes are not supported.
 NxN square matrices: Some solutions accept any “square” matrix (i.e., same number of rows and columns)
 MxN matrices: The most general solutions support any arbitrary number of rows, and columns.
If your program accepted an MxN matrix but produced incorrect results, I generally assumed you did not intend to support MxN matrices.
Stats

Number of submissions: 22

Total SLOC: 1287

Average SLOC: 58
Alicia Bielsa
Alicia Bielsa’s solution supports NxN (square) matrices. She defines a rotateMatrix90Degrees
sub that does the hard work:
sub rotateMatrix90Degrees {
my $refMatrix = shift;
my @aNewMatrix = ();
foreach my $x (0..$#{$refMatrix}){
foreach my $y (0..$#{$$refMatrix[$x]}){
$aNewMatrix[$y][$#aMatrix  $x] = $$refMatrix[$x][$y] ;
}
}
return @aNewMatrix;
}
She then defines a rotateMatrix
sub that accepts the matrix, and a rotation angle in degrees:
sub rotateMatrix {
my $refMatrix = shift;
my $degrees = shift;
my @aMatrixRotating =@{$refMatrix};
while ( $degrees / 90 >= 1 ) {
@aMatrixRotating = rotateMatrix90Degrees(\@aMatrixRotating);
$degrees = 90;
}
return @aMatrixRotating;
}
And, finally, drawMatrix
is a nice touch:
sub drawMatrix {
my $refMatrix = shift;
foreach my $row (@{$refMatrix}){
print "[ ".join(', ',@{$row}). " ]\n";
}
}
Andrezgz
Andrezgz’s solution supports MxN matrices, by calling their 90degree rotate
sub as many times as needed:
# Rotate matrix clockwise the number of times specified
$matrix = rotate($matrix) for (1 .. $rotation);
# Rotated matrix is printed
print '[ ', join(' , ', $matrix>[$_]>@*) , " ]\n"
for ( 0 .. $matrix>@*  1 );
sub rotate {
my $input = shift;
my $output = [];
foreach my $r ( 0 .. $input>@*  1 ){
foreach my $c ( 0.. $input>[0]>@*  1 ){
# Each element of the input matrix is appended to the output matrix
# at the beginning of the row defined by its column from the input matrix
unshift @{$output>[$c]}, $input>[$r]>[$c];
}
}
return $output;
}
Athanasius
Athanasius’s solution supports 3x3 matrices:
sub rotate {
my ( $degrees, $old_matrix ) = @_;
exists $ROTATIONS{$degrees}
or die "ERROR: Rotation of $degrees° is not supported\n";
my @new_matrix;
for my $r_new ( 0 .. 2 ) # Rows
{
for my $c_new ( 0 .. 2 ) # Columns
{
my ( $r_old, $c_old ) = $ROTATIONS{$degrees}>[$r_new][$c_new]>@*;
$new_matrix[$r_new]>[$c_new] = $old_matrix>[$r_old][$c_old];
}
}
return \@new_matrix;
}
CheokYin Fung
CheokYin Fung’s solution gives us rcaqx
which is short for “Rotation_Clockwise_A_Quarter, x for multiple”. Rolls right off the tongue! It supports 3x3 matrices:
sub rcaqx {
if ($_[0]>=1) {
my %nhash;
for (0..8) {
if ( $cp[$_] >= 0 ) {
$nhash{ $cp[$_] } = $hash{ ($cp[($_ )]+2) % 8 };
}
}
$nhash{1} = $hash{1};
%hash = %nhash;
rcaqx($_[0]1);
}
}
rcaqx($ANGLE/90);
However, that’s not all! Cheok Yin submitted a second solution for Task #1, which is more advanced. It supports any square (NxN) matrix, and makes use of a custom xy
class:
package xy;
use strict;
sub new {
my ($class) = @_;
bless{
_value=> $_[1],
_x=>$_[2],
_y=>$_[3],
}, $class;
}
sub x{ $_[0]>{_x}}
sub y{ $_[0]>{_y}}
sub value{ $_[0]>{_value} }
The new and improved rcaqx
looks like this:
sub rcaqx {
if ($_[2]>=1) {
my ($xcoord, $ycoord) = ($_[0], $_[1]);
$_[0] = $ycoord;
$_[1] = $xcoord;
return rcaqx($_[0], $_[1], $_[2]1);
} else {return ($_[0], $_[1])}
}
Coordinate translation helpers:
sub translation_add_negT {
$_[0] = $T>[0];
$_[1] = $T>[1];
return ($_[0], $_[1])
}
sub translation_add_T {
$_[0] += $T>[0];
$_[1] += $T>[1];
return ($_[0], $_[1])
}
And finally, here is how all of the above routines come together to actually perform the rotation:
for $i (1..$N*$N) {
$newmatrix>[$i] = xy>new($matrix>[$i]>value,
translation_add_negT(rcaqx ((translation_add_T(
$matrix>[$i]>x, $matrix>[$i]>y) ), $ANGLE/90 )) );
$coordinateplane[position( $newmatrix>[$i]>x, $newmatrix>[$i]>y )]
= $newmatrix>[$i]>value;
}
Cheok Yin is now blogging twice per week about the PWC! (See Cheok Yin’s Task #2 solution for a link to her second blog post.)
Blog › Rotation in R^2  CY’s take on PWC#053 Task 1
Colin Crain
Colin Crain’s solution went the extra mile and implemented separate routines, optimized for each of the 90, 180, and 270 degree rotations, and his is the first solution we’ve seen that supports MxN matrices:
sub rotate90 {
## matrix is an array ref of array refs
## zip and reverse subarray elements
my $matrix = shift;
my $output;
my $cols = scalar $matrix>[0]>@*; ## subarray elements, or num of cols
my $rows = scalar $matrix>@*; ## array elements, or num of rows
for my $idx ( 0..$cols1 ) { ## for each index in a row
my @newrow;
for my $row ( 0..$rows1 ) { ## for each row
unshift @newrow, $matrix>[$row]>[$idx]; ## reverse rows
}
push $output>@*, \@newrow; ## forward cols
}
return $output;
}
sub rotate180 {
## matrix is an array ref of array refs
## reverse each subarray, then reverse the outer array
my $matrix = shift;
my $output;
for my $row ( $matrix>@* ) {
my @newrow = reverse $row>@*;
unshift $output>@*, \@newrow;
}
return $output;
}
sub rotate270 {
## matrix is an array ref of array refs
## zip and reverse subarrays in outer array
my $matrix = shift;
my $output;
my $cols = scalar $matrix>[0]>@*; ## subarray elements, or num of cols
my $rows = scalar $matrix>@*; ## array elements, or num of rows
for my $idx ( 0..$cols1 ) {
my @newrow;
for my $row ( 0..$rows1 ) {
push @newrow, $matrix>[$row]>[$idx]; ## forward rows
}
unshift $output>@*, \@newrow; ## reverse cols
}
return $output;
}
Cristina Heredia
Cristina Heredia’s solution has all three allowed rotations for the task’s matrix hardcoded:
sub rotateMatix {
if ($choise == '90') {
@array = (
[7, 4, 1],
[8, 5, 2],
[9, 6, 3]
);
printArray();
}
elsif ($choise == '180') {
@array = (
[9, 8, 7],
[6, 5, 4],
[3, 2, 1]
);
printArray();
}
elsif ($choise == '270') {
@array = (
[3, 6, 9],
[2, 5, 8],
[1, 4, 7]
);
printArray();
}
else {
print "The value $choise isn't valid, please choose between: 90, 180 or 270\n";
$choise = <>;
$choise =~ s/^\s+\s+$//g;
rotateMatix();
}
}
She provides a printArray
sub to prettyprint the output matrix:
sub printArray {
for(my $i = 0; $i < 3; $i++) {
for(my $j = 0; $j < 3; $j++) {
print "$array[$i][$j] ";
}
print "\n";
}
}
Dave Cross
Dave Cross’s solution supports square (NxN) matrices. The rotate_matrix
sub handles rotations by any of 90, 180, and 270 degrees:
sub rotate_matrix {
my ( $matrix, $degrees ) = @_;
die "Must give rotation in degrees\n" unless $degrees;
die "Must rotate by 90, 180 or 270 degrees\n"
if $degrees =~ /\D/
or $degrees % 90
or $degrees > 270;
my $rotated_matrix;
for ( 1 .. $degrees / 90 ) {
$rotated_matrix = [];
for my $i ( 0 .. $#$matrix ) {
for my $j ( 0 .. $#{ $matrix>[$i] } ) {
$rotated_matrix>[$j][ $#{ $matrix>[$i] }  $i ] =
$matrix>[$i][$j];
}
}
$matrix = $rotated_matrix;
}
return $rotated_matrix;
}
Dave Jacoby
Dave Jacoby’s solution supports MxN matrices, and provides separate routines for each rotation amount:
sub rotate_90( $array ) {
my $x = 1 + scalar $array>@*;
my $y = 1 + scalar $array>[0]>@*;
my $output = [];
for my $i ( 0 .. $x ) {
my $jj = $i;
for my $j ( 0 .. $y ) {
my $ii = $y  $j;
$output>[$i][$j] = int $array>[$ii][$jj];
}
}
return $output;
}
sub rotate_180( $array ) {
my $x = 1 + scalar $array>@*;
my $y = 1 + scalar $array>[0]>@*;
my $output = [];
for my $i ( 0 .. $x ) {
my $jj = $x  $i;
for my $j ( 0 .. $y ) {
my $ii = $y  $j;
$output>[$i][$j] = int $array>[$ii][$jj];
}
}
return $output;
}
sub rotate_270($array) {
my $x = 1 + scalar $array>@*;
my $y = 1 + scalar $array>[0]>@*;
my $output = [];
for my $i ( 0 .. $x ) {
my $jj = $x  $i;
for my $j ( 0 .. $y ) {
my $ii = $j;
$output>[$i][$j] = int $array>[$ii][$jj];
}
}
return $output;
}
Blog › Rotate Your Matrix and String Your Vowels
Duncan C. White
Duncan C. White’s solution supports 3x3 matrices, but the fun part is his OO implementation which overrides stringification to handle the matrix prettyprinting:
package Matrix;
use parent "Clone";
use overload '""' => \&as_str;
sub as_str ($) {
my( $self ) = @_;
my @r = map { join( ', ', @$_ ) } @$self;
my $str = "\n" . join( "\n", @r ) . "\n";
#say "debug: $str";
return $str;
}
The constructor accepts a string such as 1 2 3/4 5 6/7 8 9
:
method new( $class: $matrixstr ) {
my $mat = [];
if( $matrixstr ) {
my @row = split( m/, $matrixstr );
die "Matrix>new( $matrixstr ): badly formed matrix string, should be 2 '/'s\n"
unless @row == 3;
foreach my $rowstr (@row) {
my @col = split( /\s+/, $rowstr );
die "Matrix>new( $matrixstr ): badly formed matrix string, row $rowstr\n"
unless @col == 3;
push @$mat, \@col;
}
}
return bless $mat, $class;
}
And finally the rotate90
method does $n
clockwise rotation(s):
method rotate90( $n ) {
$n %= 4;
for my $i (1..$n) {
my $mat = Matrix>new( "" );
foreach my $col (0..2) {
my @newrow = ();
foreach my $row (2,1,0) {
push @newrow, $self>[$row][$col];
}
$mat>[$col] = \@newrow;
}
@$self = @$mat;
}
}
The package is then used like this:
# initial matrix
my $initmat = Matrix>new( "1 2 3/4 5 6/7 8 9" );
say "initmat is $initmat";
$mat>rotate90( $times );
say "$initmat rotated $times time(s) is $mat";
E. Choroba
E. Choroba’s solution uses an old favourite, PDL
, to assist with the matrix transposition:
use PDL;
my $matrix = pdl([1, 2, 3],
[4, 5, 6],
[7, 8, 9]);
for my $rotation (0, 90, 180, 270) {
my $times = $rotation / 90;
my $result = $matrix;
$result = $result>transpose>slice([1, 0]) for 1 .. $times;
print "$rotation:$result";
}
Since the clockwise rotation we are tasked with is different from a true matrix transposition, Choroba uses PDL’s slice
to flip the matrix and get the correct result.
Blog › Perl Weekly Challenge 053: Rotate Matrix and Vowel Strings
Jaldhar H. Vyas
Jaldhar H. Vyas’s solution supports NxN square matrices, specified within the rotate
sub:
sub rotate {
my ($angle) = @_;
my @matrix = (
[ 1, 2, 3 ],
[ 4, 5, 6 ],
[ 7, 8, 9 ],
);
my $side = scalar @matrix;
for (1 .. $angle / 90) {
for my $row (0 .. ($side / 2)  1) {
for my $col ($row .. ($side  $row  1)  1) {
my $temp = $matrix[$row][$col];
$matrix[$row][$col] = $matrix[$side  1  $col][$row];
$matrix[$side  1  $col][$row] =
$matrix[$side  1  $row][$side  1  $col];
$matrix[$side  1  $row][$side  1  $col] =
$matrix[$col][$side  1  $row];
$matrix[$col][$side  1 $row] = $temp;
}
}
}
return @matrix;
}
The code operates by spiraling inward from all four corners, in the following order:
[ 0, 1, 2, 3, 0 ]
[ 3, 4, 5, 4, 1 ]
[ 2, 5, 13, 5, 2 ]
[ 1, 4, 5, 4, 3 ]
[ 0, 3, 2, 1, 0 ]
The numbers shown are a simple count of the number of times the inner loop has run. The 13
in the middle is a sideeffect of the loop bounds.
Blog › Jaldhar’s Week #053 Blog
Javier Luque
Javier Luque’s solution supports NxN square matrices, and is called multiple times to effect rotations in multiples of 90 degrees:
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$j1]>[$i];
$m>[$n$j1]>[$i] = $m>[$n$i1]>[$n$j1];
$m>[$n$i1]>[$n$j1] = $m>[$j]>[$n$i1];
$m>[$j]>[$n$i1] = $temp;
}
}
}
This rotation also spirals inward.
Blog › 053 – Perl Weekly Challenge
Laurent Rosenfeld
Laurent Rosenfeld’s solution supports NxN matrices, via repeated calls to rotate_90
:
sub rotate_90 {
my $input = shift;
my @output;
for my $row (0 .. $#$input) {
for my $col (0 .. $#{@$input[$row]}) {
$output[$col][$#{@$input[$row]}  $row] = $input>[$row][$col];
}
}
return \@output;
}
sub rotate_180 {rotate_90 rotate_90 @_}
sub rotate_270 {rotate_90 rotate_180 @_}
Blog › Rotate Matrix and Vowel Strings
Lubos Kolouch
Lubos Kolouch’s
solution also uses PDL
:
use PDL;
my $m = sequence(3,3)+1;
print($m);
for (0..2) {
say(90*($_+1));
$m = $m>transpose>slice([1,0]);
print($m);
}
Lubos credits the StackOverflow question Use Perl PDL to rotate a matrix for figuring out the rotation, and also credits Choroba’s solution for the use of >slice
. Doing the research and crediting sources is the mark of a good programmer, and I really appreciate it.
Mohammad S Anwar
Mohammad S Anwar’s solution supports 3x3 matrices only. Mohammad has been doing good work with the Test
family, providing unit tests for his solutions. Here is how he organized the tests for this task:
use Test::More;
use Test::Deep;
my $unit_tests = {
90 => {
in => [ [ 1, 2, 3 ], [ 4, 5, 6 ], [ 7, 8, 9 ] ],
out => [ [ 7, 4, 1 ], [ 8, 5, 2 ], [ 9, 6, 3 ] ],
},
180 => {
in => [ [ 1, 2, 3 ], [ 4, 5, 6 ], [ 7, 8, 9 ] ],
out => [ [ 9, 8, 7 ], [ 6, 5, 4 ], [ 3, 2, 1 ] ],
},
270 => {
in => [ [ 1, 2, 3 ], [ 4, 5, 6 ], [ 7, 8, 9 ] ],
out => [ [ 3, 6, 9 ], [ 2, 5, 8 ], [ 1, 4, 7 ] ],
},
};
foreach my $degree (sort { $a <=> $b } keys %$unit_tests) {
my $in = $unit_tests>{$degree}>{in};
my $out = $unit_tests>{$degree}>{out};
cmp_deeply(rotate_matrix($in, $degree), $out, "rotation by $degree.");
}
done_testing;
I can’t count the number of times I’ve opened up a CPAN distribution and looked at the unit tests, only to see an unorganized mess of individual tests with duplicated code. It’s easy to forget that unit tests are code, too. Mohammad hasn’t forgotten that, and took the time to factor out the common code in his tests, for a more maintainable and readable result.
Here is the rotate_matrix
that handles any 3x3 matrix:
sub rotate_matrix {
my ($matrix, $degree) = @_;
foreach my $i ( 1 .. int($degree/90) ) {
my $rows = @$matrix;
my $cols = @{$matrix>[0]};
my $_matrix = [];
foreach my $i ( 0 .. $rows1 ) {
my $k = 2;
foreach my $j ( 0 .. $cols1 ) {
$_matrix>[$i][$j] = $matrix>[$k][$i];
$k;
}
}
$matrix = $_matrix;
}
return $matrix;
}
Blog › BLOG: The Weekly Challenge #053
Roger Bell West
Roger Bell West’s solution works with any NxN (square) matrix:
sub rotate {
my ( $rotations, @in ) = @_;
my $xs = $#in;
foreach my $ya (@in) {
if ( $#{$ya} != $xs ) {
die "not a square matrix\n";
}
}
my @out = @in;
foreach ( 1 .. $rotations ) {
my @im = @out;
my @tmp;
foreach my $x ( 0 .. $xs ) {
foreach my $y ( 0 .. $xs ) {
$tmp[$y][ $xs  $x ] = $im[$x][$y];
}
}
@out = @tmp;
}
return @out;
}
Ruben Westerberg
Ruben Westerberg’s solution supports 3x3 matrices only, but does so in style, with trigonometry. I suppose we should have held this task just a little sooner, so it would line up with Pi Day, March 14th!
Ruben uses core module Math::Trig
for its pi
routines only, and POSIX
‘s round
:
use Math::Trig ':pi';
use POSIX qw<round>;
With basic trigonometry, @ir
and @ic
give the input rows and columns, for a respective 0..7 index into the 3x3 array. (pip4
is a Math::Trig
equivalent for pi*4
.)
sub rotate {
my ($input,$angle)=@_;
#input indexing
my @ip=map {pip4 *$_} 0..7;
my @ir=map {1+round sin} @ip;
my @ic=map {1+round cos} @ip;
#output indexing
my @polar=map {($angle/180 *pi) + pip4 *$_} 0..7;
my @row= map {1+round sin} @polar;
my @col =map {1+round cos} @polar;
For a 90 degree rotation, the arrays look like this:
@ir = ( 1, 2, 2, 2, 1, 0, 0, 0 );
@ic = ( 2, 2, 1, 0, 0, 0, 1, 2 );
@row = ( 2, 2, 1, 0, 0, 0, 1, 2 );
@col = ( 1, 0, 0, 0, 1, 2, 2, 2 );
Thus, each column in the above gives a coordinate mapping from input to output, for a single element in the 3x3 array. For example, the first column gives you a mapping from [1,2] to [2,1].
If you were wondering, “why index 0..7, instead of 0..8?", you are right to wonder that. Ruben handles the middle element (1,1) separately:
my $out=[[],[],[]];
$out>[1]>[1]=$matrix>[1]>[1];
Meanwhile, here is the line that handles the rest of the assignments from the input array¹ to the output array:
$out>[$row[$_]]>[$col[$_]]=$matrix>[$ir[$_]]>[$ic[$_]] for (0..@col1);
¹. Despite taking an $input
argument, rotate
always uses $matrix
. I suspect this is a simple oversight.
Ryan Thompson
My solution handles any MxN matrix:
sub rotate90_cw {
my @A = reverse @{$_[0]};
my @T;
for my $x (0..$#A) {
$T[$_][$x] = $A[$x][$_] for 0..$#{$A[0]};
}
\@T;
}
You might notice I reverse
the rows in the input array first. That’s a stylistic choice so the rest of the function could be a simple transpose, much like my Raku submission; I could have instead mirrored the output columns.
The additional rotations are simply defined in terms of rotate90_cw
:
# Convenience
sub rotate180 { rotate90_cw( rotate90_cw (@_) ) }
sub rotate_ccw { rotate90_cw( rotate180( @_) ) }
I also provided a number of unit tests, making sure I hit the important edge cases like 1xN, Mx1, and nonnumeric cell contents:
# 1xN, Nx1
is_deeply rotate90_cw( [[1,2,3]]), [[1],[2],[3]];
is_deeply rotate90_cw( [[1],[2],[3]]), [[3,2,1]];
# Nonnumeric, because why not
is_deeply rotate90_cw ( [['a','b','c'], ['d','e','f']] ),
[['d','a'],['e','b'],['f','c']];
Blog › Matrix Rotation
Saif Ahmed
Saif Ahmed’s solution works on any MxN matrix, and also does more than just rotate. Here are the supported “rotation” options:
0
,90
,180
,270
: Clockwise rotation by degreescw
,ht,
ccw`: Aliases for above. “Clockwise","Half Turn", “CounterClockwise”v
,h
: Flip vertically or horizontallylr
: Flip top left to bottom right diagonalrl
: Flip bottom right to top left diagonal
Here is the flip
sub in its entirety:
sub flip {
my $arr = shift;
my $direction = shift;
my @flipped = ();
return $arr unless $direction; # return original list for 0 deg trun
if ( $direction =~ /^cwccwlrrl90270$/ ) {
foreach my $row ( 0 .. scalar @{ $$arr[0] }  1 ) { # for each row
$flipped[$row] = []; # initialise empty row
foreach my $col ( 0 .. scalar @$arr  1 ) { # for each column
push @{ $flipped[$row] },
$$arr[$col][$row]; # this does a diagonal flip
}
@{ $flipped[$row] } = reverse @{ $flipped[$row] }
if $direction =~ /^cw90rl$/;
}
@flipped = reverse @flipped if $direction =~ /^ccw270rl$/;
}
elsif ( $direction eq 'v' ) {
@flipped = reverse(@$arr);
}
elsif ( $direction eq 'h' ) {
my $row = 0;
foreach (@$arr) {
@{ $flipped[ $row++ ] } = reverse @$_;
}
}
elsif ( $direction =~ /^180ht$/ ) {
@flipped = @{ flip( flip( $arr, "v" ), "h" ) };
}
return \@flipped;
}
The factorization of logic for cwccwlrrl90270
all into the same block is rather elegant.
The real star of the show, however, has to be Saif’s second set of test cases. While everyone else had me staring at numbers to try and figure out if they all rotated into their proper places, Saif eschewed from such eyestraininducing numerals, in favour of this majestic bit of ASCII:
my $matrix2=[[qw{   █  }],
[qw{   ░ █ }],
[qw{█ █ █ ░ ░ █}],
[qw{   ░ █ }],
[qw{   █  }]];
The output makes it extremely obvious to verify:
Rotating by 0
█
░█
███░░█
░█
█
Rotating by 90
█
█
█
█░░░█
█░█
█
Rotating by 180
█
█░
█░░███
█░
█
Rotating by 270
█
█░█
█░░░█
█
█
█
Arrows or not, Saif’s solutions are always a joy to review.
User Person
User Person’s solution works on 3x3 matrices only:
User Person has a recursive array flattener, that they will use:
sub flat {
return map { ref eq 'ARRAY' ? flat(@$_) : $_ } @_;
}
User Person uses this to flatten the input AoA, @matrix
, into @rawNums
:
my @rawNums = ();
@rawNums = flat @matrix;
Now, depending on the $deg
(degrees) input, User Person loops through @newMatrix
differently. @rawNums
is flat, and is always iterated in order, giving it a rowmajor traversal every time:
my @newMatrix = ();
my $i = 0;
if ($deg == 0) {
for (my $j = 0; $j < $width; ++$j) {
for (my $k = 0; $k < $width; ++$k) {
$newMatrix[$j][$k] = $rawNums[$i++];
}
}
} elsif ( $deg == 90 ) {
for (my $j = $width1; $j >= 0; $j) {
for (my $k = 0; $k < $width; ++$k) {
$newMatrix[$k][$j] = $rawNums[$i++];
}
}
} elsif ( $deg == 180 ) {
for (my $j = $width1; $j >= 0; $j) {
for (my $k = $width1; $k >= 0; $k) {
$newMatrix[$j][$k] = $rawNums[$i++];
}
}
} elsif ( $deg == 270 ) {
for (my $j = 0; $j < $width; ++$j) {
for (my $k = $width1; $k >= 0; $k) {
$newMatrix[$k][$j] = $rawNums[$i++];
}
}
}
Wanderdoc
Wanderdoc’s solution includes a rotate
sub that supports any MxN matrix:
sub rotate {
my ( $aref, $angle ) = @_;
my $rotated;
for my $row_idx ( 0 .. $#$aref ) {
for my $col_idx ( 0 .. $#{ $aref>[$row_idx] } ) {
if ( 90 == $angle ) {
$rotated>[$col_idx][ $#$aref  $row_idx ] =
$aref>[$row_idx][$col_idx];
}
elsif ( 180 == $angle ) {
$rotated>[ $#$aref  $row_idx ]
[ $#{ $aref>[$row_idx] }  $col_idx ] =
$aref>[$row_idx][$col_idx];
}
elsif ( 270 == $angle ) {
$rotated>[ $#{ $aref>[$row_idx] }  $col_idx ][$row_idx] =
$aref>[$row_idx][$col_idx];
}
else {
die
"Can only rotate a matrix by 90/180/270 degrees clockwise!$/";
}
}
}
return $rotated;
}
The sub also directly implements the three different rotation angles, so this is also an optimally efficient solution. Nice!
Yet Ebreo
Yet Ebreo’s solution supports MxN matrices:
#Obfuscated routine to rotate array 90cw, because it's perl. :D
sub rotate {@{$_[0]}=map[map$_[0]>[$_][$'],//..@{$_[0]}],0..~@{$_[0]>[0]}}
Again, with a little whitespace:
# Deobfuscated [Ryan]
sub rotate {
my ($matrix) = @_;
@$matrix = map [ map $matrix>[ $_ ][ $' ] => // .. @$matrix ],
0 .. $#{ $matrix>[0] };
}
We can now clearly see the rotation is done inplace. Once you run it through perltidy
, there isn’t anything too unusual here. There is one old Perl golf trick, with $'
($POSTMATCH
) and the empty regex (//
) as the start of a ..
range. This is a way to (sort of) access the outer $_
loop variable in the inner loop, without having to assign either of them to a different named variable. After //
, $'
effectively becomes an alias for the outer $_
.
Task #2 › Vowel Strings
Here is Mohammad’s description, abridged:
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:
a
can only be followed bye
andi
.e
can only be followed byi
.i
can only be followed bya
,e
,o
, andu
.o
can only be followed bya
andu
.u
can only be followed byo
ande
.
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
Solution Types
This task is a directed graph traversal. The “rules,” above, define the valid edges. With that in mind, one can implement the graph traversal in any number of ways, or, indeed, go a completely different direction, as we’ll see.
Dispatch Tables
Most people used a dispatch table to store the graph edges. The hash key is the current node, and the value is an array of nodes that may be visited from the current node. For example, if $edges{a} = ['e','i']
, that means there are directed edges from a
to e
, and also from a
to i
.
Traversal
Traversing the graph can be done breadthfirst or depthfirst if you don’t care about the ordering (or if you sort at the end). BFS will preserve the ordering.
BFS can be done with a queue, which in Perl is any old array with push
and shift
(or pop
and unshift
, if you prefer). You shift
a string off the queue, look at the last character, and then push
all strings that can be reached from the current string. For example, if you shift
the string aei
from the array, you would then push
aeia
, aeie
, aeio
, and aeiu
, because the vowels allowed after i
are a, e, o, u
.
DFS is done with a stack, which makes it natural for recursive solutions. The operations are very similar, but the stack is implicit with recursion. The strings will be in a depthfirst order at the end, but that can be managed with sort
(or not at all, if the order is unimportant).
Alternatives
There were a few alternative solutions. Several people used modules like Algorithm::Combinatorics
to generate all variations of the five vowels, and then filter the results with regexps or other means. While these solutions end up throwing out 9599.5% of strings (it gets worse the longer the strings are), they are fast enough for small inputs.
Stats

Number of submissions: 23

Total SLOC: 1129

Average SLOC: 49
Alicia Bielsa
Alicia Bielsa’s solution uses recursion to populate a global list of vowel strings.
She stores the next vowel edges in a hash, and the result vowel strings in @aStrings
:
my %hNodes = ();
$hNodes{'a'} = ['e','i'];
$hNodes{'e'} = ['i'];
$hNodes{'i'} = ['a', 'e', 'o', 'u'];
$hNodes{'o'} = ['a','u'];
$hNodes{'u'} = ['a','e'];
my @aStrings = ();
$hNodes{'u'}
should be ['o','e']
, not ['a','e']
. When that is changed, Alicia’s output is correct.
Alicia calls the recursive addVowel
once for each vowel, to start the recursion:
foreach my $vowel ( keys(%hNodes)){
addVowel($size, $vowel,'');
}
sub addVowel {
my $currentLevel = shift;
my $currentVowel = shift;
my $currentString = shift;
$currentString .= $currentVowel;
if ($currentLevel == 1 ){
push (@aStrings , $currentString);
return 0;
} else {
$currentLevel;
}
foreach my $nextVowel (@{$hNodes{$currentVowel}}){
addVowel($currentLevel, $nextVowel,$currentString );
}
return 0;
}
This is a solid recursive implementation.
Andrezgz
Andrezgz’s solution uses a %vowels
hash to store the next vowels:
my %vowels = (
a => ['e','i'],
e => ['i'],
i => ['a', 'e','o','u'],
o => ['a','u'],
u => ['o','e']
);
Then things get interesting. Here is the main loop, which initializes a @comb
array to the starting five vowels, and then calls add_vowel
LENGTH1
times:
my @comb = keys %vowels;
@comb = add_vowel(@comb) for (2..$n);
print $_.$/ for sort @comb;
And here is the add_vowel
sub, which takes a list of strings, and returns a new list of strings:
sub add_vowel {
my @output;
for my $c (@_) {
my $v = substr $c, 1;
push @output, map { $c . $_ } @{$vowels{$v}};
}
return @output
}
The branching required for this problem happens when add_vowel
appends to @output
. For each input string, @output
gets a copy of that string concatenated with each vowel that may follow the last character in the string.
This is a nice alternative to recursion.
Athanasius
Athanasius’s solution builds up a @temp
array using a BFS that becomes the @solution
:
my @solution = qw( a e i o u ); # The solution for N = 1
for ( 2 .. $n ) {
my @temp;
for my $string (@solution) {
my $last = substr $string, 1;
push @temp, $string . $_ for $FOLLOWERS{$last}>@*;
}
@solution = @temp;
}
printf "For N = %d, the %d possible distinct vowel strings are:\n %s\n",
$n, scalar @solution, join "\n ", @solution;
CheokYin Fung
CheokYin Fung’s solution uses the Tree
distribution to create an mary trees of depth $N
, where $N
is the desired vowel string length.
With Tree
(as with most computer science trees, actually), every child node is also a Tree
, so the initialization creates a forest of trees and then adds each of those to the root $vowel
tree. This is a pattern that will be repeated in the rest of the program:
my $vowel = Tree>new( "" );
$vowel>add_child( Tree>new($_) ) for qw<a e i o u>; # [Simplified for brevity RyanT]
CheokYin then calls the following functions:
grow($vowel, 5);
traverse_and_named($vowel, $N, "");
The second argument to grow()
is apparently the depth, which is hardcoded at 5 for some reason, despite $N
being the userspecified depth. I am not sure why grow($vowel, $N)
would not suffice, but maybe there is a reason I did not notice.
Here is the recursive grow
, and the produce_child
sub it calls:
# grow : traverse and force the tree nodes produce child(ren)
sub grow {
my ($t, $d) = ($_[0], $_[1]);
produce_child($t);
my @t_baby = $t>children;
foreach (@t_baby) {
grow($_, $d) if $_>depth < $d;
}
}
sub produce_child {
my $t = $_[0];
if ($t>size == 1) { switch($t>value) {
case ("a") {$t>add_child(Tree>new("e")); $t>add_child(Tree>new("i"));}
case ("e") {$t>add_child(Tree>new("i"));}
case ("i") {$t>add_child(Tree>new("a")); $t>add_child(Tree>new("e"));
$t>add_child(Tree>new("o")); $t>add_child(Tree>new("u"));}
case ("o") {$t>add_child(Tree>new("a")); $t>add_child(Tree>new("u"));}
case ("u") {$t>add_child(Tree>new("e")); $t>add_child(Tree>new("o"));}
}
}
}
Finally, the traverse_and_named
function traverses the tree and prints all the nodes at the specified depth:
sub traverse_and_named {
my ($t, $d, $str) = ($_[0], $_[1], $_[2]);
print $str."\n" if length($str)==$d;
my @t_baby = $t>children;
foreach (@t_baby) {
traverse_and_named($_, $d, $str.$_>value) if $_>depth<=$d;
}
}
Blog › Tree as a tool for enumeration  CY’s take on PWC#053 Task 2
Colin Crain
Colin Crain’s solution also uses a BFS queue:
my @output = qw( a e i o u );
my %following = ( a => [ qw( e i ) ],
e => [ qw( i ) ],
i => [ qw( a e o u ) ],
o => [ qw( a u ) ],
u => [ qw( o e ) ] );
my $count = 1;
while ($count < $length) {
my $num_clusters = scalar @output; ## memoize this now because we will add elements
for (1..$num_clusters) {
my $vowel_cluster = shift @output; ## shift off a cluster
my $vowel = substr $vowel_cluster, 1, 1; ## get the last letter
for ($following{$vowel}>@*) { ## build new combinations from that letter
push @output, "$vowel_cluster" . "$_"; ## and add them to the end of the list
}
}
$count++; ## keep track of the cluster length
}
say $_ for @output;
Dave Cross
Dave Cross’s solution sets up the %strings
map, initializes @words
with the five starting nodes, and then calls his add_letter
function on @words
$count1
times to get “words” of the correct length:
my $count = get_arg();
my %strings = (
a => [qw[e i]],
e => [qw[i]],
i => [qw[a e o u]],
o => [qw[a u]],
u => [qw[o e]],
);
my @words = map { [ $_ ] } keys %strings;
@words = add_letter(@words) for 2 .. $count;
say @$_ for sort { "@$a" cmp "@$b" } @words;
Here is the add_letter
function that appends the new word(s) based on the last vowel:
sub add_letter {
my @input = @_;
my @output;
for my $in (@input) {
push @output, map { [ @$in, $_ ] } @{ $strings{ $in>[1] } };
}
return @output;
}
Dave Jacoby
Dave Jacoby’s solution lets his vowel_strings
function do all of the heavy lifting:
my @strings = vowel_strings($l);
say join "\n", @strings;
sub vowel_strings ( $l, $string = '' ) {
if ( length $string == $l ) {
return $string;
}
my @next;
my $m = length $string == 0 ? '' : substr $string, 1;
if ( $string eq '' ) {
@next = qw{ a e i o u};
}
elsif ( $m eq 'a' ) {
@next = qw{ e i };
}
elsif ( $m eq 'e' ) {
@next = qw{ i };
}
elsif ( $m eq 'i' ) {
@next = qw{ a o u e };
}
elsif ( $m eq 'o' ) {
@next = qw{ a u };
}
elsif ( $m eq 'u' ) {
@next = qw{ o e };
}
my @output;
for my $n (@next) {
push @output, vowel_strings( $l, $string . $n );
}
return @output;
}
This is a great recursive DFS implementation. Stylsitically, I might consider using a dispatch table or turnstyle operator to eliminate the if .. elsif .. else
, but that’s just me. Computationally, I wouldn’t change a thing!
Blog › Rotate Your Matrix and String Your Vowels
Duncan C. White
Duncan C. White’s solution is also recursive, but uses regexps instead of substr
or arrays, to find the last character in each string:
use Function::Parameters;
die "vowelstrings N\n" unless @ARGV == 1;
my $n = shift;
die "vowelstrings: N ($n) should be 1..5\n" unless $n >= 1 && $n <= 5;
my @vow = qw(a e i o u);
#
# generate( $prefix, $moresteps );
# Generate and print all vowel strings starting with $prefix,
# and taking $moresteps more generative steps, applying
# the above rules at each step to extend the prefix.
#
fun generate( $prefix, $moresteps ) {
if ( $moresteps == 0 ) {
say $prefix;
return;
}
# 'a' can only be followed by 'e' or 'i'.
if ( $prefix =~ /a$/ ) {
generate( $prefix . 'e', $moresteps  1 );
generate( $prefix . 'i', $moresteps  1 );
}
# 'e' can only be followed by 'i'.
elsif ( $prefix =~ /e$/ ) {
generate( $prefix . 'i', $moresteps  1 );
}
# 'i' can only be followed by 'a', 'e', 'o', or 'u'.
elsif ( $prefix =~ /i$/ ) {
foreach my $vowel (@vow) {
next if $vowel eq 'i';
generate( $prefix . $vowel, $moresteps  1 );
}
}
# 'o' can only be followed by 'a' or 'u'.
elsif ( $prefix =~ /o$/ ) {
generate( $prefix . 'a', $moresteps  1 );
generate( $prefix . 'u', $moresteps  1 );
}
# 'u' can only be followed by 'o' or 'e'.
elsif ( $prefix =~ /u$/ ) {
generate( $prefix . 'o', $moresteps  1 );
generate( $prefix . 'e', $moresteps  1 );
}
}
foreach my $firstvowel (@vow) {
generate( $firstvowel, $n  1 );
}
Again, a lot of this duplicated code could be eliminated with a dispatch table, but apart from that, I love it.
E. Choroba
E. Choroba’s solution ought to look familiar by now (BFS queue):
my %next = (
a => [qw[ e i ]],
e => [qw[ i ]],
i => [qw[ a e o u ]],
o => [qw[ a u ]],
u => [qw[ o e ]]);
my $n = shift;
die "Invalid argument" unless ($n // "") =~ /^[15]$/;
my @agenda = sort keys %next;
while ($n > length $agenda[0]) {
my @next;
for my $string (@agenda) {
my $last = substr $string, 1;
push @next, map $string . $_, @{ $next{$last} };
}
@agenda = @next;
}
say for @agenda;
Blog › Rotate Matrix and Vowel Strings
Jaldhar H. Vyas
Jaldhar H. Vyas’s solution is another good example of a BFS queue:
sub generate {
my ($n) = @_;
my %rules = (
a => [qw/ e i /],
e => [qw/ i /],
i => [qw/ a e o u /],
o => [qw/ a u /],
u => [qw/ e o /]
);
my @generated;
for my $i (1 .. $n) {
if ($i == 1) {
@generated = sort keys %rules;
} else {
@generated = map {
my $e = $_;
map { $e . $_; } @{ $rules{substr $e, 1, 1} };
} @generated;
}
}
return @generated;
}
Blog › Jaldhar’s Week #053 Blog
Javier Luque
Javier Luque’s solution uses Algorithm::Combinatorics
’ variations_with_repetition
function. v_w_r(\@data, $k)
returns an iterator that will generate all tuples of length $k
from @data
. Thus:
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));
}
Javier generates all tuples of $size
length of @vowels
. Many of these will be invalid, but his valid_combination
checks each one in turn to see if it follows the rules of the task:
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;
}
The helper _check_letters
is called five times per candidate word, once for each vowel, with a list of the allowed vowels that may follow.
# 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;
}
This is a unique solution. Despite the extra looping checking more than 95% invalid solutions at N=5 (99.4% at size 7), it performs better than I would have expected. N=7 takes around 0.7 seconds, vs 0.012 seconds for an iterative BFS solution.
Blog › Perl Weekly Challenge
Laurent Rosenfeld
Laurent Rosenfeld’s solution is another recursive DFS example:
my %successors = (
a => ['e', 'i'],
e => ['i'],
i => [qw /a e o u/],
o => ['a', 'u'],
u => ['e', 'o']
);
my @vowels = sort keys %successors;
my $error_msg = "Please pass a parameter between 1 and 5.";
my $str_size = shift or die $error_msg;
die $error_msg unless $str_size =~ /^[15]$/;
for my $start (@vowels) {
make_str($str_size 1, $start, $start);
}
sub make_str {
my ($left, $last, $string) = @_;
say $string and return unless $left; # Stop the recursion
for my $next (@{$successors{$last}}) {
my $new_str = $string . $next;
make_str($left 1, $next, $new_str);
}
}
Blog › Rotate Matrix and Vowel Strings
Lubos Kolouch
Lubos Kolouch’s solution uses List::Permute::Limit
to generate initial permutations of vowels in his get_permutations
sub:
sub get_permutations {
my $count = shift;
my @wovels = [ 'a', 'e', 'i', 'o', 'u' ];
my @result;
my $iter = permute_iter(items=>@wovels, nitems=>$count);
while (my $ary = $iter>()) {
say @$ary if check_perm($ary);
}
}
get_permutations(2);
Those permutations are then checked against the task’s rules in check_perm
:
my @ok_rules = ( 'ae', 'ai', 'ei', 'ia', 'ie', 'io', 'iu', 'oa', 'ou', 'uo', 'ue' );
my %ok_hash = map { $_ => 1} @ok_rules;
sub check_perm {
my $perm = shift;
my @perm_arr = @$perm;
for ( 0 .. scalar @perm_arr  2 ) {
return 0 unless $ok_hash{$perm_arr[$_] . $perm_arr[ $_ + 1 ]};
}
return 1;
}
Markus Holzer
Markus Holzer’s solution revolves around the recursive build_str
, called initially with the keys of %rules
:
my %rules = (
a => [ 'e', 'i' ],
e => [ 'i' ],
i => [ 'a', 'e', 'o', 'u' ],
o => [ 'a', 'u' ],
u => [ 'e', 'o' ],
);
main( shift @ARGV  2 );
sub main( $n ) {
my @r;
build_str( $_, $n, \@r ) for ( sort keys %rules );
print join "\n", @r;
}
sub build_str ( $current, $n, $result ) {
my $last = substr( $current, 1 );
for ( $rules{$last}>@* ) {
given ( $current . $_ ) {
push $result>@*, $_ and next
if length($_) == $n;
build_str( $_, $n, $result );
}
}
}
Mohammad S Anwar
Mohammad S Anwar’s solution uses Algorithm::Combinatorics
to get an iterator that generates $char_sets
of the given $count
length:
use Algorithm::Combinatorics qw(combinations);
my $chars = [qw(a e i o u)];
my $iter = combinations($chars, $count);
my $char_sets = [];
while (my $char = $iter>next) {
push @$char_sets, join "", @$char;
}
There is a problem with this logic. Using combinations
means you are selecting elements without repetition. So, for $count = 5
, there is only one possible combination: a e i o u
. The results will be incorrect for every count. variations_with_repetition
will return all sequences of five vowels, with repetition:
# RyanT
my $char_sets = [ map { join '', @$_ } variations_with_repetition($chars, $count) ];
Once the list of @$char_sets
has been generated, Mohammad then checks each one against the following list of $rules
regexps:
my $rules = [
qr/a(?=[ie])/,
qr/e(?=[i])/,
qr/i(?=[aeou])/,
qr/o(?=[au])/,
qr/u(?=[oe])/
];
foreach my $char_set (@$char_sets) {
my $pass = 0;
foreach my $rule (@$rules) {
if ($char_set =~ /$rule/) {
$pass = 1;
}
}
print "$char_set\n" if ($pass);
}
Unfortunately, these rules are too permissive, producing invalid words like uuuo
. Notice the loop logic: $char_set
passes if it matches any of the regexps in @$rules
. Each regexp uses a zerowidth positive lookahead, but that doesn’t matter, as each regexp is applied on its own. The problem is that these rules match valid sequences. There is nothing here to notice an invalid sequence, like uu
.
To fix the logic with regexps, you have two basic options: match the entire string, or match invalid segments; i.e., an a
must be followed by an i
or e
, so if it is followed by any other character, the string is invalid. The latter choice is probably easier to do.
Blog › BLOG: The Weekly Challenge #053
Pete Houston
Pete Houston’s solution is a concise recursive implementation:
my %rules = (
a => [qw/e i/],
e => [qw/i/],
i => [qw/a e o u/],
o => [qw/a u/],
u => [qw/o e/]
);
my $n = int shift @ARGV;
die "1 <= N <= 5 is the restriction.\n" unless $n > 0 && $n < 6;
next_str ($_) for keys %rules;
sub next_str {
my $string = shift;
return say $string if length $string == $n;
for my $c (@{$rules{substr ($string, 1, 1)}}) {
next_str ("$string$c");
}
}
Roger Bell West
Roger Bell West’s solution uses a BFS queue, and is decently concise as well:
my %tree = (
'' => [qw(a e i o u)],
a => [qw(e i)],
e => [qw(i)],
i => [qw(a e o u)],
o => [qw(a u)],
u => [qw(o e)],
);
print map { "$_\n" } generate( 2, \%tree );
sub generate {
my ( $len, $tree ) = @_;
my @list = ('');
while (1) {
if ( length( $list[0] ) == $len ) {
last;
}
my $r = shift @list;
my $s = substr( $r, 1, 1 )  '';
foreach my $extension ( @{ $tree{$s} } ) {
push @list, $r . $extension;
}
}
return @list;
}
Ruben Westerberg
Ruben Westerberg’s solution has me torn. Ruben supplies his own beautiful combinations
sub:
sub combinations {
my @combinations=();
my ($data,$size)=@_;
my @indexes=(0) x ($size+1);;
my $i=0;
until ($indexes[$size]) {
my $count=List::Util::uniq(@indexes[0..$size1]);
#print $count,"\n";;
push @combinations, [@$data[@indexes[0..$size1]]] if $count == $size;
$indexes[0]++;
for (0..$size1) {
if ($indexes[$_] != 0 and 0 == ($indexes[$_] % @$data)) {
$indexes[$_]=0;
$indexes[$_+1]++;
}
}
}
@combinations;
}
This combinations
sub actually returns permutations, not combinations. Unfortunately, we don’t want permutations or combinations, but something like Algorithm::Combinatorics
's variations_with_repetition
, which produces correct results when paired with Ruben’s loop, below. As written, the combinations
sub only produces different orderings of the 5 vowels; it will never repeat them, but it needs to. This is fixable.
Here is Ruben’s main loop, which calls combinations
and checks the results with regexps:
say for sort map {join "",@$_} grep {
my $sum=0;
my $s=join '', @$_;
given ($s) {
my @match; #<<Used to force list context
$sum+=@match=/a/g; #<<Count all a
$sum=@match=(/a[ie]a$/g); #<<make sure the rules match
#<<Net sum is 0 for success
$sum+=@match=/e/g;
$sum= @match=(/eie$/g);
$sum+=@match=/i/g;
$sum= @match=/i[aeou]i$/g;
$sum+=@match=/o/g;
$sum=@match=/o[au]o$/g;
$sum+=@match=/u/g;
$sum=@match=/u[oe]u$/g;
}
$sum==0;
} combinations(\@vowels,$n);
The @match
array is used here “to force list context”. You can do the same thing without the named array using =()=
. For example:
$sum+=()=a/g;
Ryan Thompson
My solution has two variations, but first the %edges
we’ll use for both:
# Follow rules. Basically graph edges.
my %edges = ( a => ['i','e'], e => ['i'], i => ['u','o','e','a'],
o => ['u','a'], u => ['e','o'] );
The first example is a BFS queue implementation:
sub vowel_string {
my ($len) = @_;
my @queue = sort keys %edges; # Preload queue
my @vstrs;
while (my $str = shift @queue) {
push @vstrs, $str and edges if $len <= length $str;
push @queue, $str.$_ for @{$edges{ substr $str, 1 }}
}
@vstrs;
}
say for vowel_string(6);
For the second variation, I made an iterator version, which returns a code ref that can be called repeatedly to get the next element in the sequence:
sub vowel_iter {
my ($len) = @_;
my @queue = sort keys %edges;
sub {
while (my $str = shift @queue) {
return $str if $len <= length $str;
push @queue, $str.$_ for @{$edges{ substr $str, 1 }}
}
}
}
my $it = vowel_iter(3);
say while $_ = $it>();
Both versions have their merits, depending on the application, which is why I included them both.
Blog › PWC 053 › Vowel Strings
Saif Ahmed
Saif Ahmed’s solution uses a BFS queue as well:
sub vowelStrings {
my $target = shift;
my %following = ( # hash containing lists of valid following vowels
a => [ 'e', 'i' ],
e => ['i'],
i => [ 'a', 'e', 'o', 'u' ],
o => [ 'a', 'u' ],
u => [ 'o', 'e' ],
);
my @list = (qw{a e i o u }); # start with list of vowels
while ( length $list[0] < $target ) {
my $str = shift @list;
push @list, map { $str . $_ } @{ $following{ substr( $str, 1, 1 ) } };
}
return @list,;
}
User Person
User Person’s solution does something a little different, with Math::Int2Base
(converts to/from arbitrary bases):
use Math::Int2Base qw( int2base base2int );
my @vowels = qw{ a e i o u };
my $MAX = '4' x $num;
my $j = 0;
for (my $i = 0; $j <= $MAX; ++$i) {
$j = int2base($i,5);
$j = sprintf "%0${num}d", $j;
my $string;
foreach (split(//,$j)){
$string .= $vowels[$_];
}
In the Cstyle for
loop, the loop variable ($i
) is converted to base5, as there are five vowels. This allows direct indexing within @vowels
. All of this is an easy way to emulate the variations_with_repetition
function we’ve seen previously.
To see whether $string
is a valid vowel string, it is checked against five different regexps in turn:
if ( $string =~ m{a[^ei]}
or $string =~ m{e[^i]}
or $string =~ m{i[^aeou]}
or $string =~ m{o[^au]}
or $string =~ m{u[^oe]} )
{
next;
} else {
print "$string\n";
}
}
If any of these regexps match, the string is rejected. For example, a[^ei]
means that if a string contains an a
followed by anything other than an e
or an i
, it is rejected.
Wanderdoc
Wanderdoc’s solution uses Algorithm::Combinatorics
again, this time using variations
.
use Algorithm::Combinatorics qw(variations);
use Getopt::Std;
my @vowels = qw(a e i o u);
my @pos_patterns = ( qr/a[ei]/ , qr/ei/ , qr/i[aeou]/,
qr/o[au]/, qr/u[oe]/ );
my @neg_patterns = ( qr/a(?=[aou])/ , qr/e(?=[aeou])/ , qr/i(?=i)/,
qr/o(?=[eio])/, qr/u(?=[aiu])/ );
my $iter = variations(\@vowels, $options{n});
my %already_found;
Unfortunately, variations
does not include repetitions, and we need repetitions to generate valid strings such as ueiu
, so Wanderdoc’s program does not generate all valid solutions. The fix is easy, though: just use variations_with_repetition
instead.
Here is the loop, which uses the iterator semantics from Algorithm::Combinatorics
:
VAR: while ( my $c = $iter>next ) {
my $str = join( '', @$c );
for my $pp (@pos_patterns) {
if ( $str =~ /$pp/ ) {
for my $np (@neg_patterns) {
next VAR if $str =~ /$np/;
}
# A string with length > 2 can match > 1 patterns.
$already_found{$str}++;
print $str, $/ if 1 == $already_found{$str};
}
}
}
Note the use of positive and negative patterns (@pos_patterns
and @neg_patterns
) to reject invalid strings.
Yet Ebreo
Yet Ebreo’s solution is a oneliner based around regexes and glob
:
!(/a[^ei]/  /e[^i]/  /i[^aeou]/  /o[^au]/  /u[^oe]/) && say for glob "{a,e,i,o,u}" x ($ARGV[0]1);
The use of glob
here is fantastic.
See Also
Blogs this week:
CheokYin Fung › Tree as a tool for enumeration  Rotation in R^2
Dave Jacoby › Rotate Your Matrix and String Your Vowels
E. Choroba › Perl Weekly Challenge 053: Rotate Matrix and Vowel Strings
Jaldhar H. Vyas › Jaldhar’s Week #053 Blog
Javier Luque › 053 – Perl Weekly Challenge
Laurent Rosenfeld › Rotate Matrix and Vowel Strings
Mohammad S Anwar › BLOG: The Weekly Challenge #053
Ryan Thompson › Matrix Rotation  Vowel Strings