Pokemon Chiao, Perl 6

by Arne Sommer

Pokemon Chiao, Perl 6

Published 15. September 2019

This is my response to the Perl Weekly Challenge #25.

Challenge 25.1

Generate a longest sequence of the following English Pokeman names where each name starts with the last letter of previous name.

audino bagon baltoy banette bidoof braviary bronzor carracosta charmeleon cresselia croagunk darmanitan deino emboar emolga exeggcute gabite girafarig gulpin haxorus heatmor heatran ivysaur jellicent jumpluff kangaskhan kricketune landorus ledyba loudred lumineon lunatone machamp magnezone mamoswine nosepass petilil pidgeotto pikachu pinsir poliwrath poochyena porygon2 porygonz registeel relicanth remoraid rufflet sableye scolipede scrafty seaking sealeo silcoon simisear snivy snorlax spoink starly tirtouga trapinch treecko tyrogue vigoroth vulpix wailord wartortle whismur wingull yamask

The above names borrowed from wiki page.

Infinite

The challenge doesn't say so, but repetitions clearly shouldn't be allowed as they would allow an infinite sequence; e.g. «girafarig girafarig girafarig ...».

But if you want an infinite sequence, here it is. Specify the number of elements on the command line, if the default value of 10 doesn't suit you.

File: pokemon-infinite
unit sub MAIN (Int $count = 10);

my @infinite = 'girafarig', 'girafarig' ... *;

say @infinite[^$count];

It would have been easier to just use a «for» loop, but that wouldn't have given us an infinite sequence...

Some Observations

Before tackling the challenge, I'll make some observations - combined with a little bit of programming.

Let us start with a list of starting and ending characters, to get an idea of the complexity:

File: pokemon-observations
my @names = <audino bagon baltoy banette bidoof braviary bronzor
  carracosta charmeleon cresselia croagunk darmanitan deino emboar
  emolga exeggcute gabite girafarig gulpin haxorus heatmor heatran
  ivysaur jellicent jumpluff kangaskhan kricketune landorus ledyba
  loudred lumineon lunatone machamp magnezone mamoswine nosepass
  petilil pidgeotto pikachu pinsir poliwrath poochyena porygon2
  porygonz registeel relicanth remoraid rufflet sableye scolipede
  scrafty seaking sealeo silcoon simisear snivy snorlax spoink
  starly tirtouga trapinch treecko tyrogue vigoroth vulpix wailord
  wartortle whismur wingull yamask>;                                # [1]
 
say "Names: { @names.elems }.";                                     # [2]

my @start = @names.map( *.substr(  0,1) ).unique;                   # [3]
my @end   = @names.map( *.substr(*-1,1) ).unique.sort;              # [4]

say "Start: { @start }.";                                           # [3]
say "End:   { @end }.";                                             # [4]

[1] I have added newlines to make it fit the screen width.

[2] The number of names.

[3] A list of all the starting letters, without repetition. The names are already sorted, so this list will also be sorted.

[4] A list of all the ending letters, which must be sorted manually.

Running it:

$ perl6 pokemon-observations
Names: 70.
Start: a b c d e g h i j k l m n p r s t v w y.
End:   2 a d e f g h k l n o p r s t u x y z.

The first name in the list («audino») is a dead end, as no name begins with the letter «o». But it can be in our solution anyway, as the last item.

The second name in the list («bagon») is a dead start (for want of a better term), as no name ends with «b». But we have a name beginning with «n» («nosepass»), so it isn't a dead end. It can be part of the solution, but only as the first item.

We can see that the solution is a list with at least two names (as we have several letters that appear in both the start and end list), and at most 70.

A names without neighbours, called orphans (as no name has their start letter as end letter, and vice versa), can be removed. Let us see if there are any:

File: pokemon-observations (changes only)
my %start   = @start.Set;   # [1]
my %end     = @end.Set;     # [1]
my @orphans = @names.grep({ ! %end{$_.substr(0,1)} &&       # [2a]
                            ! %start{$_.substr(*-1,1)} });  # [2b]

