Straddling checkerboard: Difference between revisions
Added Perl example
SqrtNegInf (talk | contribs) m (→{{header|Perl 6}}: tweak: rows of 'table' can be flattened) |
SqrtNegInf (talk | contribs) (Added Perl example) |
||
Line 1,480:
ONENIGHTITWASONTHETWENTIETHOFMARCH1888IWASRETURNING
</pre>
=={{header|Perl}}==
{{trans|Perl 6}}
<lang perl>use strict;
use warnings;
use feature 'say';
use List::Util <min max>;
my(%trans,@table);
sub build {
my($u,$v,$alphabet) = @_;
my(@flat_board,%p2c,%c2p)
my $numeric_escape = '/';
@flat_board = split '', uc $alphabet;
splice @flat_board, min($u,$v), 0, undef;
splice @flat_board, max($u,$v), 0, undef;
push @table, [' ', 0..9];
push @table, [' ', map { defined $_ ? $_ : ' '} @flat_board[ 0 .. 9] ];
push @table, [$u, @flat_board[10 .. 19]];
push @table, [$v, @flat_board[20 .. 29]];
my @nums = my @order = 0..9;
push @nums, (map { +"$u$_" } @order), map { +"$v$_" } @order;
@c2p{@nums} = @flat_board;
for (keys %c2p) { delete $c2p{$_} unless defined $c2p{$_} }
@p2c{values %c2p} = keys %c2p;
$p2c{$_} = $p2c{$numeric_escape} . $_ for 0..9;
while ( my ($k, $v) = each %p2c) {
$trans{encode}{$k} .= $v;
$trans{decode}{$v} .= $k unless $k eq $numeric_escape;
}
}
sub decode {
my($string) = @_;
my $keys = join '|', keys %{$trans{decode}};
$string =~ s/($keys)/$trans{decode}{$1}/gr;
}
sub encode {
my($string) = uc shift;
$string =~ s#(.)#$trans{encode}{$1} // $trans{encode}{'.'}#ger;
}
my $sc = build(3, 7, 'HOLMESRTABCDFGIJKNPQUVWXYZ./');
say join ' ', @$_ for @table;
say '';
say 'Original: ', my $original = 'One night-it was on the twentieth of March, 1888-I was returning';
say 'Encoded: ', my $en = encode($original);
say 'Decoded: ', decode($en);</lang>
{{out}}
<pre> 0 1 2 3 4 5 6 7 8 9
H O L M E S R T
3 A B C D F G I J K N
7 P Q U V W X Y Z . /
Original: One night-it was on the twentieth of March, 1888-I was returning
Encoded: 13957839363509783697874306781397890578974539936590781347843083207878791798798798783678743067885972839363935
Decoded: ONE.NIGHT.IT.WAS.ON.THE.TWENTIETH.OF.MARCH..1888.I.WAS.RETURNING</pre>
=={{header|Perl 6}}==
| |||