The Email Queen with Raku
[75] Published 1. June 2020.This is my response to the Perl Weekly Challenge #062.
Challenge #062.1: Sort Email Addresses
Note that the domain is case-insensitive, while the mailbox part is case sensitive. (Some email providers choose to ignore case, but that’s another matter entirely.)
If your script is invoked with arguments, it should treat them as file names and read them in order, otherwise your script should read email addresses from standard input.
Bonus
Add a
-u option which only includes unique email addresses in the output,
just like sort -u.
Example
If given the following list:
name@example.org
rjt@cpan.org
Name@example.org
rjt@CPAN.org
user@alpha.example.org
-u) would return:
user@alpha.example.org
rjt@cpan.org
rjt@CPAN.org
Name@example.org
name@example.org
-u, the script would return:
user@alpha.example.org
rjt@CPAN.org
Name@example.org
name@example.org
The easiest part is the file with the email addresses:
File: input-list.txt
name@example.org
rjt@cpan.org
Name@example.org
rjt@CPAN.org
user@alpha.example.org
If we ignore the -u flag, we can get away with a pretty simple program:
my @input = $*ARGFILES.lines; # [1]
my %sort; # [5]
for @input -> $current # [2]
{
my ($mailbox, $domain) = $current.split('@'); # [3]
%sort{$current} = "{ $domain.lc } $mailbox"; # [4]
}
.say for @input.sort({ %sort{$^a} cmp %sort{$^b} }); # [5]
[1] $*ARGFILES give us the content of
any files specified on the command line, and on STDIN otherwise. Slapping on
lines gives us the content, one line at a time.
[2] Iterate over the addresses.
[3] Split the address, giving the mailbox (the part before the «@») and the domain (the part after the «@»).
[4] Store a version of the address suitable for sorting.
[5] Print the addresses, sorted by the strings in [5] (instead of the addresses themselves).
See
docs.raku.org/type/IO::ArgFiles and
docs.raku.org/language/variables#index-entry-$*ARGFILES
for more information about $*ARGFILES.
Running it:
$ raku sea-simple input-list.txt
user@alpha.example.org
rjt@cpan.org
rjt@CPAN.org
Name@example.org
name@example.org
$ cat input-list.txt | raku sea-simple
user@alpha.example.org
rjt@cpan.org
rjt@CPAN.org
Name@example.org
name@example.org
Looking good. Except for the missing -u support.
A sub MAIN wrapper is the best way of catching arguments, as in:
unit sub MAIN (@*dummy , :$verbose, :$u);
Wrapping the program in a sub MAIN
has the unfortunate effect of disabling the ARGFILE behaviour as seen in the first program.
That is probably a good idea, as «--u» (and «--verbose»; as I have added my beloved
verbose mode as well) should not be treated as filenames.
One can argue that ARGFILE is way too magical, and do it manually. With explicitly reading from the files or STDIN depending on the input:
File: sea
unit sub MAIN (*@files, :$verbose, :$u); # [1]
say ": Files: @files[]" if $verbose;
my @input = @files.elems # [2]
?? IO::CatHandle.new(@files).lines # [2a]
!! $*IN.lines; # [2b]
say ": Content: @input[]" if $verbose;
my %sort;
my %seen; # [3]
my @output; # [4]
for @input -> $current
{
my ($mailbox, $domain) = $current.split('@');
say ": Candidate: $mailbox @ { $domain.lc }" if $verbose;
if $u # [3]
{
my $candidate = $mailbox ~ '@' ~ $domain.lc;
next if %seen{$candidate}; # [3a]
%seen{$candidate} = True;
}
%sort{$current} = "{ $domain.lc } $mailbox";
@output.push: $current;
}
.say for @output.sort({ %sort{$^a} cmp %sort{$^b} });
[1] Using a Slurpy argument to gobble up all the postional arguments as file names. This allows zero values, so the program works even if no files are given.
[2] Do we have any files on the command line? If yes, use
IO::CatHandle to read them [2a]. If not, read from STDIN ($*IN)
[2b].
[3] Chech for duplicates, if «-u» has been specified. The next statement in
[3a] takes care of skipping duplicates.
[4] Sort and print the modified list (possibly without duplicates).
See
docs.raku.org/type/IO::CatHandle
for more information about IO::CatHandle.
We can actually simplify the program, by using lines (which reads from STDIN
if no file is specified) instead of $*IN.lines.
# !! $*IN.lines;
!! lines;
Running it without -u gives the same result as before:
$ raku sea input-list.txt
user@alpha.example.org
rjt@cpan.org
rjt@CPAN.org
Name@example.org
name@example.org
$ cat input-list.txt | raku sea
user@alpha.example.org
rjt@cpan.org
rjt@CPAN.org
Name@example.org
name@example.org
Running it with -u gives the expected result as well:
$ raku sea -u input-list.txt
user@alpha.example.org
rjt@cpan.org
Name@example.org
name@example.org
$ cat input-list.txt | raku sea -u
user@alpha.example.org
rjt@cpan.org
Name@example.org
name@example.org
Challenge #062.2: N Queens
It is possible to place 8 queens on to a single chessboard such that none of the queens can attack each other (i.e., their shaded squares would not overlap). In fact, there are multiple ways to do so, and this is a favourite undergraduate assignment in computer science.
But here at PWC, we’re going to take it into the next dimension!
Your job is to write a script to work with a three dimensional chess cube, M×M×M in size, and find a solution that maximizes the number of queens that can be placed in that cube without attacking each other. Output one possible solution.
Example
A trivial 2×2×2 solution might look like this (1 = queen, 0 = empty):
[
[[1,0], # Layer 1
[0,0]],
[[0,0], # Layer 2
[0,0]],
]
The «trivial solution» actually contains important information. Here it is, with the cells numbered for easy reference. The first digit is the layer, the second the column (up/down; ↕), and the third the row (left/right; ↔):
It is obvious that the Queen (in position «111») can move to «112», «121» and «122» (all in the same layer). It is nearly as obvious (by rotating the cube) that she can move to «211», «212» and «221».
The absence of a second Queen at position «222» (in the challenge) must imply that the Queen can move diagonally between the layers. i.e. from «111» to «222» as well.
A 2x2x2 cube can thus accomodate exactly one Queen, regardless of the actual position. (Rotating the cube actually makes all the positions equal.)
A 3x3x3 Cube
A 3x3x3 cube has only 6 unique locations for a single Queen. All the others can be gotten by rotating the cube.1: A Queen in the exact middle of the cube can reach all the positions:
(We were asked to «maximizes the number of queens», so this position is no good then.)
2: Moving the Queen to the first layer reduces the reach:
Note that placing the Queen in the third layer is identical to the first layer, as we can shuffle the layers (or rotate the cube) to get the same placement.
3: Placing the Queen in a corner on the second layer:
4: Moving her to the first layer doesn't change the reach:
5: Placing the Queen in a side in the second layer increases the reach:
6: Moving her to the first layer reduces the reach again:
That was fun, but time consuming. And we are no nearer the goal of placing as many Queens as possible in the cube.
So let us start programming...
I'll end up with one single program for this challenge, controlled by a large number of command line options.
Let us start with doing the same as what I did manually above, place a Queen at the given position and print the entire cube. I have chosen an upper case letter «Q» for the Queen, the corresponding lower case «q» for all the positions she can reach, and a period («.») for the rest (the unreachable parts).
I'll show the result of running it first:
$ raku queen-cube-1 --queen="1;1;1" 2
Q q q q
q q q q
$ raku queen-cube-1 --queen="1;1;1" 3
Q q q q q . q . q
q q . q q . . . .
q . q . . . q . q
$ raku queen-cube-1 --queen="2;2;2" 3
q q q q q q q q q
q q q q Q q q q q
q q q q q q q q q
The position is specified as a semicolon separated string as shown. I have chosen to use the same coordinates as in the illustration I made, with 1 as the lowest index. That means that the arrays have an undefined value at the position with index 0. That is not a problem, as long as we don't try to access that value. The size of the cube is given as a plain number at the end, with 8 as the default value.
If you don't like the period, specify another character with the «--empty» parameter:
$ raku queen-cube-1 --queen="1;1;1" --empty="*" 4
Q q q q q q * * q * q * q * * q
q q * * q q * * * * * * * * * *
q * q * * * * * q * q * * * * *
q * * q * * * * * * * * q * * q
The Queen identifier can be changed as well, with the «--id» parameter:
$ raku queen-cube-1 --queen="1;2;3" --empty="*" --id="A" 4
* a a a * a a a * * * * * * * *
a a A a * a a a a * a * * * a *
* a a a * a a a * * * * * * * *
a * a * * * * * a * a * * * * *
The idea was to make it easier to identify the different Queens when we start adding more of them, but this turned out to be a not-so-good idea in practice as a 8x8x8 cube can support more than the 26 Queens the letters A-Z can give us. (So I':ll stick to the «Q» from now on.)
If you miss the colour from the illustrations, ask for them with the «--colour» parameter:
$ raku queen-cube-1 --queen="1;2;3" --colour 4
. q q q . q q q . . . . . . . .
q q Q q . q q q q . q . . . q .
. q q q . q q q . . . . . . . .
q . q . . . . . q . q . . . . .
This uses ANSI Control Sequences to print in colour on the terminal. See my Raku Gather, I Take article for more information.
It is a big hassle to convert the output to html, so use the «--colour=html» parameter instead if you intend to copy the output to a web page (as I have done here).
Then the program:
File: queen-cube-1
use lib "lib"; # [1]
use QueenCube; # [1]
unit sub MAIN
(
$size = 8,
:$id = 'Q',
:$empty =".",
:$queen,
:$colour
);
get-one-solution;
sub get-one-solution
{
my $c = QueenCube.new(size => $size); # [2]
$c.init($empty); # [3]
$c.queen($id, $queen) if $queen; # [4]
$c.display($colour); # [5]
}
[1] I have chosen to put the core code in a module «QueenCube», located in the «lib» directory. See below for thew code.
[2] Generate a new cube with the given size (one variable, used for all three dinmensions).
[3] Fill all the cells with the empty character, as we want something nice to print. (Note that we could have skipped this, and instead done the nice character swapping on printing the cube.)
[4] Place the queen at the given position, and mark the cells she can reach (from that position).
[5] Print the cube.
File: lib/QueenCube.rakumod (partial)
constant ansi-blue = "\e[44m"; # [6]
constant ansi-green = "\e[42m"; # [6]
constant ansi-red = "\e[101m"; # [6]
constant ansi-stop = "\e[0m "; # [6a]
constant html-blue = '<span class="text-light bg-primary">'; # [7]
constant html-green = '<span class="text-light bg-success">'; # [7]
constant html-red = '<span class="text-light bg-danger">'; # [7]
constant html-stop = '</span> '; # [7a]
unit class QueenCube; # [8]
has Int $.size; # [8a]
has @.elems is rw; # [8b]
has $.blank is rw; # [8c]
[6] The ANSI sequences to turn in background colours in the terminal, and off [6a].
[7] And the corresponding Bootstrap HTML Colour markup.
[8] The class, with three attributes; the size (dimension) [8a], the array with all the cells [8b] and the empty character.
File: lib/QueenCube.rakumod (partial)
method init ($init) # [9]
{
self.blank = $init; # [10]
for 1 .. $!size -> $x # [11]
{
for 1 .. $!size -> $y # [11a]
{
for 1 .. $!size -> $z # [11b]
{
@.elems[$x; $y; $z] = $init; # [12]
}
}
}
}
[9] The metod for filling in the blanks (so to speak).
[10] We must set the size manually (as the default constructor handles named arguments only, and I have none of them), and this is a suitable location.
[11] Iterate over all the cells. Note that we start from 1 (and not 0), as explained earlier.
[12] Set the cell.
File: lib/QueenCube.rakumod (partial)
multi method queen ($id, $x, $y, $z) # [13]
{
die "Blacked out position $x, $y, $z "
if @.elems[$x; $y; $z] ne self.blank; # [14]
@.elems[$x; $y; $z] = $id; # [15]
my $min = 1; # [16]
my $max = self.size; # [17]
my $blackout = $id.lc; # [18]
for -1, 0, 1 -> $xx # [19]
{
for -1, 0, 1 -> $yy # [19a]
{
for -1, 0, 1 -> $zz # [19b]
{
next if $xx == $yy == $zz == 0; # [20]
for (1 .. $max) -> $h # [21]
{
my $xxx = $x + $xx * $h; # [22]
my $yyy = $y + $yy * $h;
my $zzz = $z + $zz * $h;
next if any($xxx, $yyy, $zzz) < $min; # [23]
next if any($xxx, $yyy, $zzz) > $max; # [23a]
@.elems[ $xxx; $yyy; $zzz] = $blackout; # [24]
}
}
}
}
}
[13] The metod for placing a Queen at a specified location.
[14] Terminate the program if the cell is occupied. That is ok when we place them manually, as that is indeed an unrecoverable error. When we (later on) get round to placing them automatically, the program will ensure that the cell is empty before calling this method.
[15] Put the Queen in the cell.
[16] We are now going to mark all the cells that the Queen can reach. This variable is the lower limit for the indices.
[17] And this is the upper limit.
[18] The character we use is the lower case version of the Queen letter.
[19] All the one-step-away positions can be computed by iterating over the three directions (-1, 0 and 1 step).
[20] The Queen we just placed is here. Skip the cell.
[21] Multiplier in a loop, as the Queen can go 1, 2, and so on cells away.
[22] Get the new «X» position to mark as reachable.
[23] Skip the cell if any of the coordinates are out of bounds.
[24] Mark the cell as reachable.
File: lib/QueenCube.rakumod (partial)
multi method queen ($id, $xyz) # [25]
{
my ($x, $y, $z) = $xyz.split(";"); # [25a]
die "Queen position out of range (1 .. { self.size })"
if any($x, $y, $z) < 1; # [26]
die "Queen position out of range (1 .. { self.size })"
if any($x, $y, $z) > self.size; # [26]
self.queen($id, $x, $y, $z); # [27]
}
[25] Another version of this method. This one, where we specify the position
as a single string (e.g 1;1;1) is used to place Queens as specified
on the command line.
[26] This method has out of bounds checks to take care of potential user errors.
[27] Let the other version of the method do the actual work.
File: lib/QueenCube.rakumod (partial)
method display ($colour, $layer-from = 1, $layer-to = self.size) # [28]
{
for 1 .. self.size -> $y
{
for $layer-from .. $layer-to -> $x # [29]
{
for 1 .. self.size -> $z
{
if $colour && $colour eq "html" # [30]
{
given @.elems[$x; $y; $z] # [31]
{
when self.blank { print html-red ~ $_ ~ html-stop; } # [31a]
when /<[A..Z]>/ { print html-blue ~ $_ ~ html-stop; } # [31b]
when /<[a..z]>/ { print html-green ~ $_ ~ html-stop; } # [31c]
}
}
elsif $colour # [32]
{
given @.elems[$x; $y; $z] # [33]
{
when self.blank { print ansi-red ~ $_ ~ ansi-stop; } # [33a]
when /<[A..Z]>/ { print ansi-blue ~ $_ ~ ansi-stop; } # [33b]
when /<[a..z]>/ { print ansi-green ~ $_ ~ ansi-stop; } # [33c]
}
}
else # [34]
{
print @.elems[$x; $y; $z], " "; # [34a]
}
}
print " "; # [35]
}
say "": # [36]
}
}
[28] The metod for displaying the cube, one layer after each other. It is possible to specify the start and end layers, which is useful when we want to break the output into several lines (as we do in the next method, see the next code block).
[29] The three for-loops should be familiar by now. Note that we this time
only do (= iterate over) the layers we are requested to.
[30] If we have requested HTML colours,
[31] • use those (blue for the Queen, red for vacant, and green for cells reachable by a Queen).
[32] ANSI colours,
[33] • you get the idea.
[34] No colours.
[35] Spacing between the layers (and after the last one, but you'll probably not notice this bout of sloppy programming).
[36] Add a newline after each physical row.
File: lib/QueenCube.rakumod (partial)
method display-with-newlines($colour, $break-after) # [37]
{
my $size = self.size;
my $start = 1;
my $stop = min($size, $break-after); # [38]
loop # [39]
{
self.display($colour, $start, $stop); # [40]
$start += $break-after; # [41]
$stop += $break-after; # [41]
last if $start > $size; # [42]
$stop = min($stop, $size); # [43]
print "\n\n"; # [44]
}
}
[37] We use this wrapper method if we want the output on separate lines. The parameter is the number of layers to print on each row
[38] Stop at the specified end (or the actual end, if that is lower).
[39] An eternal loop (with an exit strategy in [42].
[40] Show the specified number of layers.
[41] Move the start and stop to the next set.
[42] Exit if we have reached the end (and have already printed everything).
[43] Adjust the end, if it has passed the actual end.
[44] Print a couple of newlines before the next batch of layers.
One single Queen isn't much fun. We should be able to specify as many as we want, as a space separated list:
$ raku queen-cube-2 --queen="0;0;0 0;1;2" --colour 4
Q q q q q q q q q . q . q . . q
q q Q q q q q q q . q . . . q .
q q q q . q q q q . q . . . . .
q . q q . . . . q . q . q . . q
Number of Queens: 2
Note the last line showing the number of Queens. It is only shown if the number is greater than 1.
File: queen-cube-2 (with the changes highlighted)
use lib "lib";
use QueenCube;
unit sub MAIN
(
$size = 8,
:$id = 'Q',
:$empty =".",
:$queen,
:$colour
);
get-one-solution;
sub get-one-solution
{
my $c = QueenCube.new(size => $size);
$c.init($empty);
# $c.queen($id, $queen) if $queen;
if $queen # [1]
{
$c.queen($id, $_) for $queen.words; # [1a]
}
$c.display($colour);
my $count = $c.number-of-queens; # [2]
say "Number of Queens: ", $count if $count > 1; # [2]
}
[1] If we have specified a Queen position, iterate over them (if we are given a list). The code does one call if used without a list.
[2] Get the numer of Queens in the cube and print it.
File: lib/QueenCube.rakumod (partial)
method number-of-queens
{
return @!elems[*;*;*].grep({ $_.defined }).grep( * ~~ /<[A..Z]>/ ).elems;
# [3] ######## # [4] ############## # [5] ################# # [6]
}
[3] The * instead of a normal index gives all the values. We get a list
of all the cell values as a single list as result.
[4] The problem is the value at index 0, which we will get even if they have undefined
values. This grep call fixes that.
[5] This one gets the cells with an upepr case letter, which means a Queen.
[6] Count them (the elements, and the Queens).
But you will get an error message if you try to place a Queen in a non-empty (no Queen, and not reachable by a Queen) cell:
$ raku queen-cube-2 --queen="1;1;1 1;2;2" 4
Blacked out position 1, 2, 2
8 Queens
It is possible to place 8 Queens on a 8x8 Chess Board without conflict, as shown on en.wikipedia.org/wiki/Eight_queens_puzzle. This is one of the possible solutions:
We can use these locations, and see what it does with our cube:
$ raku queen-cube-2 --queen="1;4;1 1;6;2 1;8;3 1;2;4 1;7;5 1;1;6 1;3;7 1;5;8" \
--colour 8
Layer 1-4:
q q q q q Q q q . . q q q q q . . . . q q q q q q . q q . q . .
q q q Q q q q q . . q q q q q q q q q q . q . . q . . q q . q q
q q q q q q Q q q q q q q q q q . . . q q q q q . q . q q . q .
Q q q q q q q q q q . . . q q q q q q q . q . . q q q q q q . q
q q q q q q q Q q q q . . . q q . . q . q q q q q . q q q q q q
q Q q q q q q q q q q q q q q q q q q q q . . . . q . q q . q .
q q q q Q q q q q q q q q q . . . . q . q q q q q q . q q . . q
q q Q q q q q q . q q q q q . . q q q q q . . . . . q . q q . q
And layer 5-8:
. q . q . q . q q q . . . q q . . . . . q q . . . . q . . q . .
. q . q . q . q . . . q q . . . . . q q . . . . . . . q . . . .
q . q . q . q . . q q . . . q q q . . . . . q . . . . . . . q .
q . q . q . q . q . . . . q . . q . . . . . q . q . . . . . . q
. q . q . q . q . . q . . . . q . q . . . . . q q . . . . . . q
. q . q . q . q q q . . . q q . . q . . . . . q . q . . . . . .
q . q . q . q . . . . q q . . . . . . . q q . . . . . . q . . .
q . q . q . q . . q q . . . q q . . q q . . . . . . q . . q . .
The program can do the split for us. Just add the «--newlines=4» to get a new block after four layers.
Now we can add a Queen at a time manually (at a vacant position) to the list, until we have run out of vacant positions:
$ raku queen-cube-3 --queen="1;4;1 1;6;2 1;8;3 1;2;4 1;7;5 1;1;6 1;3;7 1;5;8 \
2;1;1 2;4;3 2;5;6 3;3;1 3;7;2 3;2;5 3;8;7 3;4;8 4;1;2 4;8;4 4;6;8 5;6;1 \
5;3;2 5;1;5 5;8;8 6;8;1 6;1;3 6;4;4 6;6;5 7;7;3 7;8;5 7;2;6 7;1;8 8;2;1 \
8;5;3 8;1;4 8;3;8" --colour=html --newlines=4 8
q q q q q Q q q Q q q q q q q q q q q q q q q q q Q q q q q q q
q q q Q q q q q q q q q q q q q q q q q Q q q q q q q q q q q q
q q q q q q Q q q q q q q q q q Q q q q q q q q q q q q q q q q
Q q q q q q q q q q Q q q q q q q q q q q q q Q q q q q q q q q
q q q q q q q Q q q q q q Q q q q q q q q q q q q q q q q q q q
q Q q q q q q q q q q q q q q q q q q q q q q q q q q q q q q Q
q q q q Q q q q q q q q q q q q q Q q q q q q q q q q q q q q q
q q Q q q q q q q q q q q q q q q q q q q q Q q q q q Q q q q q
q q q q Q q q q q q Q q q q q q q q q q q q q Q q q q Q q q q q
q q q q q q q q q q q q q q q q q q q q q Q q q Q q q q q q q q
q Q q q q q q q q q q q q q q q q q q q q q q q q q q q q q q Q
q q q q q q q q q q q Q q q q q q q q q q q q q q q q q q q q q
q q q q q q q q q q q q q q q q q q q q q q q q q q Q q q q q q
Q q q q q q q q q q q q Q q q q q q q q q q q q q q q q q q q q
q q q q q q q q q q q q q q q q q q Q q q q q q q q q q q q q q
q q q q q q q Q Q q q q q q q q q q q q Q q q q q q q q q q q q
Number of Queens: 35
That was tedious. We can let the program place the Queens for us automatically with the «--fill» option, shown here on a smaller cube to make it easier on the eye:
$ raku queen-cube-4 --fill --colour 3
Q q q q q q q Q q
q q Q q q q q q q
q q q Q q q q q q
Number of Queens: 4
Note that «--fill» will give you the same cube each time, as it looks for the first vacant cell by iterating over the layers, rows, and columns in the same order. Random order is possible, by using the «--random» option instead.
$ raku queen-cube-4 --random --colour 3
q q Q Q q q q q q
q q q q q q q q q
q q q q Q q q q q
Number of Queens: 3
$ raku queen-cube-4 --random --colour 3
q q q q q q q Q q
q Q q q q q q q q
q q q q q q q q Q
Number of Queens: 3
We can specify some of the locations, and have the program do the rest:
$ raku queen-cube-4 --queen="1;1;1 1;3;4" --random --colour 4
Q q q q q q Q q q q q q q q q q
q q q q q q q q Q q q q q q Q q
q q q Q q q q q q q q q q q q q
q q q q q q q q q q q Q q Q q q
Number of Queens: 7
$ raku queen-cube --queen="1;1;1 1;3;4" --random --colour=html 4
Q q q q q q Q q q q q q q Q q q
q q q q q q q q q q q q q q q Q
q q q Q q q q q q q q q q q q q
q q q q Q q q q q q q Q q q q q
Number of Queens: 7
use lib "lib";
use QueenCube;
unit sub MAIN
(
$size = 8,
:$id = 'Q',
:$empty =".",
:$queen,
:$colour,
:$newlines,
:$fill, # [1]
:$random # [2]
);
get-one-solution;
sub get-one-solution
{
my $c = QueenCube.new(size => $size);
$c.init($empty);
if $queen
{
$c.queen($id, $_) for $queen.words;
}
if $fill || $random # [3]
{
loop # [4]
{
my ($pos) = $random # [5]
?? $c.get-empty-cell-random
!! $c.get-empty-cell;
last unless defined $pos; # [6]
my ($x, $y, $z) = $pos.split(";"); # [7]
$c.queen($id, $x, $y, $z); # [7a]
}
}
$newlines
?? $c.display-with-newlines($colour, $newlines)
!! $c.display($colour);
my $count = $c.number-of-queens;
say "Number of Queens: ", $count if $count > 1;
}
[1] Two new arguments. Use this one if you want the program to fill in the cube with Queens.
[2] As above, but at random positions.
[3] An eternal loop (with an exit strategy in [5]).
[4] Shall the program fill in the cube with Queens?
[5] Get a free cell. Either in an orderly fashion ($fill) or random order ($random)
[6] We get an undefined value if the cube is full. Then we are done.
[7] Place the Queen in the cell.
File: lib/QueenCube.rakumod (partial)
method get-empty-cell # [8]
{
for 1 .. self.size -> $x # [9]
{
for 1 .. self.size -> $y
{
for 1 ..self.size -> $z
{
return "$x;$y;$z" if @.elems[$x;$y;$z] eq self.blank; # [9a]
}
}
}
return; # [10]
}
[8] This method looks for an empty cell in an orderly (deterministic) fashion.
[9] Orderly, and return the first empty cell (if any).
[10] All the cells are in use.
File: lib/QueenCube.rakumod (partial)
method get-empty-cell-random # [11]
{
for self.get-all-cells.flat.pick(*) -> $elem # [12]
{
my ($x, $y, $z) = $elem.split(";");
return "$x;$y;$z" if @.elems[$x;$y;$z] eq self.blank;
}
return;
}
method get-all-cells # [13]
{
my @all;
for 1 .. self.size -> $x
{
for 1 .. self.size -> $y
{
for 1 ..self.size -> $z
{
@all.push("$x;$y;$z");
}
}
}
return @all;
}
[11] This one checks for empty cells in random order.
[12] Get the cells (in order). Applying pick(*) gives them in random order.
[13] This method gives us all the cells (in order).
And We Are Getting Closer..
Running the program multiple times gives us different values, and the highest may actually be the answer to the challenge. But it is hit and miss:
$ raku queen-cube-4 --random --silent 8
Number of Queens: 29
$ raku queen-cube-4 --random --silent 8
Number of Queens: 26
We can do it in a loop, by specifying the count like «--silent=100». Again on a smaller cube, but this time to save time:
$ raku queen-cube-5 --random --silent=100 6
Number of Queens: 15
Number of Queens: 16
Number of Queens: 15
...
Number of Queens: 14
Number of Queens: 14
12 (2)
13 (10)
14 (30)
15 (26)
16 (25)
17 (6)
18 (1)
The highest is 18, but we were lucky to get it as there was only one. And we have no way of knowing if we could get 19 (or indeed an even higher value) if we do more of them.
The big problem is that the iterations are independent of each other, so that we could end up with the same Queen placement in several of them.
This one has 8 cells, so we should have about 12 of each unique placement:
$ raku queen-cube-5 --random --silent=100 2
1 (100)
File: queen-cube-5 (with the changes highlighted)
use lib "lib";
use QueenCube;
unit sub MAIN
(
$size = 8,
:$id = 'Q',
:$empty =".",
:$queen,
:$colour,
:$newlines,
:$fill,
:$random,
:$silent
);
if $silent ~~ Int # [1]
{
get-many-solutions; # [1]
}
else
{
get-one-solution; # [2]
}
sub get-one-solution
{
my $c = QueenCube.new(size => $size);
$c.init($empty);
if $queen
{
$c.queen($id, $_) for $queen.words;
}
if $fill || $random
{
loop
{
my ($pos) = $random ?? $c.get-empty-cell-random !! $c.get-empty-cell;
last unless defined $pos;
say ": Queen at $pos" if $verbose;
my ($x, $y, $z) = $pos.split(";");
$c.queen($id, $x, $y, $z);
}
}
unless $silent # [3]
{
$newlines
?? $c.display-with-newlines($colour, $newlines)
!! $c.display($colour);
}
my $count = $c.number-of-queens;
say "Number of Queens: ", $count if $count > 1;
}
sub get-many-solutions
{
my @result; # [4]
@result.push(get-one-solution) for ^$silent; # [4]
my %result; # [5]
%result{$_}++ for @result; # [5]
say "$_ (%result{$_})" for %result.keys.sort; # [6]
}
[1] If we have asked for silent mode and given a number, do a loop (see [4]).
[2] If not, use the old code path.
[3] Don't print the layers if we have asked for silent mode.
[4] Get the result (the number of Queens) from each iteration and store them in the array.
[5] Count the values.
[6] Print the result.
A Mathematical Dead End?
A 8x8x8 cube has 512 cells. The maximum number of Queens on a 8x8 board is 8, so
64 is the highest possible maximum in the cube. The only way of finding the maximum
is actually trying. The first Queen can be placed in 1 of 512 cells. The second one
in 1 of the 511 remaining cells (and now I disregard the cells reachable by the
already placed Queen), and so on for the 64 Queens. That gives
512 * 511 * .. * 448, which we can get Raku to compute for us:
> say [*] 448 .. 512;
1815878539850422595668023320799222168591395177468449164490149162890332810900\
1845065339451603547567710616793882897215629214494003042100078276517608610733\
22803200000000000000000
> say ([*] 448 .. 512).chars;
175
Most of them will be discarded early on as the cells are reachable by already placed Queens, but this number shows the hopelessness of this approach. (Actually marking a cell as reachable by a Queen, and checking them before placing a Queen takes some comptational powers, so the complexity is comparable to the 175 digit number situation.)
For comparison, the total number of atoms in the observable universe is a number with about 80 digits.
That should scare off anybody...
But I'll have a go at programming it anyway.
The Answer to the Challenge
Specify «--get-the-best» on the command line to get the (or rather the first) populated cube with the highest possible number of Queens:
$ raku queen-cube --get-the-best --colour 1
Q
Number of Queens: 1
$ raku queen-cube --get-the-best --colour 2
Q q q q
q q q q
Number of Queens: 1
$ raku queen-cube --get-the-best --colour 3
Q q q q q q q Q q
q q Q q q q q q q
q q q Q q q q q q
Number of Queens: 4
$ raku queen-cube --get-the-best --colour 4
Q q q q q q q q q Q q q q q q q
q q Q q q q q q q q q q q q q q
q q q q q q q q q q q q Q q q q
q Q q q q q q Q q q q q q q Q q
Number of Queens: 7
$ raku queen-cube --get-the-best --colour 5
Q q q q q q q q q Q q Q q q q q q q q q q q Q q q
q q Q q q q q q q q q q q q q q q q q Q q q q q q
q q q q Q q q q q q q q q q q Q q q q q q q q q q
q Q q q q q q q q q q q q q q q q q q q q q q Q q
q q q Q q q q q q q Q q q q q q q q q q q Q q q q
Number of Queens: 13
$ raku queen-cube --get-the-best --colour --newlines=4 6
Q q q q q q q q q q Q q q Q q q q q q q q q q Q
q q Q q q q q q q q q q q q q q q q q q q q q q
q q q q Q q q q q q q q q q q q q q Q q q q q q
q Q q q q q q q q q q q q q q q q q q q q q q q
q q q Q q q q q q q q Q q q q q q q q q q q Q q
q q q q q q Q q q q q q q q Q q q q q q q q q q
q q Q q q q q q q q q q
q q q q q q q q q q q q
q q q q q Q q Q q q q q
q q q q q q q q q Q q q
q Q q q q q q q q q q q
q q q q q q q q q q q q
Number of Queens: 18
$ raku queen-cube --get-the-best --colour --newlines=4 7
Q q q q q q q q q q q Q q q q Q q q q q q q q q q q Q q
q q Q q q q q q q q q q q Q q q q q q q q q q q q q q q
q q q q Q q q q q q q q q q q q q q q q q Q q q q q q q
q Q q q q q q q q q q q q q q q q q q q q q q q q q q q
q q q Q q q q q q q q q Q q q q q q q q q q q q q q q q
q q q q q q q Q q q q q q q q q q q q q q q q q q q q Q
q q q q q q q q q Q q q q q q q q q Q q q q q q q q q q
q q Q q q q q q q q q q q Q q q q q q q q
q q q q q q q q q q q q q q q q q q Q q q
q q q q q Q q q Q q q q q q q q q q q q q
q q q Q q q q q q q q q q q q q q q q q q
q Q q q q q q q q q q q q q q q Q q q q q
q q q q Q q q q q q q q q q q q q q q q q
q q q q q q q q q q q q q q q q q q q Q q
Number of Queens: 25
$ raku queen-cube --get-the-best --colour --newlines=4 8
Q q q q q q q q q q q q Q q q q q Q q q q q q q q q q q q Q q q
q q Q q q q q q q q q q q q Q q q q q q q q q q q q q q q q q Q
q q q q Q q q q q q q q q q q q q q q q q q q q Q q q q q q q q
q Q q q q q q q q q q q q q q q q q q q q q q Q q q q q q q q q
q q q Q q q q q q q q q q Q q q q q q q q q q q q q q q q q q q
q q q q q q q q Q q q q q q q q q q q q q q q q q q q q q q Q q
q q q q q q q q q q Q q q q q q q q q q q q q q q q q q q q q q
q q q q q q q q q q q q q q q Q Q q q q q q q q q q q q q q q q
q q Q q q q q q q q q q q q Q q q q q q q q q q q q q q q q q q
q q q q q q q q q q q q q q q q q q q q q q q q q q q q q Q q q
q q q q q Q q q q Q q q q q q q q q q q q q q q q q q q q q q q
q q q Q q q q q q q q q q q q q q q q q q q q q q q q q Q q q q
q Q q q q q q q q q q q q q q Q q q Q q q q q q Q q q q q q q q
q q q q Q q q q q q q q q q q q q q q q q q q q q q q q q q q q
q q q q q q q q q q q q q q q q q q q q q Q q q q q q q q q q q
q q q q q q q q q q Q q q q q q q q q q q q q q q q q q q q q q
Number of Queens: 32
$ raku queen-cube --get-the-best --colour --newlines=3 9
Q q q q q q q q q q q q q Q q q q q q Q q q q q q q q
q q Q q q q q q q q q q q q q Q q q q q q q q q q q q
q q q q Q q q q q q q q q q q q q Q q q q q q q q q q
q Q q q q q q q q q q q q q q q q q q q q q q q q q q
q q q Q q q q q q q q q q q Q q q q q q q q q q q Q q
q q q q q q q q Q Q q q q q q q q q q q q q q q q q q
q q q q q q q q q q q Q q q q q q q q q q q Q q q q q
q q q q q q q q q q q q q q q q Q q Q q q q q q q q q
q q q q q q q q q q q q q q q q q q q q q q q Q q q q
q q q q q Q q q q q q Q q q q q q q q q q q q q Q q q
q q q q q q q Q q q q q q q q q q q q q q q q q q q Q
Q q q q q q q q q q q q q q q q q q q Q q q q q q q q
q q q q q q q q q q q q Q q q q q q q q q q q q q q q
q q q q q q q q q q Q q q q q q q q q q q q q q q q q
q q q q q q q q q q q q q q q q q q q q q q q q q Q q
q q q q q q Q q q q q q q q q q q q q q q q q q q q q
q q q q q q q q Q q q q q q q q q q q q q q q q q q q
q q q Q q q q q q q q q q q q q q q Q q q q q q q q q
q q q q q q q q q q q q q q q q q q q q q q q q q q q
q q q q q q q q q q q q q q q q q q q q q Q q q q q q
q q q q q Q q q q q q q q q q q Q q q q q q q q q q q
q q q q q q q q q q q q q q q q q q q q Q q q q q q q
q q Q q q q q q q Q q q q q q q q q q q q q q q q q q
q q q q q q q q q q q q q q q q q q q q q q q q q q q
q q q q q q q q q q Q q q q q q q q q q q q q q q q q
q q q q q q Q q q q q q q q q q q q q q q q q q q q q
q q q q q q q q Q q q q q q q q q q q q q q q q q q q
Number of Queens: 41
$ raku queen-cube --get-the-best --colour --newlines=3 10
Q q q q q q q q q q q q q q Q q q q q q q Q q q q q q q q q
q q Q q q q q q q q q q q q q q Q q q q q q q q q q q q q q
q q q q Q q q q q q q q q q q q q q Q q q q q q q q q q q q
q Q q q q q q q q q q q q q q q q q q q q q q q q q q q q q
q q q Q q q q q q q q q q q q Q q q q q q q q q q q q Q q q
q q q q q q q q Q q Q q q q q q q q q q q q q q q q q q q Q
q q q q q q q q q q q q Q q q q q q q q q q q q Q q q q q q
q q q q q q q q q q q q q q q q q Q q q Q q q q q q q q q q
q q q q q q q q q q q q q q q q q q q q q q q q q Q q q q q
q q q q q Q q q q q q q q Q q q q q q q q q q q q q q q Q q
q q q q q Q q q q q q q Q q q q q q q q q q q q q q Q q q q
q q q q q q q Q q q q q q q q q q q q q q q q q q q q q Q q
Q q q q q q q q q q q q q q q q q q q q q Q q q q q q q q q
q q q q q q q q q q q q q Q q q q q q q q q q q q q q q q q
q q q q q q q q q q q Q q q q q q q q q q q q q q q q q q q
q q q q q q q q q q q q q q q q q q q q q q q q q q q q q q
q q q q q q Q q q q q q q q q q q q q q q q q q q q q q q Q
q q q q q q q q Q q q q q q q q q q q q q q q q q Q q q q q
q q q Q q q q q q q q q q q q q q q q q Q q q q q q q q q q
q q q q q q q q q q q q q q q q q Q q q q q Q q q q q q q q
q q q q q q q q q q q q q q q q q q q q q q q q q q q q q q
q q q q q q q q q q q q q q q q q q q q q q q Q q q q q q q
q q q q q Q q q q q q q q q q q q Q q q q q q q q q q q q Q
q q q q q q q q q q q q q q q q q q q q q q q q Q q q q q q
q q Q q q q q q q q Q q q q q q q q q q q q q q q q q q q q
q q q q q q q Q q q q q q q q q q q q q q q q q q q q q q q
q q q q q q q q q q q Q q q q q q q q q q q q q q q q q q q
q q q q q q q q q q q q q q q q q q q q q q q q q q q q q q
q q q q q q q q Q q q q q q q q Q q q q q q Q q q q q q q q
q q q q q q q q q q q q q q q q q q q q Q q q q q q q q q q
q q q q q q q q q q
Q q q q q q q q q q
q q q q q q q q q q
q q q q q q Q q q q
q q q q q q q q Q q
q Q q q q q q q q q
q q q q q q q Q q q
q q q q Q q q q q q
q q q q q q q q q q
q q q q q q q q q q
Number of Queens: 58
We can go on, but I'll stop there.
File: queen-cube (complete program)
use lib "lib";
use QueenCube;
unit sub MAIN
(
$size = 8,
:$id = 'Q',
:$empty =".",
:$queen,
:$colour,
:$newlines,
:$fill,
:$random,
:$silent,
:$get-the-best, # [2]
:$verbose # [1]
);
if $get-the-best
{
get-the-best; # [2]
}
elsif $silent ~~ Int
{
get-many-solutions;
}
else
{
get-one-solution;
}
sub get-one-solution
{
my $c = QueenCube.new(size => $size);
$c.init($empty);
if $queen
{
$c.queen($id, $_) for $queen.words;
}
if $fill || $random
{
loop
{
my $pos = $random ?? $c.get-empty-cell-random !! $c.get-empty-cell;
last unless defined $pos;
say ": Queen at $pos" if $verbose;
my ($x, $y, $z) = $pos.split(";");
$c.queen($id, $x, $y, $z);
}
}
unless $silent
{
$newlines
?? $c.display-with-newlines($colour, $newlines)
!! $c.display($colour);
}
my $count = $c.number-of-queens;
say "Number of Queens: ", $count if $count > 1;
return $count;
}
sub get-many-solutions
{
my @result;
@result.push(get-one-solution) for ^$silent;
my %result;
%result{$_}++ for @result;
say "$_ (%result{$_})" for %result.keys.sort;
}
sub get-the-best # [2]
{
my Int $best-count = 0; # [3]
my $best-cube; # [3a]
my $c = QueenCube.new(size => $size); # [4]
$c.init($empty); # [4a]
iterate($c); # [5]
sub iterate ($cube) # [5]
{
for $cube.get-all-cells -> $cell # [6]
{
next unless $c.cell-is-free($cell); # [7]
my $copy = $cube.clone; # [8]
$copy.queen($id, $cell); # [9]
iterate($copy); # [10]
}
my $q = $cube.number-of-queens; # [11]
if $q > $best-count # [11]
{
say ": New best cube with $q Queens (old had $best-count)" if $verbose;
$best-count = $q; # [11b]
$best-cube = $cube # [11c]
}
elsif $verbose
{
say ": Considering cube with $q Queens";
}
}
$newlines
?? $c.display-with-newlines($colour, $newlines)
!! $c.display($colour);
say "Number of Queens: ", $best-count;
}
[1] I have added verbose mode to help debugging the latest addition, but have run out of time.
[2] The new code to get a cube with the highest possible number of Queens (hopefully).
[3] The current high score (highest number of Queens in a cube), and the cube (the first one) [3a].
[4] Set up the cube and initialise it [4a].
[5] Start the show by calling the recursive procedure.
[6] Iterate over all the cells in the cube,
[7] • skip cells that are in use.
[8] Get a clone (copy) of the cube (with the Raku supplied
clone method), so that we can work with (add new Queens) the cube recursively
without messing up the cube in the other iterations.
[9] Add a new Queen.
[10] Recursively add Queens.
[11] We get here when we have filled the cube (and this is where I think that I have the error. We should get here for every possible populated cube, but I suspect that we don't). Get the number of Queens in this cube, and save it [11a] and the cube [11b] if the number is higher than the old one.
File: lib/QueenCube.rakumod (surprisingly little new code here this time)
method cell-is-free ($cell) # [12]
{
my ($x, $y, $z) = $cell.split(";");
return self.elems[$x;$y;$z] eq self.blank;
}
[12] Is the given cell empty?
I'll update the article if I figure out the problem.
And that't it.