Rosetta Code

Playfair cipher: Difference between revisions

Page Discussion

Playfair cipher (view source)

Revision as of 10:51, 25 January 2020

1,333 bytes added ,  4 years ago
m
→‎{{header|REXX}}: split some compound statements, added/changed whitespace and comments, ordered functions by name, used a template for the output sections.
m (→‎{{header|REXX}}: split some compound statements, added/changed whitespace and comments, ordered functions by name, used a template for the output sections.)
Line 2,088:
<br>A fair amount of code was added to massage the decrypted encryption to remove doubled &nbsp; '''X'''es &nbsp; so as to match the original text
<br>(this is the ''possible text'' part of the REXX code).
<lang rexx>/*REXX program implements a PLAYFAIR cipher (encryption &and decryption). */
@abc= 'abcdefghijklmnopqrstuvwxyz'; @abcU= @abc /*literals for lower and upper ABC's.*/
parse arg omit key '(' text /*TEXT is the phrase to be used. */ ;oldK=key /*save old.*/
#oldKey=0 key /*numbersave ofthe gridold characters usedkey. */▼
if key =='' | key ==',' then do; key='Playfair example.'; oldK=key " ◄───using the default."; end
if omitkey =='' | omitkey ==',' then omit='J' /*thethen do; "omitted" character. key= */'Playfair example.'
if text='' then text='Hide the gold in the tree stump!!' /* oldKey= key " ◄───using the default.*/"
newKey =scrub(key , 1) /*scrub old cipher key──► newKey */ end
newTextif omit==scrub(text ) '' | omit==',' then omit= 'J' /*the " omitted" character textstring. ──► newText*/
if newText=text='' then call err then text= 'TEXTHide isthe emptygold orin hasthe notree lettersstump!!' /*default.*/
newKey = scrub(key, 1) /*scrub old cipher key ──► newKey */
if length(omit)\==1 then call err 'OMIT letter must be only one letter'▼
newText= scrub(text ) /* " " text ──► newText */
if \datatype(omit,'M') then call err 'OMIT letter must be a Latin alphabet letter.'
upperif omitnewText=='' @abcU then call err 'TEXT is empty or has no /*uppercase OMIT char & alphabetletters.*/'
▲if length(omit)\==1 then call err 'OMIT letter must be only one letter.'
cant='can''t contain the "OMIT" character: ' omit▼
if pos\datatype(omit,newText 'M')\==0 then call err 'TEXT'OMIT letter must be a Latin alphabet cantletter.'
upper qTextomit @abcU /*reinstateuppercase theOMIT usecharacters of& uppercharsalphabet.*/▼
if pos(omit,newKey) \==0 then call err 'cipher key' cant
▲ @cant= 'can''t contain the "OMIT" character: ' omit /*literal used in error text*/
fill=space(translate(@abcU,, omit), 0) /*elide OMIT char from alphabet. */▼
xx='X'; if pos(omit, newText)\==xx0 then xx=call err 'QTEXT' /*char used for double characters*/@cant
if lengthpos(omit, newKey)<3 \==0 then call err 'cipher key' is too short, must be ≥3 unique characters.'@cant
fill= space( translate(fill@abcU, ,newKey omit), 0) /*removeelide any cipherOMIT characters. from alphabet. */
gridxx=newKey ||'X' fill /*only first 25 chars are /*character used for double characters.*/
if omit==xx then xx= 'Q' /* " " " " " */
say 'old cipher key: ' strip(oldK) ; padL=14+2; pad=left('',padL)▼
if length(newKey)<3 then call err ,
say 'new cipher key: ' newKey ; padX=left('',padL,"═")'Playfair'▼
say ' omit char: ' omit /* [↓] lowercase of double char 'cipher key is too short, must be ≥ 3 unique characters.*/'
▲fill= space( translate(@abcUfill, , omitnewKey), 0) /*elideremove OMITany charcipher from alphabetcharacters. */
say ' double char: ' xx ; Lxx=translate(xx, @abc, @abcU)
grid= newKey || fill /*only first 25 characters are used. */
say ' original text: ' strip(text) /* [↓] doubled version of Lxx. */▼
▲say 'old cipher key: ' strip(oldK) ; padL=14+2; pad=left('',padLoldKey)
call show 'cleansed', newText ; LxxLxx=Lxx || Lxx▼
say 'new cipher key: ' newKey
▲#=0 /*number of grid characters used.*/
say ' omit char: ' omit
do row =1 for 5 /*build array of individual cells*/▼
say ' double char: ' xx
do col=1 for 5; #=#+1; @.row.col=substr(grid,#,1)▼
▲say ' original text: ' strip(text) /* [↓] doubled version of Lxx. */
if row==1 then @.0.col=@.1.col▼
padL= 14 + 2
if col==5 then do; @.row.6=@.row.1; @.row.0=@.row.5; end
▲call show 'cleansed', newText ; LxxLxx=Lxx || Lxx
if row==5 then do; @.6.col=@.1.col; @.0.col=@.5.col; end
#=0 end /*colnumber of grid characters used. */
do row =1 for 5 end /*rowbuild array of individual cells. */
▲ do col=1 for 5; #= # + 1; @.row.col= substr(grid, #, 1)
 
