'Sqr4comp.bas           hh            Mar. 1/01

' Uses info from FourSqr.dat generated by FourSqr.bas
' Finds complement pairs for order-4 magic squares and outputs index and
'   pair numbers to the screen and new Sqr4_Out.dat.
' Also splits up Group code into 2 columns

' Final data file is Sqr4_Out.dat
'  pos. 0 = solution #, 1= Group #,
'  2= group code (degree of rotation, LSD (if 2 digits) 1= simple, 2= semi-pan)
'  3 to 18 = numbers in magic square, 19 = Comp. pair #, 20 = other member
' Read data file into WORD for final editing

DEFINT A-Z
DECLARE SUB rotate ()                   ' rotates the square 90 degrees CCW
DECLARE SUB reflect ()                  ' reflect around the leading diagonal

DIM testset(26)                         'hold solution to test
DIM SHARED comp(19)                     'hold complement of testset
DIM SHARED temp(19)                     'temporary hold rotated or reflected
DIM Orig(880, 26)                       'Hold list from FourSqr.dat
                                        '  leave 2 places on end for pair # and name
DIM SHARED currentset, PairNum AS INTEGER

CLS
PRINT "Sqr4comp.bas           hh            Mar. 1/01"

PRINT " Uses info from FourSqr.dat generated by FourSqr.bas"
PRINT " Finds complement pairs for order-4 magic squares and outputs index and"
PRINT "   pair numbers to the screen and new Sqr4_Out.dat which must be in the same ."
PRINT "Sqr4_Out.dat must be in the same sub-directory as this program."
PRINT " Also splits up Group code into 2 columns"
PRINT " Final data file is Sqr4_Out.dat"
PRINT "Line   position 0 = solution #, 1= Group #,"
PRINT "  2= group code (degree of rotation, LSD (if 2 digits) 1= simple, 2= semi-pan)"
PRINT "  3 to 18 = numbers in magic square, 19 = Comp. pair #, 20 = other member"
PRINT " Read data file into WORD for final editing"
PRINT

OPEN "FourSqr.dat" FOR INPUT AS #1
FOR indx1 = 1 TO 880

   INPUT #1, x                          ' put the set of solutions in an array
   INPUT #1, x                          '   in compact order i.e. remove spaces
   INPUT #1, x
   Orig(indx1, 2) = x                   ' group code
   INPUT #1, x
   INPUT #1, x
   Orig(indx1, 3) = x      ' a
   INPUT #1, x
   Orig(indx1, 4) = x      ' b
   INPUT #1, x
   Orig(indx1, 5) = x      ' c
   INPUT #1, x
   Orig(indx1, 6) = x      ' d
   INPUT #1, x
   INPUT #1, x
   Orig(indx1, 7) = x      ' e
   INPUT #1, x
   Orig(indx1, 8) = x      ' f
   INPUT #1, x
   Orig(indx1, 9) = x      ' g
   INPUT #1, x
   Orig(indx1, 10) = x     ' h
   INPUT #1, x
   INPUT #1, x
   Orig(indx1, 11) = x     ' i
   INPUT #1, x
   Orig(indx1, 12) = x     ' j
   INPUT #1, x
   Orig(indx1, 13) = x     ' k
   INPUT #1, x
   Orig(indx1, 14) = x     ' l
   INPUT #1, x
   INPUT #1, x
   Orig(indx1, 15) = x     ' m
   INPUT #1, x
   Orig(indx1, 16) = x     ' n
   INPUT #1, x
   Orig(indx1, 17) = x     ' o
   INPUT #1, x
   Orig(indx1, 18) = x     ' p
  NEXT indx1
CLOSE #1

'KILL "Sqr4_Out.dat"
OPEN "Sqr4_Out.dat" FOR APPEND AS #1    ' prepare new data file
FOR solnum = 1 TO 880                   ' main loop
   currentset = solnum                  ' solution number
   Orig(currentset, 0) = currentset     ' put index # in record
   x = Orig(currentset, 2)
   Group = x / 100
   Orig(currentset, 1) = Group          ' add field for group number
   y = Orig(currentset, 2) - Group * 100      ' new group code
   IF Group <> 6 THEN y = y / 10              ' take out LSD of code
   IF y = 0 THEN y = 1
   groupcode = y
   Orig(currentset, 2) = groupcode
  
   IF Orig(currentset, 19) = 0 THEN     ' test only solutions not already tested
      FOR indx1 = 1 TO 16               '    assigned to a pair
         testset(indx1) = Orig(currentset, indx1 + 2)
      NEXT
     
      testset(1) = Orig(currentset, 3)   'a   
      testset(2) = Orig(currentset, 4)   'b
      testset(3) = Orig(currentset, 5)   'c  This routine saves the current set
      testset(4) = Orig(currentset, 6)   'd   for testing
      testset(5) = Orig(currentset, 7)   'e
      testset(6) = Orig(currentset, 8)   'f
      testset(7) = Orig(currentset, 9)   'g
      testset(8) = Orig(currentset, 10)  'h
      testset(9) = Orig(currentset, 11)
      testset(10) = Orig(currentset, 12)
      testset(11) = Orig(currentset, 13)
      testset(12) = Orig(currentset, 14)
      testset(13) = Orig(currentset, 15)
      testset(14) = Orig(currentset, 16)
      testset(15) = Orig(currentset, 17)
      testset(16) = Orig(currentset, 18)
  
   FOR indx1 = 1 TO 16
      comp(indx1) = 17 - testset(indx1)  ' put complement of testset in comp()
   NEXT indx1
  
