Playfair cipher: Difference between revisions
Walterpachl (talk | contribs) (added ooRexx) |
Walterpachl (talk | contribs) m (moved ooRexx) |
||
Line 138:
HI DE TH EG OL DI NT HE TR EX ES TU MP
</pre>
=={{header|D}}==
{{trans|Python}}
<lang d>import std.stdio, std.array, std.algorithm, std.range, std.ascii,
std.conv, std.string, std.regex;
string unique(in string s) pure /*nothrow*/ {
string result;
foreach (immutable char c; s)
if (!result.canFind(c))
result ~= c;
return result;
}
struct Playfair {
string from, to;
string[string] enc, dec;
this(in string key, in string from_ = "J", in string to_ = null) {
this.from = from_;
if (to_.empty)
this.to = (from_ == "J") ? "I" : "";
auto m = _canonicalize(key ~ uppercase)
.unique
.chunks(5)
.map!text
.array;
auto I5 = 5.iota;
foreach (const R; m)
foreach (immutable i, immutable j; cartesianProduct(I5, I5))
if (i != j)
enc[[R[i], R[j]]] = [R[(i + 1) % 5], R[(j+1) % 5]];
foreach (immutable r; I5) {
const c = m.transversal(r).array;
foreach (immutable i, immutable j; cartesianProduct(I5, I5))
if (i != j)
enc[[c[i], c[j]]] = [c[(i + 1) % 5], c[(j+1) % 5]];
}
foreach (i1, j1, i2, j2; cartesianProduct(I5, I5, I5, I5))
if (i1 != i2 && j1 != j2)
enc[[m[i1][j1], m[i2][j2]]] = [m[i1][j2], m[i2][j1]];
dec = enc.byValue.zip(enc.byKey).assocArray;
}
private string _canonicalize(in string s) const /*pure*/ {
return s.toUpper.removechars("^A-Z").replace(from, to);
}
string encode(in string s) const {
return _canonicalize(s)
.matchAll(r"(.)(?:(?!\1)(.))?".regex)
//.map!(m => enc[m[0].leftJustify(2, 'X')])
.map!(m => cast()enc[m[0].leftJustify(2, 'X')])
.join(" ");
}
string decode(in string s) const /*pure*/ {
return _canonicalize(s)
.chunks(2)
//.map!dec
.map!(p => cast()dec[p.text])
.join(" ");
}
}
void main() {
const pf = Playfair("Playfair example");
immutable orig = "Hide the gold in...the TREESTUMP!!!";
writeln("Original: ", orig);
immutable enc = pf.encode(orig);
writeln(" Encoded: ", enc);
writeln(" Decoded: ", pf.decode(enc));
}</lang>
{{out}}
<pre>Original: Hide the gold in...the TREESTUMP!!!
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|ooRexx}}==
Line 357 ⟶ 439:
TOBEORNOTTOBEE
original text: TOBEORNOTTOBEE</pre>
=={{header|Perl 6}}==
|
Revision as of 10:37, 12 November 2013
Implement a Playfair cipher encryption and decryption.
The user must be able to choose J = I or no Q in the alphabet. The output of the encrypted and decrypted message must be in capitalized digraphs, separated by spaces.
Output example: HI DE TH EG OL DI NT HE TR EX ES TU MP.
C++
<lang cpp>#include <iostream>
- include <string>
using namespace std;
class playfair { public:
void doIt( string k, string t, bool ij, bool e ) {
createGrid( k, ij ); getTextReady( t, ij, e ); if( e ) doIt( 1 ); else doIt( -1 ); display();
}
private:
void doIt( int dir ) {
int a, b, c, d; string ntxt; for( string::const_iterator ti = _txt.begin(); ti != _txt.end(); ti++ ) { if( getCharPos( *ti++, a, b ) ) if( getCharPos( *ti, c, d ) ) { if( a == c ) { ntxt += getChar( a, b + dir ); ntxt += getChar( c, d + dir ); } else if( b == d ){ ntxt += getChar( a + dir, b ); ntxt += getChar( c + dir, d ); } else { ntxt += getChar( c, b ); ntxt += getChar( a, d ); } } } _txt = ntxt;
}
void display() {
cout << "\n\n OUTPUT:\n=========" << endl; string::iterator si = _txt.begin(); int cnt = 0; while( si != _txt.end() ) { cout << *si; si++; cout << *si << " "; si++; if( ++cnt >= 26 ) cout << endl, cnt = 0; } cout << endl << endl;
}
char getChar( int a, int b ) {
return _m[ (b + 5) % 5 ][ (a + 5) % 5 ];
}
bool getCharPos( char l, int &a, int &b ) {
for( int y = 0; y < 5; y++ ) for( int x = 0; x < 5; x++ ) if( _m[y][x] == l ) { a = x; b = y; return true; }
return false;
}
void getTextReady( string t, bool ij, bool e ) {
for( string::iterator si = t.begin(); si != t.end(); si++ ) { *si = toupper( *si ); if( *si < 65 || *si > 90 ) continue; if( *si == 'J' && ij ) *si = 'I'; else if( *si == 'Q' && !ij ) continue; _txt += *si; } if( e ) { string ntxt = ""; size_t len = _txt.length(); for( size_t x = 0; x < len; x += 2 ) { ntxt += _txt[x]; if( x + 1 < len ) { if( _txt[x] == _txt[x + 1] ) ntxt += 'X'; ntxt += _txt[x + 1]; } } _txt = ntxt; } if( _txt.length() & 1 ) _txt += 'X';
}
void createGrid( string k, bool ij ) {
if( k.length() < 1 ) k = "KEYWORD"; k += "ABCDEFGHIJKLMNOPQRSTUVWXYZ"; string nk = ""; for( string::iterator si = k.begin(); si != k.end(); si++ ) { *si = toupper( *si ); if( *si < 65 || *si > 90 ) continue; if( ( *si == 'J' && ij ) || ( *si == 'Q' && !ij ) )continue; if( nk.find( *si ) == -1 ) nk += *si; } copy( nk.begin(), nk.end(), &_m[0][0] );
}
string _txt; char _m[5][5];
};
int main( int argc, char* argv[] ) {
string key, i, txt; bool ij, e; cout << "(E)ncode or (D)ecode? "; getline( cin, i ); e = ( i[0] == 'e' || i[0] == 'E' ); cout << "Enter a en/decryption key: "; getline( cin, key ); cout << "I <-> J (Y/N): "; getline( cin, i ); ij = ( i[0] == 'y' || i[0] == 'Y' ); cout << "Enter the text: "; getline( cin, txt ); playfair pf; pf.doIt( key, txt, ij, e ); return system( "pause" );
}</lang>
- Output:
(E)ncode or (D)ecode? e Enter a en/decryption key: playfair example I <-> J (Y/N): y Enter the text: Hide the gold in the tree stump
OUTPUT: ========= BM OD ZB XD NA BE KU DM UI XM MO UV IF
(E)ncode or (D)ecode? d Enter a en/decryption key: playfair example I <-> J (Y/N): y Enter the text: BMODZBXDNABEKUDMUIXMMOUVIFOUTPUT: ========= HI DE TH EG OL DI NT HE TR EX ES TU MP
D
<lang d>import std.stdio, std.array, std.algorithm, std.range, std.ascii,
std.conv, std.string, std.regex;
string unique(in string s) pure /*nothrow*/ {
string result; foreach (immutable char c; s) if (!result.canFind(c)) result ~= c; return result;
}
struct Playfair {
string from, to; string[string] enc, dec;
this(in string key, in string from_ = "J", in string to_ = null) { this.from = from_; if (to_.empty) this.to = (from_ == "J") ? "I" : "";
auto m = _canonicalize(key ~ uppercase) .unique .chunks(5) .map!text .array; auto I5 = 5.iota;
foreach (const R; m) foreach (immutable i, immutable j; cartesianProduct(I5, I5)) if (i != j) enc[[R[i], R[j]]] = [R[(i + 1) % 5], R[(j+1) % 5]];
foreach (immutable r; I5) { const c = m.transversal(r).array; foreach (immutable i, immutable j; cartesianProduct(I5, I5)) if (i != j) enc[[c[i], c[j]]] = [c[(i + 1) % 5], c[(j+1) % 5]]; }
foreach (i1, j1, i2, j2; cartesianProduct(I5, I5, I5, I5)) if (i1 != i2 && j1 != j2) enc[[m[i1][j1], m[i2][j2]]] = [m[i1][j2], m[i2][j1]];
dec = enc.byValue.zip(enc.byKey).assocArray; }
private string _canonicalize(in string s) const /*pure*/ { return s.toUpper.removechars("^A-Z").replace(from, to); }
string encode(in string s) const { return _canonicalize(s) .matchAll(r"(.)(?:(?!\1)(.))?".regex) //.map!(m => enc[m[0].leftJustify(2, 'X')]) .map!(m => cast()enc[m[0].leftJustify(2, 'X')]) .join(" "); }
string decode(in string s) const /*pure*/ { return _canonicalize(s) .chunks(2) //.map!dec .map!(p => cast()dec[p.text]) .join(" "); }
}
void main() {
const pf = Playfair("Playfair example"); immutable orig = "Hide the gold in...the TREESTUMP!!!"; writeln("Original: ", orig); immutable enc = pf.encode(orig); writeln(" Encoded: ", enc); writeln(" Decoded: ", pf.decode(enc));
}</lang>
- Output:
Original: Hide the gold in...the TREESTUMP!!! 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
ooRexx
<lang oorexx>/*---------------------------------------------------------------------
- REXX program implements a PLAYFAIR cipher (encryption & decryption).
- 11.11.2013 Walter Pachl revamped, for ooRexx, the REXX program
- the logic of which was devised by Gerard Schildberger
- Invoke as rexx pf O abcd efgh ( phrase to be processed
- Defaults: 'Playfair example.'
- J
- 'Hide the gold in the tree stump'
- Major changes: avoid language elements not allowed in ooRexx
- show use of a.[expr1,expr2]
- allow key to be more than one word
- add restriction of using X or Q in text
- 12.11.2013 change order of arguments
- and comment the use of a.[expr1,expr2]
- Program should run on all Rexxes that have changestr-bif
- --------------------------------------------------------------------*/
Parse Upper Version v oorexx=pos('OOREXX',v)>0
Parse Arg omit oldk '(' text If omit= Then omit='J' If oldk= Then oldk='Playfair example.' If text= Then text='Hide the gold in the tree stump!!'
newkey=scrub(oldk,1) newtext=scrub(text) If newtext== Then Call err 'TEXT is empty or has no letters' If length(omit)\==1 Then Call err 'OMIT letter must be only one letter' If\datatype(omit,'M') Then Call err 'OMIT letter must be a Latin alphabet letter.' omit=translate(omit) cant='must not contain the "OMIT" character: ' omit If pos(omit,newtext)\==0 Then Call err 'TEXT' cant If pos(omit,newkey)\==0 Then Call err 'cipher key' cant abc='abcdefghijklmnopqrstuvwxyz' abcu=translate(abc) /* uppercase alphabet */ abcx=space(translate(abcu,,omit),0) /*elide OMIT char from alphabet */ xx='X' /* char used for double characters*/ If omit==xx Then xx='Q' If pos(xx,newtext)>0 Then Call err 'Sorry,' xx 'is not allowed in text' If length(newkey)<3 Then Call err 'cipher key is too short, must be at least 3 different letters' abcx=space(translate(abcx,,newkey),0) /*remove any cipher characters */ grid=newkey||abcx /* only first 25 chars are used*/ Say 'old cipher key: ' strip(oldk) padl=14+2 pad=left(,padl) Say 'new cipher key: ' newkey padx=left(,padl,"-")'Playfair' Say ' omit char: ' omit /* [?] lowercase of double char. */ Say ' double char: ' xx lxx=translate(xx,abc,abcu) Say ' original text: ' strip(text)/* [?] doubled version of Lxx. */ Call show 'cleansed',newtext lxxlxx=lxx||lxx n=0 /* number of grid characters used.*/ Do row=1 For 5 /* build array of individual cells*/ Do col=1 For 5 n=n+1 a.row.col=substr(grid,n,1) If row==1 Then a.0.col=a.1.col If col==5 Then Do a.row.6=a.row.1 a.row.0=a.row.5 End If row==5 Then Do a.6.col=a.1.col a.0.col=a.5.col End End End
etext=playfair(newtext,1) Call show 'encrypted',etext ptext=playfair(etext,-1) Call show 'plain',ptext qtext=changestr(xx||xx,ptext,lxx) /*change doubled doublechar-?sing*/ qtext=changestr(lxx||xx,qtext,lxxlxx) /*change Xx --? lowercase dblChar*/ qtext=space(translate(qtext,,xx),0) /*remove char used for "doubles."*/ qtext=translate(qtext) /*reinstate the use of upperchars*/ Call show 'decoded',qtext Say ' original text: ' newtext /* ·· and show the original text.*/ Say Exit
playfair: /*---------------------------------------------------------------------
- encode (e=1) or decode (e=-1) the given text (t) using the grid
- --------------------------------------------------------------------*/
Arg t,e d= If e=1 Then Do Do k=1 By 1 Until c= c=substr(t,k,1) If substr(t,k+1,1)==c Then t=left(t,k)||lxx||substr(t,k+1) End End t=translate(t) Do j=1 By 2 To length(t) c2=strip(substr(t,j,2)) If length(c2)==1 Then c2=c2||xx /* append X or Q char, rule 1*/ Call LR Select /*- This could/should be used on ooRexx ------------------------- When rowl==rowr Then c2=a.[rowl,coll+e]a.[rowr,colr+e] /*rule 2*/ When coll==colr Then c2=a.[rowl+e,coll]a.[rowr+e,colr] /*rule 3*/ *--------------------------------------------------------------*/ When rowl==rowr Then c2=aa(rowl,coll+e)aa(rowr,colr+e) /*rule 2*/ When coll==colr Then c2=aa(rowl+e,coll)aa(rowr+e,colr) /*rule 3*/ Otherwise c2=a.rowl.colr||a.rowr.coll /*rule 4*/ End d=d||c2 End Return d
aa: /*---------------------------------------------------------------------
- ooRexx allows to use a.[rowl,coll+e]
- this function can be removed when ooRexx syntax is used to access a.
- --------------------------------------------------------------------*/
Parse Arg xrow,xcol Return a.xrow.xcol
err: /*---------------------------------------------------------------------
- Exit with an error message
- --------------------------------------------------------------------*/
Say Say '***error!***' arg(1) Say Exit 13
lr: /*---------------------------------------------------------------------
- get grid positions of the 2 characters
- --------------------------------------------------------------------*/
Parse Value rowcol(left(c2,1)) with rowl coll Parse Value rowcol(right(c2,1)) with rowr colr Return
rowcol: procedure Expose grid /*---------------------------------------------------------------------
- compute row and column of the given character in the 5x5 grid
- --------------------------------------------------------------------*/
Parse Arg c p=pos(c,grid) col=(p-1)//5+1 row=(4+p)%5 Return row col
show: /*---------------------------------------------------------------------
- Show heading and text
- --------------------------------------------------------------------*/
Arg,y Say Say right(arg(1) 'text: ',padl) digram(arg(2)) result=space(arg(2),0) If arg(1)='decoded' Then Do result=strip(result,'T',xx) End Say pad result Return
scrub: Procedure /*---------------------------------------------------------------------
- Remove all non-letters from the given string, uppercase letters
- and, if unique=1 remove duplicates
- 'aB + c1Bb' -> 'ABCBB' or 'ABC', respectively
- --------------------------------------------------------------------*/
Arg xxx,unique /* ARG caps all args */ d= used.=0 Do While xxx<> Parse Var xxx c +1 xxx If datatype(c,'U') Then If (unique=1 & pos(c,d)=0) |, unique<>1 Then d=d||c End Return d
digram: Procedure /*---------------------------------------------------------------------
- Return the given string as character pairs separated by blanks
- 'ABCDEF' -> 'AB CD EF'
- 'ABCDE' -> 'AB CD E'
- --------------------------------------------------------------------*/
Parse Arg x d= Do j=1 By 2 To length(x) d=d||substr(x,j,2)' ' End Return strip(d)</lang>
Output (sample):
old cipher key: this is my little key new cipher key: THISMYLEK omit char: X double char: Q original text: to be or not to bee cleansed text: TO BE OR NO TT OB EE TOBEORNOTTOBEE encrypted text: IJ DY JV OP MJ IJ DY OA JJ IJDYJVOPMJIJDYOAJJ plain text: TO BE OR NO TQ TO BE QE QQ TOBEORNOTQTOBEQEQQ decoded text: TO BE OR NO TT OB EE Q TOBEORNOTTOBEE original text: TOBEORNOTTOBEE
Perl 6
<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.uniq.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>
- Output:
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
Python
<lang python>from string import ascii_uppercase from itertools import product from re import findall
def uniq(seq):
seen = {} return [seen.setdefault(x, x) for x in seq if x not in seen]
def partition(seq, n):
return [seq[i : i + n] for i in xrange(0, len(seq), n)]
"""Instantiate a specific encoder/decoder."""
def playfair(key, from_ = 'J', to = None):
if to is None: to = 'I' if from_ == 'J' else
def canonicalize(s): return filter(str.isupper, s.upper()).replace(from_, to)
# Build 5x5 matrix. m = partition(uniq(canonicalize(key + ascii_uppercase)), 5)
# Pregenerate all forward translations. enc = {}
# Map pairs in same row. for row in m: for i, j in product(xrange(5), repeat=2): if i != j: enc[row[i] + row[j]] = row[(i + 1) % 5] + row[(j + 1) % 5]
# Map pairs in same column. for c in zip(*m): for i, j in product(xrange(5), repeat=2): if i != j: enc[c[i] + c[j]] = c[(i + 1) % 5] + c[(j + 1) % 5]
# Map pairs with cross-connections. for i1, j1, i2, j2 in product(xrange(5), repeat=4): if i1 != i2 and j1 != j2: enc[m[i1][j1] + m[i2][j2]] = m[i1][j2] + m[i2][j1]
# Generate reverse translations. dec = dict((v, k) for k, v in enc.iteritems())
def sub_enc(txt): lst = findall(r"(.)(?:(?!\1)(.))?", canonicalize(txt)) return " ".join(enc[a + (b if b else 'X')] for a, b in lst)
def sub_dec(encoded): return " ".join(dec[p] for p in partition(canonicalize(encoded), 2))
return sub_enc, sub_dec
(encode, decode) = playfair("Playfair example")
orig = "Hide the gold in...the TREESTUMP!!!"
print "Original:", orig
enc = encode(orig)
print "Encoded:", enc
print "Decoded:", decode(enc)</lang>
- Output:
Original: Hide the gold in...the TREESTUMP!!! 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
REXX
Quite a bit of the REXX code deals with error checking, accepting arguments, and displaying the options used, and displaying input and output.
For ease of viewing and comparing, the output is in capitalized digraphs (which are really digrams) as well as the original input(s).
Thanks to Walter Pachl, this program is now sensitive of using a suitable double character when X is present in the cipher key.
Also, more thanks are due to Walter Pachl for finding that the cipher key can't contain the OMIT character.
A fair amount of code was added to massage the decrypted encryption to remove doubled Xes so as to match the original text
(this is the possible text part of the REXX code).
<lang rexx>/*REXX program implements a PLAYFAIR cipher (encryption & decryption).*/
@abc='abcdefghijklmnopqrstuvwxyz'; @abcU=@abc /*lower and upper ABC's.*/
parse arg omit key '(' text /*TEXT is the phrase to be used. */ ;oldK=key /*save old.*/
if key == | key ==',' then do; key='Playfair example.'; oldK=key " ◄───using the default."; end
if omit== | omit==',' then omit='J' /*the "omitted" character. */
if text= then text='Hide the gold in the tree stump!!' /*default.*/
newKey =scrub(key , 1) /*scrub old cipher key──► newKey */
newText=scrub(text ) /* " " text ──► newText*/
if newText== then call err 'TEXT is empty or has no letters'
if length(omit)\==1 then call err 'OMIT letter must be only one letter'
if \datatype(omit,'M') then call err 'OMIT letter must be a Latin alphabet letter.'
upper omit @abcU /*uppercase OMIT char & alphabet.*/
cant='cant contain the "OMIT" character: ' omit
if pos(omit,newText)\==0 then call err 'TEXT' cant if pos(omit,newKey) \==0 then call err 'cipher key' cant fill=space(translate(@abcU,, omit), 0) /*elide OMIT char from alphabet. */ xx='X'; if omit==xx then xx='Q' /*char used for double characters*/ if length(newKey)<3 then call err 'cipher key is too short, must be ≥3 unique characters.' fill=space(translate(fill,,newKey),0) /*remove any cipher characters. */ grid=newKey || fill /*only first 25 chars are used.*/ say 'old cipher key: ' strip(oldK) ; padL=14+2; pad=left(,padL) say 'new cipher key: ' newKey ; padX=left(,padL,"═")'Playfair' say ' omit char: ' omit /* [↓] lowercase of double char.*/ say ' double char: ' xx ; Lxx=translate(xx, @abc, @abcU) say ' original text: ' strip(text) /* [↓] doubled version of Lxx. */ call show 'cleansed', newText ; LxxLxx=Lxx || Lxx
- =0 /*number of grid characters used.*/
do row =1 for 5 /*build array of individual cells*/ do col=1 for 5; #=#+1; @.row.col=substr(grid,#,1) if row==1 then @.0.col=@.1.col if col==5 then do; @.row.6=@.row.1; @.row.0=@.row.5; end if row==5 then do; @.6.col=@.1.col; @.0.col=@.5.col; end end /*col*/ end /*row*/
eText=.Playfair(newText, 1); call show 'encrypted' , eText pText=.Playfair(eText ); call show 'plain' , pText qText=changestr(xx ||xx,pText,Lxx) /*change doubled doublechar─►sing*/ qText=changestr(Lxx||xx,qText,LxxLxx) /*change Xx ──► lowercase dblChar*/ qText=space(translate(qText,,xx),0) /*remove char used for "doubles."*/ upper qText /*reinstate the use of upperchars*/ if length(qText)\==length(pText) then call show 'possible', qText say ' original text: ' newText; say /*··· and show the original text.*/ if qtext==newText then say padx 'encryption──► decryption──► encryption worked.' exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────one─line subroutines───────────────────────────────*/ @@: parse arg Xrow,Xcol; return @.Xrow.Xcol err: say; say '***error!***' arg(1); say; exit 13 LR: rowL=row(left(__,1)); colL=_; rowR=row(right(__,1)); colR=_; return length(__) row: ?=pos(arg(1),grid); _=(?-1)//5+1; return (4+?)%5 show: arg ,y; say; say right(arg(1) 'text: ',padL) digram(y); say pad space(y,0); return /*──────────────────────────────────SCRUB subroutine────────────────────*/ scrub: procedure; arg xxx,unique; xxx=space(xxx,0) /*ARG caps all args*/ $=; do j=1 for length(xxx); _=substr(xxx,j,1)
if unique==1 then if pos(_,$)\==0 then iterate /*unique?*/ if datatype(_,'M') then $=$||_ /*only use Latin letters. */ end /*j*/
return $ /*──────────────────────────────────DIGRAM subroutine───────────────────*/ digram: procedure; parse arg x; $=; do j=1 by 2 to length(x)
$=$ || substr(x,j,2)' ' end /*j*/
return strip($) /*──────────────────────────────────.PLAYFAIR subroutine────────────────*/ .Playfair: arg T,encrypt; i=-1; if encrypt==1 then i=1; $=
do k=1 while i==1; _=substr(T,k,1); if _==' ' then leave if _==substr(T,k+1 ,1) then T=left(T,k) || Lxx || substr(T,k+1) end /*k*/
upper T
do j=1 by 2 to length(T); __=strip(substr(T,j,2)) if LR()==1 then __=__ || xx; call LR /*append X or Q char, rule 1*/ select when rowL==rowR then __=@@(rowL, colL+i)@@(rowR, colR+i) /*rule 2*/ when colL==colR then __=@@(rowL+i,colL )@@(rowR+i,colR) /*rule 3*/ otherwise __=@@(rowL, colR )@@(rowR, colL) /*rule 4*/ end /*select*/ $=$ || __ end /*j*/
return $</lang>
Some older REXXes don't have a changestr bif, so one is included here ──► CHANGESTR.REX.
output when using the default inputs:
old cipher key: Playfair example. ◄───using the default. new cipher key: PLAYFIREXM omit char: J double char: X original text: Hide the gold in the tree stump!! cleansed text: HI DE TH EG OL DI NT HE TR EE ST UM P HIDETHEGOLDINTHETREESTUMP encrypted text: BM OD ZB XD NA BE KU DM UI XM MO UV IF BMODZBXDNABEKUDMUIXMMOUVIF plain text: HI DE TH EG OL DI NT HE TR EX ES TU MP HIDETHEGOLDINTHETREXESTUMP possible text: HI DE TH EG OL DI NT HE TR EE ST UM P HIDETHEGOLDINTHETREESTUMP original text: HIDETHEGOLDINTHETREESTUMP ════════════════Playfair encryption──► decryption──► encryption worked.
output when using the input of: x stuvw (myteest
old cipher key: stuvw new cipher key: STUVW omit char: X double char: Q original text: myteest cleansed text: MY TE ES T MYTEEST encrypted text: NR WB ZB TU NRWBZBTU plain text: MY TE QE ST MYTEQEST possible text: MY TE ES T MYTEEST original text: MYTEEST ════════════════Playfair encryption──► decryption──► encryption worked.
Tcl
<lang tcl>package require TclOO
oo::class create Playfair {
variable grid lookup excluder constructor {{keyword "PLAYFAIR EXAMPLE"} {exclude "J"}} {
# Tweaking according to exact operation mode if {$exclude eq "J"} { set excluder "J I" } else { set excluder [list $exclude ""] }
# Clean up the keyword source set keys [my Clean [append keyword "ABCDEFGHIJKLMNOPQRSTUVWXYZ"]]
# Generate the encoding grid set grid [lrepeat 5 [lrepeat 5 ""]] set idx -1 for {set i 0} {$i < 5} {incr i} {for {set j 0} {$j < 5} {} { if {![info exist lookup([set c [lindex $keys [incr idx]]])]} { lset grid $i $j $c set lookup($c) [list $i $j] incr j } }}
# Sanity check if {[array size lookup] != 25} { error "failed to build encoding table correctly" }
}
# Worker to apply a consistent cleanup/split rule method Clean {str} {
set str [string map $excluder [string toupper $str]] split [regsub -all {[^A-Z]} $str ""] ""
}
# These public methods are implemented by a single non-public method forward encode my Transform 1 forward decode my Transform -1
# The application of the Playfair cypher transform method Transform {direction message} {
# Split message into true digraphs foreach c [my Clean $message] { if {![info exists lookup($c)]} continue if {[info exist c0]} { lappend digraphs $c0 [expr {$c0 eq $c ? "X" : $c}] unset c0 } else { set c0 $c } } if {[info exist c0]} { lappend digraphs $c0 "Z" }
# Encode the digraphs set result "" foreach {a b} $digraphs { lassign $lookup($a) ai aj lassign $lookup($b) bi bj if {$ai == $bi} { set aj [expr {($aj + $direction) % 5}] set bj [expr {($bj + $direction) % 5}] } elseif {$aj == $bj} { set ai [expr {($ai + $direction) % 5}] set bi [expr {($bi + $direction) % 5}] } else { set tmp $aj set aj $bj set bj $tmp } lappend result [lindex $grid $ai $aj][lindex $grid $bi $bj] }
# Real use would be: return [join $result ""] return $result
}
}</lang> Demonstrating: <lang tcl>Playfair create cypher "Playfair Example" set plaintext "Hide the gold in...the TREESTUMP!!!" set encoded [cypher encode $plaintext] set decoded [cypher decode $encoded] puts "Original: $plaintext" puts "Encoded: $encoded" puts "Decoded: $decoded"</lang>
- Output:
Original: Hide the gold in...the TREESTUMP!!! Encoded: BM OD ZB XD NA BE KU DM UI XM KZ ZR FT Decoded: HI DE TH EG OL DI NT HE TR EX ST UM PZ