say "Orphans: { @orphans }";

[1] We want to do hash lookups on the start and end characters, so we set them up a a Set (where the value is True or False, telling us if the key (in our case the start or end letter) is present in the Set).

[2] Take (with «grep») all names where the first letter is not an end letter for any name (2a), and also the last letter is not a start letter for any name (2b). The list is sorted, as «@names» is sorted.

See docs.perl6.org/language/setbagmix for more information abouts Sets.

Running it:

$ perl6 pokemon-observations 
Names: 70.
Start: a b c d e g h i j k l m n p r s t v w y.
End:   2 a d e f g h k l n o p r s t u x y z.
Orphans: bidoof jumpluff vulpix

There are only three orphans.

We can remove them from the list with the Set minus operator:

File: pokemon-observations (changes only)
my @not-dead = (@names ∖ @orphans).keys.sort;  # [1]

say "Not Dead (implied): { @not-dead }"

[1] Not a «\» but the set minus operator «∖» (Unicode U+2216). Note that we apply it on two lists, which are coerced to Sets before the operator does its magic. We have to sort the resulting list, as Sets are unordered, i.e. have a random order when coerced to a list.

Removing three of 70 names from the list doesn't exactly help us that much, so I'll consider this a dead end.

Graph Visualisation with Graphviz

We can set up a graph with 70 nodes (the names), and they have a list of neighbours (in the forward direction only) which can be empty. Then the task is simply (!) a graph traversal problem.

Trying to visualise a graph with 70 nodes may not be a good idea. But I'll have a go at it anyway, with the Graphviz program, to get an idea of the problem at hand.

We have a directed graph, called «Digraph» by Graphviz. The following example (borrowed from graphs.grevian.org) shows how it is done:

Then it is just a matter of doing some programming:

File: pokemon-graphviz
my @names = <audino bagon baltoy banette bidoof braviary bronzor
  carracosta charmeleon cresselia croagunk darmanitan deino emboar
  emolga exeggcute gabite girafarig gulpin haxorus heatmor heatran
  ivysaur jellicent jumpluff kangaskhan kricketune landorus ledyba
  loudred lumineon lunatone machamp magnezone mamoswine nosepass
  petilil pidgeotto pikachu pinsir poliwrath poochyena porygon2
  porygonz registeel relicanth remoraid rufflet sableye scolipede
  scrafty seaking sealeo silcoon simisear snivy snorlax spoink
  starly tirtouga trapinch treecko tyrogue vigoroth vulpix wailord
  wartortle whismur wingull yamask>;

my @start = @names.map( *.substr(0,1) ).unique;

my %start-list;                                                  # [1]

for @start -> $letter                                            # [1a]
{
  %start-list{$letter} = @names.grep(*.substr(0,1) eq $letter);  # [1b]
}

say 'digraph foogrph {';                                         # [2]

for @names -> $name                                              # [3]
{
  my $last-char = $name.substr(*-1,1);                           # [4]

  if %start-list{$last-char}                                     # [5]
  {
    for @(%start-list{$last-char}) -> $next                      # [6]
    {
      say "  $name -> $next;" unless $name eq $next;             # [6a]
    }
  }
  else                                                           # [7]
  {
    say "  $name;"; # A dead end.                                # [7]
  } 
}

say '}';                                                         # [2]

[1] This hash has the start letters of the names as keys, and the values are a list of all names starting with that letter. We set it up by iterating over the start letters (1a), selecting the names (with «grep») (1b).

[2] The start and end of the Vizgraph data structure.

[3] Iterate over the names.

[4] Get the last character of the current name.

[5] If we have names starting with that letter,

[6] • Iterate over the list and print the pair (but not if they are equal, as e.g. «girafarig» and «girafarig»).

[7] If not (in 5), print the name only.

