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

Dim Col40$(40)
Dim Sq$(8)  'Ct$ is for AC625
Ct$= "MZSCZAHRXZGRDNBQZESWSPZZNRHFH"
Ct$= Ct$+"YBGWRHECVZLDTGGQCGEHZSDVN"
Ct$= Ct$+"WWZILFDLDYLFNMHHCTHBBEKFN"
Ct$= Ct$+"HZYLDKGZCEHYVFGNXAADZBTGI"
Ct$= Ct$+"LLIRMHXFCDFHYKRELXLNGCLXN"
Ct$= Ct$+"GHKXRCQXEPLWPGRLLKGZUFYTB"
Ct$= Ct$+"KCRGCGKEUUEFGACXNNHLN"

Ct$   = UCase$(Ct$)   'Use upper case
CtIC  = IofC1000(Ct$) 'Overall IC
CtOrigLen = Len(Ct$)  'Original len

'Odd len rules out digraphic cipher
CtDig$ = "Cipher is not digraphic: "
CtDig$ = CtDig$+"Its length is odd."
CtLenIsEven = (CtOrigLen MOD 2) - 1
If CtLenIsEven Then
  CtDig$ = ""
  Dic1   = Dic10000(Ct$)
  Tmp$   = Mid$(Ct$,2,CtOrigLen-1)
  Dic2   = Dic10000(Tmp$)
End If

JinCt$= "J does not occur in cipher."
If instr(Ct$,"J") > 0 Then
  JinCt$="J occurs in cipher."
End If

'Make Ct$ length divisible by 40
'so ICs can be averaged.
CtLen = (Len(Ct$)\40)*40
Ct$   = Left$(Ct$,CtLen)

'If Ct$ is written across a 40-column
'block, Col40$(N) will be a string
'containing the letters in column N
Col=1
For I=1 to CtLen
  Ch$ = Mid$(Ct$,I,1)
  Col40$(Col) = Col40$(Col) + Ch$
  Col = Col+1
  If Col > 40 Then Col=1
Next I

'Sq$(SqN) will be a string of letters
'enciphered by square number SqN
SqN = 1
For I=1 to 40 step 5
  For J=0 to 4
    Sq$(SqN) = Sq$(SqN) + Col40$(I+J)
  Next J
  SqN = SqN+1
Next I

'Pool letters from equivalent squares
Sq15$ = Sq$(1) + Sq$(5)
Sq28$ = Sq$(2) + Sq$(8)

'Compute various IC averages
IcSum=0
For I=1 to 40
  IC = IofC1000(Col40$(I))
  IcSum = IcSum + IC
Next I
Ic40 = IcSum\40

IcSum=0
For I=1 to 8
  IC = IofC1000(Sq$(I))
  IcSum = IcSum + IC
Next I
IC8 = IcSum\8

ICSq15 = IofC1000(Sq15$)
ICSq28 = IofC1000(Sq28$)
IC1528 = (ICSq15 + ICSq28) \ 2

Print "PhilStat - Phillips Analysis"
Print  "Cipher length =";CtOrigLen
If CtDig$<>"" Then Print CtDig$
Print  JinCt$
Print "IC for entire Cipher =";CtIc
Print "Dic1 =";Dic1;"  Dic2 =";Dic2
Print
Print "Cipher truncated; len =";CtLen
Print "Avg IC for Period 40 =";IC40
Print "Avg IC for 8 squares =";IC8
Print "IC for Squares 1&5   =";ICSq15
Print "IC for Squares 2&8   =";ICSq28
Print "Avg IC for 1&5,2&8   =";IC1528

'Returns IC * 1000 for Txt$
Function IofC1000(Txt$)
  Dim Freq(127)
  N=Len(Txt$)
  For I=1 To N
    L = Asc(Mid$(Txt$,I,1))
    Freq(L) = Freq(L) + 1
  Next I
  For I=32 TO 127  'Sum counts the
    F = Freq(I)    '  coincidences
    If F>1 Then Sum = Sum + (F*(F-1))
  Next I           
  IofC1000 = (1000*Sum/N) \ (N-1)
End Function 'IofC1000

'Returns Dic * 10000 for Txt$
Function Dic10000(Txt$)
  Dim Freq(26,26) 'For Digraph Counts
  N=Len(Txt$)
  For I=1 To N Step 2
    Di$ = Mid$(Txt$,I,2) 'Get digraph
    L$  = Left$(Di$,1)   'Get 1st Ltr
    R$  = Right$(Di$,1)  'Get 2nd Ltr
    L   = ASC(L$) - 64   'Convert A-Z
    R   = ASC(R$) - 64   '  to 1-26
    Freq(L,R)=Freq(L,R)+1'Count Di$
  Next I
  For L=1 to 26    'Sum holds number
    For R=1 to 26  '  of digraphic
      F=Freq(L,R)  '  coincidences
      If F>1 Then Sum=Sum + (F*(F-1))
    Next R
  Next L
  N = N/2  'Number of digraphs
  Dic10000 = ((10000*Sum)/N) \ (N-1)
End Function 'Dic10000