Gray Swapping with Raku & Perl

[84] Published 25. July 2020.

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

Challenge #070.1: Character Swapping

You are given a string $S of size $N.

You are also given swap count $C and offset $O such that $C >= 1, $O >= 1, $C <= $O and $C + $O <= $N.

Example

Input:
    $S = 'perlandraku'
    $C = 3
    $O = 4

Character Swapping:
    swap 1: e <=> n = pnrlaedraku
    swap 2: r <=> d = pndlaerraku
    swap 3: l <=> r = pndraerlaku

Output:
    pndraerlaku

It is easier to change elements in an array, than characters inside a string, so I'll do just that.

File: charswap-mod

#! /usr/bin/env raku

subset PosInt of Int where * >= 1;                                   # [1]

unit sub MAIN (:$S = 'perlandraku',                                  # [2]
               PosInt :$O = 4,
	       PosInt :$C where $C < $O && $C + $O <= $S.chars = 3,  # [3]
	       :$v, :$verbose = $v);                                 # [4]

my @S = $S.comb;                                                     # [5]
my $N = $S.chars;                                                    # [6]

for 1 .. $C -> $index                                                # [7]
{
  say "swap $index: { @S[$index % $N] } <-> { @S[ ($index + $O) % $N ] } \
    == { @S.join }" if $verbose;
  
  swap(@S[$index % $N], @S[ ($index + $O) % $N ]);                   # [8]
}

say @S.join;                                                         # [9]

sub swap ($a is rw, $b is rw)                                        # [10]
{
  ($a, $b) = ($b, $a);
}

[1] Both $O and $C are required to be positive integers (i.e. larger than or equal to zero). A custom type makes it easier to see what is going on, rather than adding another where clause on them. Especially line [4].

[2] I have chosen named arguments, so that we can let if fall back to default values for any argument.

[3] Quite a where clause. Note the default value at the end, which is not part of that clause.

[4] Verbose mode (--verbose or -verbose) and the shortcut (--v or -v).

[5] The individual letters in an array, as it is easier to handle array elements than single characters in a string (substrings).

[6] The length of the string. We needed that value in [3], but the variable is not available there.

[7] Iterate over the indeces of the letters to swap, starting with 1. This means that the first letter (at index 0) will not be swapped, ever.

[8] Swap the two letters, using a procedure (see [10]).

[9] Print the result after the swappings. We have an array, so

[10] Procedure arguments are read only by default, so we cannot change them. is copy would give us a writeable copy, but the values outside of the procedure would not be effected. Using is rw solves this, as we can write to the original variable. This requires writeable variables, so a call like swap("p", "e") will fail (and terminate the program).

Running it:

$ /charswap-mod
pndraerlaku

$ .charswap-mod -v
swap 1: e <-> n == perlandraku
swap 2: r <-> d == pnrlaedraku
swap 3: l <-> r == pndlaerraku
pndraerlaku

$ ./charswap-mod -S="This is not the end" -O=9 -C=7
Tt the enohis is nd

$ ./charswap-mod -v -S="This is not the end" -O=9 -C=7
swap 1: h <-> t == This is not the end
swap 2: i <->   == Ttis is noh the end
swap 3: s <-> t == Tt s is nohithe end
swap 4:   <-> h == Tt t is nohishe end
swap 5: i <-> e == Tt this nohis e end
swap 6: s <->   == Tt thes nohis i end
swap 7:   <-> e == Tt the  nohis isend
Tt the enohis is nd

The % $N part (modulo N) can be removed, as it will never be triggered because of the $C + $O <= $S.chars clause in [4].

And we can remove $N as well, as it is not used.

File: charswap-sans-mod

#! /usr/bin/env raku

subset PosInt of Int where * >= 1;

unit sub MAIN (:$S = 'perlandraku',
               PosInt :$O = 4,
	       PosInt :$C where $C < $O && $C + $O <= $S.chars = 3,
	       :$v, :$verbose = $v);

my @S = $S.comb;

for 1 .. $C -> $index
{
  say "swap $index: { @S[$index] } <-> { @S[$index + $O] } == { @S.join }"
    if $verbose;
  
  swap(@S[$index], @S[$index + $O]);
}

say @S.join;

sub swap ($a is rw, $b is rw)
{
  ($a, $b) = ($b, $a);
}

Running it gives the same result:

$ ./charswap-sans-mod 
pndraerlaku

$ ./charswap-sans-mod -S="This is not the end" -O=9 -C=7
Tt the enohis is nd

And finally, a version working on substrings:

File: charswap

