Playfair cipher: Difference between revisions

Content added Content deleted
m (→‎{{header|REXX}}: changed direction of an arrow in a comment. -- ~~~~)
(→‎{{header|REXX}}: changed variable names and better showing of input and output, choosing a better "double character", added a conclusion (output is Playfair encryption is correct). -- ~~~~)
Line 360: Line 360:


=={{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, and displaying input and output.
<br><br>Thanks to Walter Pachl, this program is now sensitive of using a suitable ''double character'' when &nbsp; '''x''' &nbsp; is present in the cipher key.
<lang rexx>/*REXX program implements a PLAYFAIR cipher (encryption & decryption).*/
<lang rexx>/*REXX program implements a PLAYFAIR cipher (encryption & decryption).*/
parse arg key . 1 oldK omit _ . '(' text /*TEXT is the phrase to be used*/
parse arg key . 1 oldK omit _ . '(' text /*TEXT is the phrase to be used*/
if key =='' | key ==',' then do; key='Playfair example.'; oldK=key " ◄───the default."; end
if key =='' | key ==',' then do; key='Playfair example.'; oldK=key " ◄───using the default."; end
if omit=='' | omit==',' then omit='J' /*the "omitted" character. */
if omit=='' | omit==',' then omit='J' /*the "omitted" character. */
if text='' then text='Hide the gold in the tree stump!!' /*default.*/
if text='' then text='Hide the gold in the tree stump!!' /*default.*/
Line 375: Line 376:
upper omit /*uppercase the OMIT character.*/
upper omit /*uppercase the OMIT character.*/
fill=space(translate('ABCDEFGHIJKLMNOPQRSTUVWXYZ',,omit),0) /*elide omit*/
fill=space(translate('ABCDEFGHIJKLMNOPQRSTUVWXYZ',,omit),0) /*elide omit*/
xx='X'; if omit==xx then xx='Q' /*char used for double characters*/
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 > 2 unique characters.'
if length(newKey)<3 then call err 'cipher key is too short, must be > 2 unique characters.'
fill=space(translate(fill,,newKey),0) /*remove any cipher characters. */
fill=space(translate(fill,,newKey),0) /*remove any cipher characters. */
grid=left(newKey || fill,26) /*use only the first 25 chars. */
grid=left(newKey || fill,26) /*use only the first 25 chars. */
say ' old cipher: ' strip(oldK)
say ' old cipher: ' strip(oldK) ; padL=14+2; pad=left('',padL)
say ' new cipher: ' newKey
say ' new cipher: ' newKey ; padX=left('',padL,'═')
say ' omit char : ' omit
say ' omit char: ' omit
say 'double char : ' xx
say ' double char: ' xx
say ' old text : ' strip(text)
say ' original text: ' strip(text)
say ' new text : ' newText
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 394: Line 394:
end /*col*/
end /*col*/
end /*row*/
end /*row*/

say
cText=.playfair(newText, 1); say ' cipher text: ' digram(cText)
cText=.playfair(newText, 1); call show 'cipher' , cText
pText=.playfair(cText ); say ' plain text: ' digram(pText)
pText=.playfair(cText ); call show 'plain' , pText
qText=space(translate(pText,,xx),0) /*remove char used for "doubles."*/
qText=space(translate(pText,,xx),0) /*remove char used for "doubles."*/
if length(qText)\==length(pText) then say 'possible text: ' digram(qText)
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 'Playfair encryption─►decryption─►encryption worked.'
exit /*stick a fork in it, we're done.*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────one─line subroutines───────────────────────────*/
/*──────────────────────────────────one-line subroutines────────────────*/
@@: parse arg Xrow,Xcol; return @.Xrow.Xcol
@@: parse arg Xrow,Xcol; return @.Xrow.Xcol
err: say; say '***error!***' arg(1); say; exit 13
err: say; say '***error!***' arg(1); say; exit 13
LR: rowL=row(left(__,1)); colL=_; rowR=row(right(__,1)); colR=_; return length(__)
LR: rowL=row(left(__,1)); colL=_; rowR=row(right(__,1)); colR=_; return length(__)
row: ?=pos(arg(1),grid); _=(?-1)//5+1; return (4+?)%5
row: ?=pos(arg(1),grid); _=(?-1)//5+1; return (4+?)%5
show: arg x,y; say; say right(x 'text: ',padL) digram(y); say pad space(y,0); return
/*──────────────────────────────────SCRUB subroutine────────────────────*/
/*──────────────────────────────────SCRUB subroutine────────────────────*/
scrub: procedure; arg stuff,unique /* ARG capitalizes all arguments.*/
scrub: procedure; arg xxx,unique; xxx=space(xxx,0) /*ARG caps all args*/
$=; do j=1 for length(xxx); _=substr(xxx,j,1)
$= /* [↑] if 1, then remove duplicate chars*/
do j=1 for length(stuff); _=substr(stuff,j,1)
if unique==1 then if pos(_,$)\==0 then iterate /*unique?*/
if unique==1 then if pos(_,$)\==0 then iterate
if datatype(_,'M') then $=$||_ /*only use Latin letters. */
if datatype(_,'M') then $=$||_ /*only use Latin letters.*/
end /*j*/
⚫
end /*j*/
return $
return $
/*──────────────────────────────────DIGRAM subroutine───────────────────*/
/*──────────────────────────────────DIGRAM subroutine───────────────────*/
digram: procedure; parse arg x; $=; do j=1 by 2 to length(x)
digram: procedure; parse arg x; $=; do j=1 by 2 to length(x)
$=$ || substr(x,j,2)' '
$=$ || substr(x,j,2)' '
end /*j*/
end /*j*/
return strip($)
return strip($)
/*──────────────────────────────────.PLAYFAIR subroutine────────────────*/
/*──────────────────────────────────.PLAYFAIR subroutine────────────────*/
.playfair: parse arg T,encrypt; i=-1; if encrypt==1 then i=1; $=
.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
do k=1 while i==1; _=substr(T,k,1); if _==' ' then leave
if _==substr(T,k+1,1) then T=left(T,k) || xx || 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))
if length(__)==1 then __=__ || xx; call LR /*append X|Q char, rule 1*/
if LR()==1 then __=__ || xx; call LR /*append X or 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 435: Line 437:
'''output''' when using the default inputs:
'''output''' when using the default inputs:
<pre>
<pre>
old cipher: Playfair example. ◄───the default.
old cipher: Playfair example. ◄───using the default.
new cipher: PLAYFIREXM
new cipher: PLAYFIREXM
omit char : J
omit char: J
double char : X
double char: X
old text : Hide the gold in the tree stump!!
original text: Hide the gold in the tree stump!!
new text : HIDETHEGOLDINTHETREESTUMP
new text: HIDETHEGOLDINTHETREESTUMP
⚫
digram text ↔: HI DE TH EG OL DI NT HE TR EE ST UM P


cipher 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
BMODZBXDNABEKUDMUIXMMOUVIF

possible text: HI DE TH EG OL DI NT HE TR EE ST UM P
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.
</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:
Line 455: Line 464:


cypher text= BM OD ZB XD NA BE KU DM UI XM MO UV IF
cypher 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</pre>
plain text= HI DE TH EG OL DI NT HE TR EX ES TU MP
</pre>
'''output''' when using the input of: &nbsp; <tt> stuvw x (myteest </tt>
<pre>
old cipher: stuvw
new cipher: STUVW
omit char: X
double char: Q
original text: myteest
new text: MYTEEST

CIPHER 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.
</pre>


=={{header|Tcl}}==
=={{header|Tcl}}==
Retrieved from "https://rosettacode.org/wiki/Playfair_cipher"