▲ do if row ==1 forthen 5 /*build array@.0.col= of individual cells*/@.1.col
eText=.Playfair(newText, 1); call show 'encrypted' , eText▼
pText=.Playfair(eText ) if col==5 then do; @.row.6= @.row.1; call show 'plain' @.row.0= @.row.5; , pTextend
▲ if row==15 then do; @.06.col= @.1.col; @.0.col= @.5.col; end
qText=changestr(xx ||xx,pText,Lxx) /*change doubled doublechar─►sing*/▼
end /*kcol*/▼
qText=changestr(Lxx||xx,qText,LxxLxx) /*change Xx ──► lowercase dblChar*/▼
end /*selectrow*/▼
qText=space(translate(qText,,xx),0) /*remove char used for "doubles."*/▼
pad = left('', padL)
▲upper qText /*reinstate the use of upperchars*/
▲say 'new cipher key: ' newKey ; padX= left('', padL, "═")'Playfair'
if length(qText)\==length(pText) then call show 'possible', qText▼
Lxx = translate(xx, @abc, @abcU) /* [↓] lowercase of double character. */
say ' original text: ' newText; say /*··· and show the original text.*/▼
LxxLxx= Lxx || Lxx /* [↓] doubled version of Lxx. */
▲eText= .Playfair(newText, 1); call show 'encrypted' , eText
pText= .Playfair(eText ); call show 'plain' , pText
▲qText= changestr(xx || xx, pText, Lxx) /*change doubled doublechar─►singdoublechar ──► single.*/
▲qText= changestr(Lxx || xx, qText, LxxLxx) /*change Xx xx ──► lowercase dblChardblCharacter*/
▲qText= space( translate( qText, , xx), 0) /*remove charcharacter used for "doubles.". */
upper qText /*reinstate the use of upper characters*/
▲if length(qText)\==length(pText) then call show 'possible', qText
▲say ' original text: ' newText; say /*··· and also show the original text. */
if qtext==newText then say padx 'encryption──► decryption──► encryption worked.'
exit /*stick a fork in it, we're all 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────────────────────*/
.Playfair: arg T,encrypt; i= -1; if encrypt==1 then i= 1; $=
scrub: procedure; arg xxx,unique; xxx=space(xxx,0) /*ARG caps all args*/▼
$=; do jk=1 forwhile length(xxx) i==1; _= substr(xxxT,j k, 1); if _==' ' then leave
if unique_==substr(T, k+1, 1) then T= if posleft(_T,$ k)\==0 || thenLxx iterate|| substr(T, k /*unique?*/+ 1)
if datatype(_,'M') then $=$||_ /*only useend Latin letters. /*k*/
end upper /*j*/T
do j=1 by 2 to length(T); __= strip( substr(T, j, 2) )
return $▼
if LR()==1 then __= __ || xx; call LR /*append X or Q char, rule 1*/
/*──────────────────────────────────DIGRAM subroutine───────────────────*/
digram: procedure; parse arg x; $=; do j=1 by 2 to length(x)select
when rowL==rowR then __= @@(rowL, colL+i)@@(rowR, colR+i) /*rule $=$ || substr(x,j,2)' '*/
when colL==colR then __= @@(rowL+i, colL )@@(rowR+i, colR) end /*jrule 3*/
when rowL==rowR then otherwise __= @@(rowL, colL+i colR )@@(rowR, colR+i colL) /*rule 24*/▼
return strip($)▼
end /*select*/
/*──────────────────────────────────.PLAYFAIR subroutine────────────────*/
.Playfair: arg T,encrypt; i=-1; if encrypt$==1 $ then|| i=1; $=__
do k=1 while i==1;end _=substr(T,k,1); if _==' ' then leave/*j*/
▲ return $
if _==substr(T,k+1 ,1) then T=left(T,k) || Lxx || substr(T,k+1)
/*──────────────────────────────────────────────────────────────────────────────────────*/
▲ end /*k*/
digram: procedure; parse arg x; $=; do j=1 by 2 to length(x)
upper T
do j=1 by 2 to length(T); __ $=strip( $ || substr(Tx, j, 2))' '
if LR()==1 then __=__ || xx; call LR /*append X or Q char, rule 1 end /*j*/
▲ return strip($)
select
/*──────────────────────────────────────────────────────────────────────────────────────*/
▲ when rowL==rowR then __=@@(rowL, colL+i)@@(rowR, colR+i) /*rule 2*/
▲scrub: procedure; arg xxx,unique; xxx= space(xxx, 0) /*ARG capscapitalizes all args*/
when colL==colR then __=@@(rowL+i,colL )@@(rowR+i,colR) /*rule 3*/
otherwise $=; __=@@(rowL, colR do )@@(rowR,j=1 colLfor length(xxx); /*rule 4*/_= substr(xxx, j, 1)
if unique==1 then if pos(_, $)\==0 then iterate /*is unique?*/
▲ end /*select*/
if datatype(_, 'M') then $= $ || _ /*only use Latin letters. */
$=$ || __
end /*j*/
return $</lang>
Some older REXXes don't have a '''changestr''' bif, so one is included here ──► [[CHANGESTR.REX]].
<br><br>
'''{{out|output'''|text=&nbsp; when using the default inputs:}}
<pre>
old cipher key: Playfair example. ◄───using the default.
Line 2,192 ⟶ 2,201:
════════════════Playfair encryption──► decryption──► encryption worked.
</pre>
'''{{out|output'''|text=&nbsp; when using the input of: &nbsp; &nbsp; <tt> x &nbsp; stuvw &nbsp; (myteest </tt>}}
<pre>
old cipher key: stuvw
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/231202"