again:                                      '  then normalize before comparing
   IF comp(1) > comp(4) THEN rotate         ' call rotate S.R.
   IF comp(1) > comp(13) THEN rotate        ' call rotate S.R.
   IF comp(1) > comp(16) THEN rotate        ' call rotate S.R.
   IF comp(1) > comp(4) THEN GOTO again     ' call rotate S.R. again if necessary
   IF comp(1) > comp(13) THEN GOTO again    ' call rotate S.R.  
   IF comp(1) > comp(16) THEN GOTO again    ' call rotate S.R.
   
   IF comp(5) < comp(2) THEN reflect        ' call reflect S. R.
  
   matchcntr = 0
   FOR indx2 = 1 TO 16                      ' check if this is self-similar
      IF Orig(currentset, indx2 + 2) = comp(indx2) THEN matchcntr = matchcntr + 1
   NEXT indx2
   IF matchcntr = 16 THEN
      Orig(currentset, 19) = 999            ' indicate that this solution
      Orig(currentset, 20) = currentset     '   is self-similar
      GOTO nextsol
   END IF

   FOR indx1 = currentset + 1 TO 880        ' search for a match
      matchcntr = 0
      FOR indx2 = 1 TO 16
         IF Orig(indx1, indx2 + 2) = comp(indx2) THEN matchcntr = matchcntr + 1
      NEXT indx2
      IF matchcntr = 16 THEN              ' mark each solution as the complemnt
         PairNum = PairNum + 1            '   of the other
         Orig(indx1, 19) = PairNum
         Orig(indx1, 20) = currentset
         Orig(currentset, 19) = PairNum
         Orig(currentset, 20) = indx1
         EXIT FOR                         ' this search is finished
      END IF
   NEXT indx1
   END IF

nextsol:
   FOR indx1 = 0 TO 20                    ' write this solution to screen
      PRINT Orig(currentset, indx1);
   NEXT indx1
   PRINT
'  --- Prepare dat for writing to file ---
   currentset = Orig(currentset, 0): Group = Orig(currentset, 1): groupcode = Orig(currentset, 2)
   a = Orig(currentset, 3): b = Orig(currentset, 4): c = Orig(currentset, 5)
   d = Orig(currentset, 6): e = Orig(currentset, 7): f = Orig(currentset, 8)
   g = Orig(currentset, 9): h = Orig(currentset, 10): i = Orig(currentset, 11)
   j = Orig(currentset, 12): k = Orig(currentset, 13): l = Orig(currentset, 14)
   m = Orig(currentset, 15): n = Orig(currentset, 16): o = Orig(currentset, 17)
   p = Orig(currentset, 18): PairA = Orig(currentset, 19): PairB = Orig(currentset, 20)
   WRITE #1, currentset, Group, groupcode, a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, PairA, PairB

NEXT solnum                               ' loop for next solution to test

END

SUB reflect

temp(2) = comp(5)              ' reflect around leading diagonal
temp(3) = comp(9)
temp(4) = comp(13)
temp(5) = comp(2)
temp(9) = comp(3)
temp(13) = comp(4)
temp(10) = comp(7)
temp(7) = comp(10)
temp(14) = comp(8)
temp(8) = comp(14)
temp(12) = comp(15)
temp(15) = comp(12)

FOR indx2 = 1 TO 16              ' put reflected square back into comp()
   comp(indx2) = temp(indx2)
NEXT


END SUB

SUB rotate

temp(1) = comp(4)            ' rotate the complemented square 90 degrees CCW
temp(2) = comp(8)
temp(3) = comp(12)
temp(4) = comp(16)
temp(5) = comp(3)
temp(6) = comp(7)
temp(7) = comp(11)
temp(8) = comp(15)
temp(9) = comp(2)

temp(10) = comp(6)
temp(11) = comp(10)
temp(12) = comp(14)
temp(13) = comp(1)
temp(14) = comp(5)
temp(15) = comp(9)
temp(16) = comp(13)

FOR indx2 = 1 TO 16              ' put rotated square back into comp()
   comp(indx2) = temp(indx2)
NEXT

END SUB