#! /usr/bin/env raku

subset PosInt of Int where * >= 1;

unit sub MAIN (:$S is copy = 'perlandraku',
               PosInt :$O = 4,
	       PosInt :$C where $C < $O && $C + $O <= $S.chars = 3,
	       :$v, :$verbose = $v);

for 1 .. $C -> $index
{
  say "swap $index: { $S.substr($index, 1) } <-> \
     { $S.substr($index + $O, 1) } == $S" if $verbose;

  ($S.substr-rw($index,1), $S.substr-rw($index + $O,1) ) =  # [1]
  ($S.substr($index + $O, 1), $S.substr($index, 1));        # [1a]
}

say $S;

[1] The substr method (in [1a]) returns a copy, so we have to use substr-rw (in [1]) instead as we want to change the values.

See docs.raku.org/routine/substr and docs.raku.org/routine/substr-rw for more information about the substr and substr-rw.

The moral, such as it is, is that it is actually easier to work with substrings (than arrays). So my gut feeling didn't survive the reality check. Oh well.

A Perl Version

This is pretty much a straight forward translation from the Raku version:

File: charswap-perl

#! /usr/bin/env perl

use strict;
use feature 'say';

my $verbose = 0;

if (@ARGV && $ARGV[0] eq "--verbose")
{
  $verbose = 1;
  shift(@ARGV);
}

my $S = shift(@ARGV) // 'perlandraku';
my $N = length $S;
my $O = shift(@ARGV) // 4;
my $C = shift(@ARGV) // 3;

die '$O: Integer >= 1 only'  unless int $O == $O;
die '$C: Integer >= 1 only'  unless int $C == $C;
die '$C: Must be < $O'       unless $C < $O;
die '$C + $O: Must be <= $N' unless $C + $O <= $N;

for my $index (1 .. $C)
{
  say "swap $index: " . substr($S, $index, 1) . " <-> "
    . substr($S, $index + $O, 1) . " == $S" if $verbose;

  (substr($S, $index,1), substr($S, $index + $O,1) ) =
  (substr($S, $index + $O, 1), substr($S, $index, 1));
}

say $S;

Running it:

$ ./charswap-perl 
pndraerlaku

$ ./charswap-perl 'perlandraku' 5 4
perlandraku
pdraknerlau

A Node Version

It is impossible to change values of substrings in Node (JavaScript), but chopping it (the string) up into pieces that we glue together again in a rearranged order works:

File: charswap-node

#! /usr/bin/env node

var S = process.argv[2] || 'perlandraku';
var N = S.length;
var O = process.argv[3] || 4;
var C = process.argv[4] || 3;

let die = (message) => {
    console.log(message);
    process.kill(process.pid);
};

var OO = parseInt(O);                     # [1]

if (OO != O || O < 1)
    die('O: Integer >= 1 only');

var CC = parseInt(C);

if (CC != C || C < 1)
    die('C: Integer >= 1 only');

if (C >= O)
    die('C: Must be < O');

if (CC + OO > N)                          # [1a]
    die('C + O: Must be <= N');

for (index = 1; index <= CC; index++)     # [2]
{
    S = S.slice(0, index)                 # [3]
	+ S.charAt(index + OO)            # [4]
	+ S.slice(index +1, index + OO)
	+ S.charAt(index)
	+ S.slice(index + OO +1);
}

console.log(S);

[1] The input from the command line is taken as a string by default. That is mostly ok, except that the + operator (in [1a]) will happily do this «3 + 4 = 34», when used on strings. Hence the parseInt. This overloading of + is a design error, in my view.

[2] A C style for loop. How old fashion...

[3] A substring from the first index, upto the second (not including) if given, or to the end.

[4] A single character, at the given position.

Running it:

$ ./charswap-node 
pndraerlaku

$ ./charswap-node "This is not the end" 9 7
Tt the enohis is nd

Challenge #070.2: Gray Code Sequence

You are given an integer 2 <= $N <= 5.

Write a script to generate $N-bit gray code sequence.

2-bit Gray Code Sequence

[0, 1, 3, 2]

To generate the 3-bit Gray code sequence from the 2-bit Gray code sequence, follow the step below:

2-bit Gray Code sequence
[0, 1, 3, 2]

Binary form of the sequence
a) S1 = [00, 01, 11, 10]

Reverse of S1
b) S2 = [10, 11, 01, 00]

Prefix all entries of S1 with '0'
c) S1 = [000, 001, 011, 010]

Prefix all entries of S2 with '1'
d) S2 = [110, 111, 101, 100]

