Straddling checkerboard: Difference between revisions
Content added Content deleted
SqrtNegInf (talk | contribs) m (→{{header|Perl 6}}: tweak: rows of 'table' can be flattened) |
SqrtNegInf (talk | contribs) (Added Perl example) |
||
Line 1,480: | Line 1,480: | ||
ONENIGHTITWASONTHETWENTIETHOFMARCH1888IWASRETURNING |
ONENIGHTITWASONTHETWENTIETHOFMARCH1888IWASRETURNING |
||
</pre> |
</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}}== |
=={{header|Perl 6}}== |