'Copyright 2002 The American Cryptogram Association (ACA)
'3613 Piedmont Drive, Plano TX 75075-6234
'All rights reserved.


'PeriodIC.Bas 

'The published version requires that 
'functions PolyIC() and RJust$ be 
'copied from MA2002 Progress.Bas.
'This has already been done below,
'so this version is complete.

 
'AC-652 JA2001 Unknown Nicodemus 
c$="ONIAEXTETEUSFFEWVFHGEHYEMAHULKYU" 
c$=c$+"FBZFNAGNSMJBJZFXRZBKBKXMAKFKN" 
c$=c$+"NOOFTMCANXDIUSIFIYWQIHWYPBSJH" 
c$=c$+"QUFURGTGARWCSVWJKCCDMHXGBAIHM" 
c$=c$+"ZEINIETSLOOBFFTUQEVLVXVIMYYBO" 
c$=c$+"PCTPUZXCFQGAFOOATFCVKZYVMPMBX" 
c$=c$+"MLKERKVSQLYXSVFFH" 
 
BeginPeriod=3 : EndPeriod=16 
CLen = Len(c$) 
'Print the column headers. 
Print "IC for Periodics & Nicodemus" 
Print "ICs shown are 1000 x IC" 
Print "Period | Periodic Depth | "; 
Print "Nicodemus Depth" 
 
'Print the ICs and depths 
For Per=BeginPeriod to EndPeriod 
  'Round 1000*IC to nearest integer
  IC = Int(PolyIC(C$,Per) + .5) 
  Print RJust$(Per,4);RJust$(IC,10); 
  Depth=Clen\Per 
  Print RJust$(Depth,7); 
  Ct$=RearrangeNicod$(C$,Per) 
  IC = Int(PolyIC(Ct$,Per) + .5) 
  Depth = (CLen\(Per*5)) * 5 
  Print RJust$(IC,11);RJust$(Depth,7) 
Next Per 
 
'Prompt for period but exit if user
'  simply presses <Enter>.
Input "Period for Nicodemus";Per 
If Per < BeginPeriod then System 
Print "Cipher as standard periodic:" 
Print RearrangeNicod$(C$,Per) 
System 'Exits QBasic 
 
Function RearrangeNicod$(Ct$,Per) 
'Converts Nicodemus into a standard 
'Vigenere-family ciphertext. 
 
' CtLen = ciphertext length 
' GrLen = group length = the number 
'   of letters needed to put 5 more 
'   letters in each column. 
' RLen = the number of letters in 
'   all complete groups. 
' GrInCol = the number of groups 
'   per column given the period. 
' N$ = the portion of ciphertext 
'   in the Nicodemus block. 
' R$ = the rearranged ciphertext 
 
' Loop initializations 
  CtLen = Len(Ct$) 
  GrLen = Per*5 
  RLen  = CtLen - (CtLen mod GrLen) 
  GrInCol = RLen \ GrLen 
  N$ = Left$(Ct$,Rlen) 
  R$ = "" 
 
'Next eight lines rearrange N$ to R$ 
  For I=0 to GrInCol-1 
    For J=1 to 5 
      For K=0 to Per-1 
        Posn= 5*K + J + 5*Per*I 
        R$=R$+Mid$(N$,Posn,1) 
      Next K 
    Next J 
  Next I 
  RearrangeNicod$=R$ 
End Function 'RearrangeNicod$

'Computes the average column IC for
'Ct$ written in a block of width Per.
Function PolyIC(Ct$,Per) Static
Dim Fr(26)
CtLen=Len(Ct$) : ColIC=0
For Col=1 to Per
  Erase Fr 
  N = 0 : Sum = 0
  For I=Col to CtLen STEP Per
    Ch = ASC(Mid$(CT$,I,1)) - 64
    Fr(Ch) = Fr(Ch) + 1
    N = N+1
  Next I
  For I=1 to 26
    Sum = Sum + Fr(I) * (Fr(I)-1)
  Next I
  ColIC = ColIC+Sum/(N*(N-1))*1000
Next Col
PolyIC = ColIC/Per
End Function 'PolyIC

'Right-justify I in field of length L
Function RJust$(I,L)
  Tmp$ = Space$(L) + Ltrim$(Str$(I))
  RJust$ = Right$(Tmp$,L)
End Function 'RJust$