Concatenate S1 and S2 gives 3-bit Gray Code sequence
e) [000, 001, 011, 010, 110, 111, 101, 100]

3-bit Gray Code sequence
[0, 1, 3, 2, 6, 7, 5, 4]

Example

Input: $N = 4

Output: [0, 1, 3, 2, 6, 7, 5, 4, 12, 13, 15, 14, 10, 11, 9, 8]

Observation 1
We are given the 2-bit Gray Code sequence, Then we do the steps above, and end up with the 3-bit Gray Code sequence. If we want the 4-bit Gray Code sequence, we simply do the steps above once more (on the 3-bit Gray Code sequence). And so on. In a loop.

Observation 2
The binary form of the sequence (marked «a)» above have leading zeroes on some of the values, so that all the numbers have the same length. The length is 1 less than the sequence bit number.

The program should be easy to understand, especially if you map the verbose output to the steps in the challenge.

File: gray-code-seq

#! /usr/bin/env raku

unit sub MAIN (Int $N where 2 <= $N <=5 = 3,
   	       :$v, :$verbose = $v);

my @sequence = (0,1,3,2);

for 3 .. $N -> $level
{
  @sequence = generate2bgcs(@sequence, $level, $verbose);
}

say "[{ @sequence.join(", ") }]";

sub generate2bgcs (@in, $level, $verbose)
{
  my @S1a = @in.map({ .fmt('%0' ~ ($level-1)  ~ 'b')  });  # [1]
  my @S2a = @S1a.reverse;
  my @S1  = @S1a.map({ "0$_" });
  my @S2  = @S2a.map({ "1$_" });
  my @S3  = (@S1, @S2).flat;                               # [2]
  my @out = @S3.map( *.parse-base(2) );                    # [3]
  
  if $verbose
  {
    say ": a) S1 = [{ @S1a.join(", ")  }]";
    say ": b) S2 = [{ @S2a.join(", ")  }]";
    say ": c) S1 = [{ @S1.join(", ")   }]";
    say ": b) S2 = [{ @S2.join(", ")   }]";
    say ": e) S3 = [{ @S3.join(", ")   }]";
    say ": \$N=$level  = [{ @out.join(", ")   }]";
  }
  return @out;
}

[1] Using the fmt metod to convert the (decimal) number to binary (the «b» flag). We want it to have at least $level-1 characters, and we pad with zeroes from the start (e.g. 1.fmt('%03d') => 001).

[2] We want one array with all the elements, not an array with two elemens (the content of «@S1» and «@S2».)

[3] using parse-base(2) to interpret the value as a binary number, and converting it to a (decimal) number.

See docs.raku.org/routine/fmt for more information about fmt.

See docs.raku.org/routine/parse-base for more information about parse-base.

Running it:

$ ./gray-code-seq
[0, 1, 3, 2, 6, 7, 5, 4]

$ ./gray-code-seq 4
[0, 1, 3, 2, 6, 7, 5, 4, 12, 13, 15, 14, 10, 11, 9, 8]

$ ./gray-code-seq -v
: a) S1 = [00, 01, 11, 10]
: b) S2 = [10, 11, 01, 00]
: c) S1 = [000, 001, 011, 010]
: b) S2 = [110, 111, 101, 100]
: e) S3 = [000, 001, 011, 010, 110, 111, 101, 100]
: $N=3  = [0, 1, 3, 2, 6, 7, 5, 4]
[0, 1, 3, 2, 6, 7, 5, 4]

$ ./gray-code-seq 5
[0, 1, 3, 2, 6, 7, 5, 4, 12, 13, 15, 14, 10, 11, 9, 8, 24, 25, 27, 26, 30, \
  31, 29, 28, 20, 21, 23, 22, 18, 19, 17, 16]

$ ./gray-code-seq -v 4
: a) S1 = [00, 01, 11, 10]
: b) S2 = [10, 11, 01, 00]
: c) S1 = [000, 001, 011, 010]
: b) S2 = [110, 111, 101, 100]
: e) S3 = [000, 001, 011, 010, 110, 111, 101, 100]
: $N=3  = [0, 1, 3, 2, 6, 7, 5, 4]
: a) S1 = [000, 001, 011, 010, 110, 111, 101, 100]
: b) S2 = [100, 101, 111, 110, 010, 011, 001, 000]
: c) S1 = [0000, 0001, 0011, 0010, 0110, 0111, 0101, 0100]
: b) S2 = [1100, 1101, 1111, 1110, 1010, 1011, 1001, 1000]
: e) S3 = [0000, 0001, 0011, 0010, 0110, 0111, 0101, 0100, 1100, 1101, 1111, \
  1110, 1010, 1011, 1001, 1000]