Running it gives the output (in «dot» format) on STDOUT, so we redirect it to a file:

$ perl6 pokemon-graphviz > pokemon.dot

The pokemon.dot file is included in the zip file.

We generate the graph with the «dot» command, which also writes to STDOUT. Use the «-T» command line option to specify the output format:

$ dot -Tpng pokemon.dot > pokemon.png
$ dot -Tsvg pokemon.dot > pokemon.svg

The image looks like this, scaled down: .

It is also available as a large png file, and a much nicer svg file.

I have chosen to represent each connection on a separate line. Graphwiz supports a more compact one-line notation for this; E.g «A -> { B C };» instead of «A -> B;» and «A -> C;».

The answer to the Challenge, finally

The program uses a recursive procedure, and is very short (except for this procedure):

File: pokemon-path (partial)
my @names = <audino bagon baltoy banette bidoof braviary bronzor
  carracosta charmeleon cresselia croagunk darmanitan deino emboar
  emolga exeggcute gabite girafarig gulpin haxorus heatmor heatran
  ivysaur jellicent jumpluff kangaskhan kricketune landorus ledyba
  loudred lumineon lunatone machamp magnezone mamoswine nosepass
  petilil pidgeotto pikachu pinsir poliwrath poochyena porygon2
  porygonz registeel relicanth remoraid rufflet sableye scolipede
  scrafty seaking sealeo silcoon simisear snivy snorlax spoink
  starly tirtouga trapinch treecko tyrogue vigoroth vulpix wailord
  wartortle whismur wingull yamask>;                             # [1]

my @start = @names.map( *.substr(0,1) ).unique;                  # [2]

my %start-list;                     # [3]

for @start -> $letter               # [3a]
{
  %start-list{$letter} = @names.grep(*.substr(0,1) eq $letter);  # [3b]
}

my $length = 0;                     # [4]
my @solution;                       # [5]

for @names -> $name                 # [6]
{
  do-check( $name.List );           # [6]
}

for @(@solution) -> @sol            # [7]
{
  say "{ @sol.elems }: { @sol }";   # [7]
}

say "Total: { @(@solution).elems } solutions.";  # [8]

[1] I have added newlines to make it fit the screen width.

[2] A list of all the starting letters, without repetition. The names are already sorted, so this list will also be sorted.

[3] A This hash has the start letters of the names as keys, and the values are a list of all names starting with that letter. We set it up by iterating over the start letters (3a), selecting the names (with «grep») (3b).

[4] The length (number of names) in the current solution, the longest one p.t. It starts at zero, obviously.

[5] The solutions, as a list of lists. We can have several solutions that are equally long - and thus equally right.

[6] Iterate over the names, and pass each one to «do-check» as a list (as «do-check» requires a list).

[7] After the recursive magic, we print the result by iterating over the list of lists, printing each one.

[8] And finally we print the count; how many lists we have in the result.

File: pokemon-path (the rest)
sub do-check (@path)                       # [9]
{
  my $last = @path[*-1];                   # [10]
  my $last-letter = $last.substr(*-1,1);   # [11]

  my $found-next = False;                  # [12]

  if %start-list{$last-letter}             # [13]
  {
    for @(%start-list{$last-letter}) -> $next-name # [14]
    {
      next if $next-name eq any( @path );          # [15]

      my @new = @path; @new.push: $next-name;      # [16]
      $found-next = True;                          # [16a]
      do-check(@new);                              # [16b]
    }
  }
  unless $found-next                               # [17]
  {
    my $current-length = @path.elems;              # [18]

    return if $current-length < $length;           # [19]

    if $current-length > $length                   # [20]
    {
      @solution = ();                              # [21]
      $length = $current-length;                   # [22]
      say "Currently longest path found at $current-length."; # [22a]
    }
    
    @solution.push(@path);                         # [23]
  }
}

[9] We start with a list of names (that has been found ok, so far).

[10] Get the last name in that list,

