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

'A complete version of the program is in the file RouteSol.Bas

'This is the file routesol.txt.
'It contains the program code that appeared in the
'Sep/Oct 2002 Computer Column of The Cryptogram.
'This code is incomplete as it stands, needing some 
'routines from earlier programs (see the file
'RouteSol.Bas for details).

'The printed text starts here:

'RouteSol.Bas
DefInt A-Z
Const alt = -1, up = -1, max = 999
Dim shared Sq[100,100] 
dim shared RouteIn[500]
dim shared threshold

'Demo cipher  MJ02 E-02
ct$="DOCLFCMGPAAMAIAEUHPAINARSTALG"
ct$=ct$+"NXSAIURATOTIXLHITMVNNCVEC"
ct$=ct$+"INIYTNROUEAUISRNGMLCE"

Print "Digraph Threshold ";
Input "<Enter = 720> ";Threshold
If Threshold = 0 then Threshold=720
DiagnoseRoute ct$
input "Press Enter to Exit";x$
system


'For NRxNC rectangle & route pair InR
'OutR (0-47 each), convert Ct$ to Pt$
Function RouteTr$(nr,nc,InR,OutR,Ct$,Pt$)

 'Create routes & put names in R$
 R$=InByRoute$(nr,nc,InR)
 R$=R$+RJust$(1+(InR\12),1)+" "
 i=1 'Save write-in route numbers
 For r=1 to nr
   For c=1 to nc
     RouteIn[i] = Sq[r,c]
     i=i+1
   Next c
 Next r

 Pt$=Space$(nr*nc) 'Pre-extend Pt$
 R$=R$+" "+InbyRoute$(nr,nc,OutR)
 R$=R$+RJust$(1+(OutR\12),1)
 i=1 'Use routes in Sq$ & RouteIn to

 For r=1 to nr   'copy letters from
   For c=1 to nc 'Ct$ into Pt$
     ch$=mid$(Ct$,RouteIn[i],1)
     mid$(Pt$,Sq[r,c],1) = Ch$
     i=i+1
   Next c
 Next r

 RouteTr$=R$
End Function  'RouteTr$

SUB DiagnoseRoute(ct$)
Ctlen = len(ct$) : PL = 40
If Ctlen < 40 then PL = Ctlen

For fact=2 to 53     'Factor Ctlen
  r = Ctlen mod fact 'r=0 for factors
  If r <> 0 then goto nextf
  nr=ctlen/fact : nc=fact
  if nc > nr then exit for
  print "Trying rectangle ";nr;"x";nc
  Npr = 1 'Number of lines printed
  for RIn = 0 to 11
   for ROut = 0 to 47
     R$=RouteTr$(nr,nc,RIn,Rout,ct$,pt$)
     eval = DiAvg(pt$,1)
     if eval > threshold then 
       Npr = Npr+1 : print eval;
       print mid$(pt$,1,PL);" ";R$
     End If
     if Npr mod 15 = 0 then 
       Npr=1 'Reset output line count
       input "<Enter> for more";x$
     End If
     if eval > hi then 'save new high
       hi = eval : hnr=nr : hnc=nc
       hiR$ = R$
       hiPt$ = Pt$
     end if
   next ROut
  next RIn
nextf:
next fact

Print 
print "Best score & routes:";hi;hiR$;
print " ";hnr;"rows and";hnc;"cols."
print "Most likely plaintext: ";hiPt$

END SUB 'DiagnoseRoute