: $N=4  = [0, 1, 3, 2, 6, 7, 5, 4, 12, 13, 15, 14, 10, 11, 9, 8]
[0, 1, 3, 2, 6, 7, 5, 4, 12, 13, 15, 14, 10, 11, 9, 8]

$ ./gray-code-seq -v 5
: a) S1 = [00, 01, 11, 10]
: b) S2 = [10, 11, 01, 00]
: c) S1 = [000, 001, 011, 010]
: b) S2 = [110, 111, 101, 100]
: e) S3 = [000, 001, 011, 010, 110, 111, 101, 100]
: $N=3  = [0, 1, 3, 2, 6, 7, 5, 4]
: a) S1 = [000, 001, 011, 010, 110, 111, 101, 100]
: b) S2 = [100, 101, 111, 110, 010, 011, 001, 000]
: c) S1 = [0000, 0001, 0011, 0010, 0110, 0111, 0101, 0100]
: b) S2 = [1100, 1101, 1111, 1110, 1010, 1011, 1001, 1000]
: e) S3 = [0000, 0001, 0011, 0010, 0110, 0111, 0101, 0100, 1100, 1101, 1111, \
  1110, 1010, 1011, 1001, 1000]
: $N=4  = [0, 1, 3, 2, 6, 7, 5, 4, 12, 13, 15, 14, 10, 11, 9, 8]
: a) S1 = [0000, 0001, 0011, 0010, 0110, 0111, 0101, 0100, 1100, 1101, 1111, \
  1110, 1010, 1011, 1001, 1000]
: b) S2 = [1000, 1001, 1011, 1010, 1110, 1111, 1101, 1100, 0100, 0101, 0111, \
  0110, 0010, 0011, 0001, 0000]
: c) S1 = [00000, 00001, 00011, 00010, 00110, 00111, 00101, 00100, 01100, \
  01101, 01111, 01110, 01010, 01011, 01001, 01000]
: b) S2 = [11000, 11001, 11011, 11010, 11110, 11111, 11101, 11100, 10100, \
  10101, 10111, 10110, 10010, 10011, 10001, 10000]
: e) S3 = [00000, 00001, 00011, 00010, 00110, 00111, 00101, 00100, 01100, \
  01101, 01111, 01110, 01010, 01011, 01001, 01000, 11000, 11001, 11011, \
  11010, 11110, 11111, 11101, 11100, 10100, 10101, 10111, 10110, 10010, \
  10011, 10001, 10000]
: $N=5  = [0, 1, 3, 2, 6, 7, 5, 4, 12, 13, 15, 14, 10, 11, 9, 8, 24, 25, 27, \
  26, 30, 31, 29, 28, 20, 21, 23, 22, 18, 19, 17, 16]
[0, 1, 3, 2, 6, 7, 5, 4, 12, 13, 15, 14, 10, 11, 9, 8, 24, 25, 27, 26, 30, \
  31, 29, 28, 20, 21, 23, 22, 18, 19, 17, 16]

A Perl Version

This is pretty much a straight forward translation from the Raku version:

File: gray-code-seq-perl

#! /usr/bin/env perl

use strict;
use feature 'say';
use feature 'signatures';
no warnings 'experimental::signatures';

my $verbose = 0;

if (@ARGV && $ARGV[0] eq "--verbose")
{
  $verbose = 1;
  shift(@ARGV);
}

my $N = shift(@ARGV) // 3;

die '$N out of range (2..5)' unless 2 <= $N && $N <=5;

my @sequence = (0,1,3,2);

for my $level (3 .. $N)
{
  @sequence = generate2bgcs($level, $verbose, @sequence);
}

say "[" . join(", ", @sequence) . "]";

sub generate2bgcs ($level, $verbose, @in)
{
  my @S1a = map { sprintf('%0' . ($level-1)  . 'b', $_) } @in;
  my @S2a = reverse @S1a;
  my @S1  = map { "0$_" } @S1a;
  my @S2  = map { "1$_" } @S2a;
  my @S3  = (@S1, @S2); 
  my @out = map { oct("0b$_") } @S3;
  
  if ($verbose)
  {
    say ": a) S1 = [" . join(", ", @S1a) ."]";
    say ": b) S2 = [" . join(", ", @S2a) ."]";
    say ": c) S1 = [" . join(", ", @S1)  ."]";
    say ": b) S2 = [" . join(", ", @S2)  ."]";
    say ": e) S3 = [" . join(", ", @S3)  ."]";
    say ": \$N=$level  = [" . join(", ", @out) . "]";
  }
  return @out;
}