[11] and the last letter of that last name.

[12] We haven't found any new names to add to the list (yet).

[13] Are there any names starting with that last letter (from 11)?

[14] If yes, iterate over the names.

[15] Skip the name if it is already in the list of names (@path). Note the clever use of «any» here (meaning «is the next-name already in @path»), so we could avoid a separate list of visited (or used) names.

[16] Here we have a legal next word. Add it to a copy of the list of names (as we use recursion, and all calls must have their own version). We have (at least) one new word, so set the flag (16a), and call «do-check-path» recursively (with the new list)(16b).

[17] If we haven't added a new word to the initial list,

[18] Get the number of names in the list.

[19] If that number is smaller than the one in (the global variable) $length, abort this call.

[20] If that number is greater,

[21] • emtpy the list of solutions (the global variable @solution).

[22] • set the new length (number og names) of the currently longest solution. (I have added a debug line (22a) to visualise what is happening while we wait for the rpogram to finish. And wait. And wait.

[23] Add the solution to the global list of solutions. If neither of the «if» statements above kicked in, the new length is the same as the old length. In that case, we simply add the new solution to the list.

Running it:

$ perl6 pokemon-gone
Currently longest path found at 1.
Currently longest path found at 9.
Currently longest path found at 10.
Currently longest path found at 11.
Currently longest path found at 12.
Currently longest path found at 13.
Currently longest path found at 14.
Currently longest path found at 15.
Currently longest path found at 16.
Currently longest path found at 17.
Currently longest path found at 18.
Currently longest path found at 19.
Currently longest path found at 20.
Currently longest path found at 21.
Currently longest path found at 22.
Currently longest path found at 23.
23: machamp petilil landorus scrafty yamask kricketune emboar registeel \
  loudred darmanitan nosepass simisear relicanth heatmor rufflet trapinch \
  haxorus seaking girafarig gabite exeggcute emolga audino
23: machamp petilil landorus scrafty yamask kricketune emboar registeel \
  loudred darmanitan nosepass simisear rufflet trapinch heatmor relicanth \
  haxorus seaking girafarig gabite exeggcute emolga audino
....
23: machamp pinsir rufflet trapinch heatmor remoraid darmanitan nosepass \
  starly yamask kricketune exeggcute emboar relicanth haxorus simisear \
  registeel landorus seaking girafarig gabite emolga audino
Total: 1248 solutions.

The program took about 13 minutes on my computer. That is not very fast, but is probably ok for a recursive procedure that gets called a lot.

The length of the longest sequence of names is 23. Note the number of (equally valid) answers; 1248. I have removed most of them from the listing.

The solutions come in alphabetical order (or the same order as the input list of names), and will do so every time we run the program. (So if we change it to only print one solution, we will get the same one each time.)

Euler Bonus

I do apologise for the lack of theoretical foundation in this article, so this section is here to make amends.

In Challenge 21 (Challenge | My solution) we handled Euler’s number. Our friend Leonard Euler (1707-1783) was a very productive gentleman, and he worked with graph theory among other things.

His solution to the problem known as the Seven Bridges of Königsberg is considered to be the first theorem of graph theory. So he laid the foundation for the whole field of graph theory.

You will not find the German city of Königsberg on any recent map. And the reason is not that the mathematicians made up cities as they went along, but that it ceased to exist as a German city in 1945. The Russians annexed it (in accordance with the Yalta Conference), and renamed it Kaliningrad.

This section didn't actually add any theoretical foundation, except name dropping Euler. So be it.

Challenge 25.2

Create script to implement Chaocipher. Please checkout wiki page for more information.

The wikipedia article isn't very helpful, but this pdf article is: www.mountainvistasoft.com/chaocipher/ActualChaocipher/Chaocipher-Revealed-Algorithm.pdf.

Note that when I use a variable called or pefixed with «encoded», this applies to the default encoding mode. If we enable decoding (with «--decipher»), this is turned upside down - and the variables have the opposite meaning.

Here it is, in parts to make it easier to follow:

File: chaocipher (partial)
subset ChaoChar of Str where $_ eq any ('A' .. 'Z');   # [1]
subset ChaoStr  of Str where /^ <[A .. Z]>+ $/;        # [2]

subset ChaoAlphabet of Str
  where $_.comb.sort.join eq 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';          # [3]

unit sub MAIN (ChaoStr      $message,                               # [4a]
               Bool         :$verbose,                              # [4b]
	       Bool         :$decipher,                             # [4c]
	       ChaoAlphabet :$left  = ('A' ... 'Z').pick(*).join,   # [4d]
	       ChaoAlphabet :$right = ('A' ... 'Z').pick(*).join);  # [4e]

my @left  = $left.comb;                                # [5]
my @right = $right.comb;                               # [6]

say "!! { @left.join }  { @right.join }" if $verbose;  # [7]

constant ZENITH = 0;                                   # [8]
constant NADIR  = 13;                                  # [8a]
constant END    = 25;                                  # [8b]

[1] I set up a custom type for the characters (both plain text and encoded); A .. Z only

[2] Ditto for the input string (to encode), but a whole string.

[3] The alphabet (used for both the «left» and «right» paramater) is exactly the 26 letters A .. Z when we sort it.

[4] The arguments to the program:

[4a] The message to encode (or decode).

[4b] A named optional flag «--verbose» to get debug messages. (Described in the section where we run the program.)

[4c] A named optional flag «--decipher» tellling the program to decipher (or decode, or decrypt, depending on your dictionary) the text instead of encoding it.

[4d] A named optional flag «--left» taking the left alphabet. The program will use a random value if it isn't specified. It is essential to use the «--verbose» flag if this one isn't used, as you will need the alphabet!

[4e] A named optional flag «--right», as above, but for the right alphabet.

[5] Get the left alphabet in a list (as it is easier to pick a single letter from a list (by an index) than from a string (with «substr»), but more importantly we can rotate a list with «rotate», but a string must be done manually (with 2x «substr»).

[6] As above, but for the right alphabet.

[7] Debug output (enabled by (4b)), and described later on.

[8] ZENITH (shown as «+») and NADIR (shown as «+») are as described, except that I have definef them as 1 below the specified values (as Perl 6 starts an array with index 0, and not 1 as used in the explanation). END is simply the index of the last character in the alphabet strings. I have set them up as constants, as they are indeed constant. (Sigils are not needed on constants, but you are free to use them.)

File: chaocipher (partial)
my $encoded-message = "";                  # [9]

for $message.comb -> $letter               # [10]
{
  my $encoded-letter = $decipher           # [11]
    ?? left2right($letter)                 # [11a]
    !! right2left($letter);                # [11b]

  $encoded-message ~= $encoded-letter;     # [12]

  if ($decipher)                                               # [13]
  {
    @left  .= rotate while @left[ZENITH]  ne $letter;          # [13a]
    @right .= rotate while @right[ZENITH] ne $encoded-letter;  # [13b]
  }
  else                                                         # [14]
  {
    @left  .= rotate while @left[ZENITH]  ne $encoded-letter;  # [14a]
    @right .= rotate while @right[ZENITH] ne $letter;          # [14b]
  }

  @right .= rotate;                                            # [15]
  
  @left  = @left[ZENITH, ZENITH + 2 .. NADIR, ZENITH + 1,
                 NADIR + 1 .. END].flat;                       # [16]

  @right = @right[ZENITH, ZENITH + 1, ZENITH + 3 .. NADIR,
                  ZENITH + 2, NADIR + 1 .. END].flat;          # [17]
  
  say "!! { @left.join }  { @right.join }   $encoded-letter   $letter"
    if $verbose;                                               # [18]
}

[9] We collect the encoded message (one letter at a time) here.

[10] Iterate over the letters in the original message.

[11] If we have requested decoding; call «left2right», and if not call «right2left».

[12] Add the newly encoded letter to the string.

[13] If we have requested decoding, rotate the left (13a) and right (13b) alphabets as required.

[14] If not, do the rotation with the plain text letter and the encoded letter swapped.

[15] One addition rotation, as required.

[16] Hash slices (as we have on the right side of the assignment) are not assigneable, so we cannot use them on the left hand side. I could have used «splice» to swap parts of the list, but fdound it easier to specify the complete list instead. The final «flat» is there as the slices are not flatten by default. Whithout it we would have ended up with 4 elemens (a value, a list, a value, and a list). This is for the left alpahbet.

[17] As above, but for the right alphabet.

[18] As (7), enabled by (4b), and described later on.

File: chaocipher (partial)
sub right2left (ChaoChar $letter)                       # [11b]
{
  for 0 .. Inf -> $index                                # [19]
  {
    return @left[$index] if @right[$index] eq $letter;  # [19a]
  }
}

sub left2right (ChaoChar $letter)                       # [11a]
{
  for 0 .. Inf -> $index                                # [20]
  {
    return @right[$index] if @left[$index] eq $letter;  # [20a]
  }
}

[19] This is the encoding, where we take the input letter, get the index it has in the left alphabet, and returns the letter with the same index from the right alphabet.

[20] This is the decoding, where the left and right alpahbets have switched roles.

Running it, with the sample values from the pdf document:

$ perl6 chaocipher --left=HXUCZVAMDSLKPEFJRIGTWOBNYQ \
  --right=PTLNBQDEOYSFAVZKGJRIHWXUMC WELLDONEISBETTERTHANWELLSAID
OAHQHCNYNXTSZJRRHJBYHQKSOUJY

With verbose mode:

$ perl6 chaocipher --left=HXUCZVAMDSLKPEFJRIGTWOBNYQ --verbose  \
  --right=PTLNBQDEOYSFAVZKGJRIHWXUMC WELLDONEISBETTERTHANWELLSAID
!! HXUCZVAMDSLKPEFJRIGTWOBNYQ  PTLNBQDEOYSFAVZKGJRIHWXUMC
!! ONYQHXUCZVAMDBSLKPEFJRIGTW  XUCPTLNBQDEOYMSFAVZKGJRIHW   O   W
!! ADBSLKPEFJRIGMTWONYQHXUCZV  OYSFAVZKGJRIHMWXUCPTLNBQDE   A   E
!! HUCZVADBSLKPEXFJRIGMTWONYQ  NBDEOYSFAVZKGQJRIHMWXUCPTL   H   L
!! QUCZVADBSLKPEHXFJRIGMTWONY  NBEOYSFAVZKGQDJRIHMWXUCPTL   Q   L
!! HFJRIGMTWONYQXUCZVADBSLKPE  JRHMWXUCPTLNBIEOYSFAVZKGQD   H   D
!! CVADBSLKPEHFJZRIGMTWONYQXU  YSAVZKGQDJRHMFWXUCPTLNBIEO   C   O
!! NQXUCVADBSLKPYEHFJZRIGMTWO  BIOYSAVZKGQDJERHMFWXUCPTLN   N   N
!! YHFJZRIGMTWONEQXUCVADBSLKP  RHFWXUCPTLNBIMOYSAVZKGQDJE   Y   E
!! NQXUCVADBSLKPEYHFJZRIGMTWO  MOSAVZKGQDJERYHFWXUCPTLNBI   N   I
!! XCVADBSLKPEYHUFJZRIGMTWONQ  AVKGQDJERYHFWZXUCPTLNBIMOS   X   S
!! TONQXCVADBSLKWPEYHUFJZRIGM  IMSAVKGQDJERYOHFWZXUCPTLNB   T   B
!! SKWPEYHUFJZRILGMTONQXCVADB  RYHFWZXUCPTLNOBIMSAVKGQDJE   S   E
!! ZILGMTONQXCVARDBSKWPEYHUFJ  LNBIMSAVKGQDJOERYHFWZXUCPT   Z   T
!! JILGMTONQXCVAZRDBSKWPEYHUF  LNIMSAVKGQDJOBERYHFWZXUCPT   J   T
!! RBSKWPEYHUFJIDLGMTONQXCVAZ  RYFWZXUCPTLNIHMSAVKGQDJOBE   R   E
!! RSKWPEYHUFJIDBLGMTONQXCVAZ  YFZXUCPTLNIHMWSAVKGQDJOBER   R   R
!! HFJIDBLGMTONQUXCVAZRSKWPEY  LNHMWSAVKGQDJIOBERYFZXUCPT   H   T
!! JDBLGMTONQUXCIVAZRSKWPEYHF  MWAVKGQDJIOBESRYFZXUCPTLNH   J   H
!! BGMTONQUXCIVALZRSKWPEYHFJD  VKQDJIOBESRYFGZXUCPTLNHMWA   B   A
!! YFJDBGMTONQUXHCIVALZRSKWPE  HMAVKQDJIOBESWRYFGZXUCPTLN   Y   N
!! HIVALZRSKWPEYCFJDBGMTONQUX  RYGZXUCPTLNHMFAVKQDJIOBESW   H   W
!! QXHIVALZRSKWPUEYCFJDBGMTON  SWYGZXUCPTLNHRMFAVKQDJIOBE   Q   E
!! KPUEYCFJDBGMTWONQXHIVALZRS  NHMFAVKQDJIOBRESWYGZXUCPTL   K   L
!! SPUEYCFJDBGMTKWONQXHIVALZR  NHFAVKQDJIOBRMESWYGZXUCPTL   S   L
!! OQXHIVALZRSPUNEYCFJDBGMTKW  WYZXUCPTLNHFAGVKQDJIOBRMES   O   S
!! UEYCFJDBGMTKWNOQXHIVALZRSP  GVQDJIOBRMESWKYZXUCPTLNHFA   U   A
!! JBGMTKWNOQXHIDVALZRSPUEYCF  OBMESWKYZXUCPRTLNHFAGVQDJI   J   I
!! YFJBGMTKWNOQXCHIDVALZRSPUE  JIBMESWKYZXUCOPRTLNHFAGVQD   Y   D
OAHQHCNYNXTSZJRRHJBYHQKSOUJY

And the opposite direction:

$ perl6 chaocipher --left=HXUCZVAMDSLKPEFJRIGTWOBNYQ --decipher \
  --right=PTLNBQDEOYSFAVZKGJRIHWXUMC OAHQHCNYNXTSZJRRHJBYHQKSOUJY
WELLDONEISBETTERTHANWELLSAID

With verbose mode:

$ perl6 chaocipher --left=HXUCZVAMDSLKPEFJRIGTWOBNYQ --decipher --verbose \
  --right=PTLNBQDEOYSFAVZKGJRIHWXUMC OAHQHCNYNXTSZJRRHJBYHQKSOUJY
!! HXUCZVAMDSLKPEFJRIGTWOBNYQ  PTLNBQDEOYSFAVZKGJRIHWXUMC
!! ONYQHXUCZVAMDBSLKPEFJRIGTW  XUCPTLNBQDEOYMSFAVZKGJRIHW   W   O
!! ADBSLKPEFJRIGMTWONYQHXUCZV  OYSFAVZKGJRIHMWXUCPTLNBQDE   E   A
!! HUCZVADBSLKPEXFJRIGMTWONYQ  NBDEOYSFAVZKGQJRIHMWXUCPTL   L   H
!! QUCZVADBSLKPEHXFJRIGMTWONY  NBEOYSFAVZKGQDJRIHMWXUCPTL   L   Q
!! HFJRIGMTWONYQXUCZVADBSLKPE  JRHMWXUCPTLNBIEOYSFAVZKGQD   D   H
!! CVADBSLKPEHFJZRIGMTWONYQXU  YSAVZKGQDJRHMFWXUCPTLNBIEO   O   C
!! NQXUCVADBSLKPYEHFJZRIGMTWO  BIOYSAVZKGQDJERHMFWXUCPTLN   N   N
!! YHFJZRIGMTWONEQXUCVADBSLKP  RHFWXUCPTLNBIMOYSAVZKGQDJE   E   Y
!! NQXUCVADBSLKPEYHFJZRIGMTWO  MOSAVZKGQDJERYHFWXUCPTLNBI   I   N
!! XCVADBSLKPEYHUFJZRIGMTWONQ  AVKGQDJERYHFWZXUCPTLNBIMOS   S   X
!! TONQXCVADBSLKWPEYHUFJZRIGM  IMSAVKGQDJERYOHFWZXUCPTLNB   B   T
!! SKWPEYHUFJZRILGMTONQXCVADB  RYHFWZXUCPTLNOBIMSAVKGQDJE   E   S
!! ZILGMTONQXCVARDBSKWPEYHUFJ  LNBIMSAVKGQDJOERYHFWZXUCPT   T   Z
!! JILGMTONQXCVAZRDBSKWPEYHUF  LNIMSAVKGQDJOBERYHFWZXUCPT   T   J
!! RBSKWPEYHUFJIDLGMTONQXCVAZ  RYFWZXUCPTLNIHMSAVKGQDJOBE   E   R
!! RSKWPEYHUFJIDBLGMTONQXCVAZ  YFZXUCPTLNIHMWSAVKGQDJOBER   R   R
!! HFJIDBLGMTONQUXCVAZRSKWPEY  LNHMWSAVKGQDJIOBERYFZXUCPT   T   H
!! JDBLGMTONQUXCIVAZRSKWPEYHF  MWAVKGQDJIOBESRYFZXUCPTLNH   H   J
!! BGMTONQUXCIVALZRSKWPEYHFJD  VKQDJIOBESRYFGZXUCPTLNHMWA   A   B
!! YFJDBGMTONQUXHCIVALZRSKWPE  HMAVKQDJIOBESWRYFGZXUCPTLN   N   Y
!! HIVALZRSKWPEYCFJDBGMTONQUX  RYGZXUCPTLNHMFAVKQDJIOBESW   W   H
!! QXHIVALZRSKWPUEYCFJDBGMTON  SWYGZXUCPTLNHRMFAVKQDJIOBE   E   Q
!! KPUEYCFJDBGMTWONQXHIVALZRS  NHMFAVKQDJIOBRESWYGZXUCPTL   L   K
!! SPUEYCFJDBGMTKWONQXHIVALZR  NHFAVKQDJIOBRMESWYGZXUCPTL   L   S
!! OQXHIVALZRSPUNEYCFJDBGMTKW  WYZXUCPTLNHFAGVKQDJIOBRMES   S   O
!! UEYCFJDBGMTKWNOQXHIVALZRSP  GVQDJIOBRMESWKYZXUCPTLNHFA   A   U
!! JBGMTKWNOQXHIDVALZRSPUEYCF  OBMESWKYZXUCPRTLNHFAGVQDJI   I   J
!! YFJBGMTKWNOQXCHIDVALZRSPUE  JIBMESWKYZXUCOPRTLNHFAGVQD   D   Y
WELLDONEISBETTERTHANWELLSAID

A Note on Verbose Mode

If you compare the verbose output from the encoding with the table in the pdf file, you will notice that I have chosen to print the letters (starting with «W» and «O» from the second line, and not the first one. I print one additional line, withe the last letters - and this line shows where those letters come from. The pdf file doesn't explain the discrepancy.

The pdf file doesn't show the verbose output from the decoding, but as the program obviously gives the right answer we are done.