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

'Progress.Bas -- Identifies and
'  reduces progressive ciphers to
'  periodic polyalphabetics
'Demo example is E-26 SO2001
ct$="MHIAGKDYPDHRVTTIDCDDVYVJFFMRSUW"
ct$=ct$+"KDECQYXPCNVBGBUKWWYTVSSYQPC"
ct$=ct$+"XRHFJMWUWBKRSPPPSEBRMYILLZF"
ct$=ct$+"QWCJTBZDSAGGZZXDYJCAEKVGPVV"
ct$=ct$+"IMOTBKLWVTSYA"

DEFINT A-Z
Typ$="V"     'See Dec$() for types
MinimumPeriod=5 : MaximumPeriod=10
'Main routine prints the table of ICs

'Print headers first
Print "Per"+Space$(28);
Print "Progression Index"
Print "  ";
For I=1 to 25
  Print RJust$(I,3);
Next I
Print

'For each period and index, remove 
'the progression index and compute
'the IC for the reduced cipher R$
For P=MinimumPeriod to MaximumPeriod
  Print RJust$(P,2);
  For I=1 to 25
    R$ = RemoveIdx$(Ct$,P,I,Typ$)
    IC = PolyIC(R$,P)
    Print RJust$(IC,3);
  Next I
  Print
Next P
Print

'Let user select period and index and
'print the reduced cipher.
Print "To reduce to periodic cipher";
Input " enter: Period,Index";P,I
R$ = RemoveIdx$(Ct$,P,I,Typ$)
LineLen = 60 'Length of output line
While Len(R$)>LineLen
  Print Mid$(R$,1,LineLen)
  R$ = Mid$(R$,LineLen+1)
Wend
Print R$
System 'Exit Basic

'Returns pt ltr from ct ltr, Key Num,
'Typ$ = V/B/A/P = Vig/Beau/Var/Porta
Function Dec$(CLtr$,K,Typ$)
 C = Asc(CLtr$) - 65
 Select Case Typ$
   Case "V" : D = (C-K+26) mod 26
   Case "B" : D = (K-C+26) mod 26
   Case "A" : D = (C+K) mod 26
   Case Else' 'Else assume Porta
     K = K\2 : D = C
     If D < 13 Then
        D=D+K : If D<13 Then D=D+13
     Else
        D=D-K : If D>12 Then D=D-13
     End If
 End Select
 Dec$ = Chr$(D+65)
End Function 'Dec$

'Removes the progression index from
'Ct$ for a given period and index.
'Returns the reduced cipher.
Function RemoveIdx$(Ct$,Per,Idx,Typ$)
  CtLen=Len(Ct$) : CurIdx=0
  Col=1 : R$=""
  For I=1 to CtLen
    C$ = Mid$(Ct$,I,1)
    R$ = R$ + Dec$(C$,CurIdx,Typ$)
    Col= Col+1
    If Col > Per Then
      Col = 1
      CurIdx = CurIdx + Idx
      CurIdx = CurIdx mod 26
    End If
  Next I
  RemoveIdx$ = R$
End Function 'RemoveIdx$

'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$