Running it gives the same output.

Except that it is more forgiving. Specifying a decimal number works here, but not in the Raku version:

$ ./gray-code-seq-perl 2.99
[0, 1, 3, 2]

$ ./gray-code-seq-perl 3.14
[0, 1, 3, 2, 6, 7, 5, 4]

$ ./gray-code-seq 3.14
Usage:
  ./gray-code-seq [-v=<Any>] [--verbose=<Any>] [<N>]

A Node Version

A Node version of this one as well:

File: gray-code-seq-node

#! /usr/bin/env node

var N = process.argv[2] || 3;

var verbose = false;

if (N == '--verbose') 
{
  verbose = true;
  N = process.argv[3] || 3;
}

let die = (message) => {
    console.log(message);
    process.kill(process.pid);
};

var NN = parseInt(N);

if (NN != N || NN < 2 || NN > 5)
    die('N: Integer 2,3,4,5 only');

var sequence = [0,1,3,2];

let asBinary = (value, length) => {
  var binary =  value.toString(2);

  while (binary.length < length)
    binary = "0" + binary;

  return binary;
}

let generate2bgcs = (array, level) => {
  var S1a = array.map(x => asBinary(x,level-1) );
  var S2a = S1a.slice(); S2a.reverse();
  var S1  = S1a.map(x => '0' + x);
  var S2  = S2a.map(x => '1' + x);
  var S3  = S1; for (x of S2) { S3.push(x); }
  var out = S3.map( x => parseInt(x, 2) );
  
  if (verbose)
  {
    console.log(': in: ' + array);
    console.log(': a) S1 = ' + S1a);
    console.log(': b) S2 = ' + S2a);
    console.log(': c) S1 = ' + S1);
    console.log(': d) S2 = ' + S2);
    console.log(': e) S3 = ' + S3);
    console.log(': out: ' + out);
  }

  return out;
}

for (level = 3; level <= NN; level++)
{
  sequence = generate2bgcs(sequence, level);
}

Note that map (in Node and JS) returns a new array with the changes applied (and leaves the original array unchanged), but reverse changes the array itself. Another design error?

Running it:

$ ./gray-code-seq-node 2.99
N: Integer 2,3,4,5 only
Terminated

$ ./gray-code-seq-node 3
[ 0, 1, 3, 2, 6, 7, 5, 4 ]

$ ./gray-code-seq-node 4
[ 0, 1, 3, 2, 6, 7, 5, 4, 12, 13, 15, 14, 10, 11, 9, 8 ]

$ ./gray-code-seq-node --verbose 3
: in: 0,1,3,2
: a) S1 = 00,01,11,10
: b) S2 = 10,11,01,00
: c) S1 = 000,001,011,010,110,111,101,100
: d) S2 = 110,111,101,100
: e) S3 = 000,001,011,010,110,111,101,100
: out: 0,1,3,2,6,7,5,4
[ 0, 1, 3, 2, 6, 7, 5, 4 ]

$ ./gray-code-seq-node --verbose 4
: in: 0,1,3,2
: a) S1 = 00,01,11,10
: b) S2 = 10,11,01,00
: c) S1 = 000,001,011,010,110,111,101,100
: d) S2 = 110,111,101,100
: e) S3 = 000,001,011,010,110,111,101,100
: out: 0,1,3,2,6,7,5,4
: in: 0,1,3,2,6,7,5,4
: a) S1 = 000,001,011,010,110,111,101,100
: b) S2 = 100,101,111,110,010,011,001,000
: c) S1 = 0000,0001,0011,0010,0110,0111,0101,0100,1100,1101,1111,1110,\
  1010,1011,1001,1000
: d) S2 = 1100,1101,1111,1110,1010,1011,1001,1000
: e) S3 = 0000,0001,0011,0010,0110,0111,0101,0100,1100,1101,1111,1110,\
  1010,1011,1001,1000
: out: 0,1,3,2,6,7,5,4,12,13,15,14,10,11,9,8
[ 0, 1, 3, 2, 6, 7, 5, 4, 12, 13, 15, 14, 10, 11, 9, 8 ]

Note the extra space after the opening bracket, and before the closing one. So this is not strictly answering the challenge. Oh well.

And that's it.

Links

About me
Keyword Index
Raku Courses
Beginning Raku (book)
RSS Feed
Code (zip)
Reddit Comments