Playfair cipher: Difference between revisions

Content added Content deleted
(→‎{{header|REXX}}: fixed two unset variables. -- ~~~~)
(→‎{{header|REXX}}: added more diagnostic output, added "possible text" (which deletes the character used for double characters in the original text), used preferred spelling of cipher. -- ~~~~)
Line 361: Line 361:
=={{header|REXX}}==
=={{header|REXX}}==
Quite a bit of the REXX code deals with error checking, accepting arguments, and displaying the options used.
Quite a bit of the REXX code deals with error checking, accepting arguments, and displaying the options used.
<lang rexx>/*REXX program implements a PLAYFAIR cypher (encryption & decryption).*/
<lang rexx>/*REXX program implements a PLAYFAIR cipher (encryption & decryption).*/
arg oldK noX _ . '(' oldX
parse arg key . 1 oldK omit _ . '(' text /*TEXT is the phrase to be used*/
if oldK=='' | oldK==',' then oldK='Playfair example'
if key =='' | key ==',' then do; key='Playfair example.'; oldK=key " ◄───the default."; end
if noX=='' | noX==',' then noX='J'
if omit=='' | omit==',' then omit='J' /*the "omitted" character. */
if oldX ='' then oldX='Hide the gold in the tree stump!!' /*default.*/
if text='' then text='Hide the gold in the tree stump!!' /*default.*/
key =scrub(key) /*use only Latin alphabet letters*/
⚫
say ' old cypher=' oldK
oldK=scrub(oldK) /*use only Latin alphabet letters*/
newText=scrub(text) /* " " " " " */
newX=scrub(oldX) /* " " " " " */
if _\=='' then call err 'too many arguments specified.'
if _\=='' then call err 'too many arguments specified.'
if newX=='' then call err 'PHRASE is empty or has no letters'
if newText=='' then call err 'TEXT is empty or has no letters'
if length(noX)\==1 then call err '"omitted" letter must be only one letter'
if length(omit)\==1 then call err 'OMIT letter must be only one letter'
if \datatype(noX,'M') then call err '"omitted" letter must be a Latin alphabet letter.'
if \datatype(omit,'M') then call err 'OMIT letter must be a Latin alphabet letter.'
if pos(noX,oldX)\==0 then call err 'PHRASE can''t contain the "OMIT" character: ' noX
if pos(omit,text)\==0 then call err 'TEXT can''t contain the "OMIT" character: ' omit
⚫
upper omit /*uppercase the OMIT character.*/
fill=space(translate('ABCDEFGHIJKLMNOPQRSTUVWXYZ',,noX),0) /*remove NOX*/
fill=space(translate('ABCDEFGHIJKLMNOPQRSTUVWXYZ',,omit),0) /*elide omit*/
⚫
newK= /* [↓] remove any duplicate chars*/
do j=1 for length(oldK); _=substr(oldK,j,1)
newKey= /* [↓] remove any duplicate chars*/
if pos(_,newK)==0 then newK=newK || _
do j=1 for length(key); _=substr(key,j,1)
if pos(_,newKey)==0 then newKey=newKey || _
end /*j*/
end /*j*/
xx='X'; if omit==xx then xx='Q' /*char used for double characters*/
if length(newK)<3 then call err 'cypher key is too short, must be > 2 character.'
if length(newKey)<3 then call err 'cipher key is too short, must be > 2 unique characters.'
⚫
fill=space(translate(fill,,newK),0) /*remove any cypher characters. */
grid=left(newK || fill,26) /*use only the first 25 chars. */
fill=space(translate(fill,,newKey),0) /*remove any cipher characters. */
grid=left(newKey || fill,26) /*use only the first 25 chars. */
⚫
say ' new cypher=' newK
say ' old phrase=' oldX
say ' old cipher: ' strip(oldK)
say ' new phrase=' newX
say ' new cipher: ' newKey
say ' new digram=' digram(newX)
say ' omit char : ' omit
say 'double char : ' xx
⚫
say ' old text : ' strip(text)
⚫
say ' new text : ' newText
say 'digram text ↔: ' digram(newText)
#=0
#=0
do row =1 for 5 /*build grid (individual cells).*/
do row =1 for 5 /*build grid (individual cells).*/
Line 395: Line 399:
end /*row*/
end /*row*/
say
say
cText=.playfair(newX, 1); say ' cypher text=' digram(cText)
cText=.playfair(newText, 1); say ' cipher text: ' digram(cText)
pText=.playfair(cText,0); say ' plain text=' digram(pText)
pText=.playfair(cText ); say ' plain text: ' digram(pText)
⚫
qText=space(translate(pText,,xx),0) /*remove char used for "doubles."*/
if length(qText)\==length(pText) then say 'possible text: ' digram(qText)
exit /*stick a fork in it, we're done.*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────one-line subroutines────────────────*/
/*──────────────────────────────────one-line subroutines────────────────*/
Line 415: Line 421:
return strip($)
return strip($)
/*──────────────────────────────────.PLAYFAIR subroutine────────────────*/
/*──────────────────────────────────.PLAYFAIR subroutine────────────────*/
.playfair: parse arg T,encrypt; i=-1; if encrypt then i=1; $=
.playfair: parse arg T,encrypt; i=-1; if encrypt==1 then i=1; $=
do k=1 while encrypt; _=substr(T,k,1); if _='' then leave
do k=1 while i==1; _=substr(T,k,1); if _='' then leave
if _==substr(T,k+1,1) then T=left(T,k) || 'X' || substr(T,k+1)
if _==substr(T,k+1,1) then T=left(T,k) || xx || substr(T,k+1)
end /*k*/
end /*k*/
do j=1 by 2 to length(T); __=strip(substr(T,j,2)); call LR
do j=1 by 2 to length(T); __=strip(substr(T,j,2)); call LR
if length(__)==1 then __=__ || 'X'; call LR /*append an "X" character, rule 1*/
if length(__)==1 then __=__ || xx; call LR /*append X|Q char, rule 1*/
select
select
when rowL==rowR then __=@@(rowL, colL+i)@@(rowR, colR+i) /*rule 2*/
when rowL==rowR then __=@@(rowL, colL+i)@@(rowR, colR+i) /*rule 2*/
Line 431: Line 437:
'''output''' when using the default inputs:
'''output''' when using the default inputs:
<pre>
<pre>
old cypher= Playfair example
old cipher: Playfair example. ◄───the default.
new cypher= PLAYFIREXM
new cipher: PLAYFIREXM
omit char : J
old phrase= Hide the gold in the tree stump!!
double char : X
⚫
new phrase= HIDETHEGOLDINTHETREESTUMP
new digram= HI DE TH EG OL DI NT HE TR EE ST UM P
old text : Hide the gold in the tree stump!!
⚫
new text : HIDETHEGOLDINTHETREESTUMP
digram text ↔: HI DE TH EG OL DI NT HE TR EE ST UM P


cypher text= BM OD ZB XD NA BE KU DM UI XM MO UV IF
cipher text: BM OD ZB XD NA BE KU DM UI XM MO UV IF
plain text= HI DE TH EG OL DI NT HE TR EX ES TU MP
plain text: HI DE TH EG OL DI NT HE TR EX ES TU MP
possible text: HI DE TH EG OL DI NT HE TR EE ST UM P
</pre>
</pre>
After the usual replacements for $, @, #, and x= I ran the program on ooRexx with the following correct results:
After the usual replacements for $, @, #, and x= I ran the program on ooRexx with the following correct results:
Retrieved from "https://rosettacode.org/wiki/Playfair_cipher"