Playfair cipher: Difference between revisions
Rename Perl 6 -> Raku, alphabetize, minor clean-up
m (→{{header|REXX}}: split some compound statements, added/changed whitespace and comments, ordered functions by name, used a template for the output sections.) |
Thundergnat (talk | contribs) (Rename Perl 6 -> Raku, alphabetize, minor clean-up) |
||
Line 1,100:
}
}</lang>
=={{header|Julia}}==
Line 1,729 ⟶ 1,728:
decoded text: TO BE OR NO TT OB EE Q
TOBEORNOTTOBEE
original text: TOBEORNOTTOBEE</pre>
=={{header|Perl}}==
Line 1,810 ⟶ 1,809:
red: HI DE TH EG OL DI NT HE TR EX ES TU MP
</pre>
=={{header|Phix}}==
Line 2,080 ⟶ 2,009:
Encoded: BM OD ZB XD NA BE KU DM UI XM MO UV IF
Decoded: HI DE TH EG OL DI NT HE TR EX ES TU MP</pre>
=={{header|Raku}}==
(formerly Perl 6)
{{Works with|rakudo|2016.07}}
<lang perl6># Instantiate a specific encoder/decoder.
sub playfair( $key,
$from = 'J',
$to = $from eq 'J' ?? 'I' !! ''
) {
sub canon($str) { $str.subst(/<-alpha>/,'', :g).uc.subst(/$from/,$to,:g) }
# Build 5x5 matrix.
my @m = canon($key ~ ('A'..'Z').join).comb.unique.map:
-> $a,$b,$c,$d,$e { [$a,$b,$c,$d,$e] }
# Pregenerate all forward translations.
my %ENC = gather {
# Map pairs in same row.
for @m -> @r {
for ^@r X ^@r -> (\i,\j) {
next if i == j;
take @r[i] ~ @r[j] => @r[(i+1)%5] ~ @r[(j+1)%5];
}
}
# Map pairs in same column.
for ^5 -> $c {
my @c = @m.map: *.[$c];
for ^@c X ^@c -> (\i,\j) {
next if i == j;
take @c[i] ~ @c[j] => @c[(i+1)%5] ~ @c[(j+1)%5];
}
}
# Map pairs with cross-connections.
for ^5 X ^5 X ^5 X ^5 -> (\i1,\j1,\i2,\j2) {
next if i1 == i2 or j1 == j2;
take @m[i1][j1] ~ @m[i2][j2] => @m[i1][j2] ~ @m[i2][j1];
}
}
# Generate reverse translations.
my %DEC = %ENC.invert;
return
anon sub enc($red) {
my @list = canon($red).comb(/(.) (.?) <?{ $1 ne $0 }>/);
~@list.map: { .chars == 1 ?? %ENC{$_~'X'} !! %ENC{$_} }
},
anon sub dec($black) {
my @list = canon($black).comb(/../);
~@list.map: { %DEC{$_} }
}
}
my (&encode,&decode) = playfair 'Playfair example';
my $orig = "Hide the gold in...the TREESTUMP!!!";
say " orig:\t$orig";
my $black = encode $orig;
say "black:\t$black";
my $red = decode $black;
say " red:\t$red";</lang>
{{out}}
<pre> orig: Hide the gold in...the TREESTUMP!!!
black: BM OD ZB XD NA BE KU DM UI XM MO UV IF
red: HI DE TH EG OL DI NT HE TR EX ES TU MP</pre>
=={{header|REXX}}==
| |||