' Pan5x5.bas                         hh                         Mar. 31/01

' Convert an 'essentially different order-5 pandiagonal magic square to 3
'  other squares by 1-3-5-2-4 row/column permutations, then each of these
'  to another square by diagonal to column transformation.
' Then obtain 24 other squares from each of these 4 by cyclical transformation
'
' The resulting solutions are saved in sequential file pan5x5.dat.
' I then open this mixed up text file in MS Word, put it into a table
' sort it (3 columns at a time starting from the right, and save it as
' Pan5x5-3600 B.doc
'
' You can also generate just the 4 variations of each of the 36 magic squares as
'  pan5x5s.dat. Open it in Word, put in a table & sort as above.
' I then edit the file back to comma delimited text and save it as Pan5x5sl.txt
' Renaming it to Pan5x5sl.dat makes it readable in Pan5Read.bas

CONST false = 0, true = NOT false

DEFINT A-Z
DECLARE SUB r2left ()                     ' move a column from the right to the left
DECLARE SUB b2top ()                      ' move a row from the bottom to the top
DECLARE SUB reflect ()                    ' reflect the magic square horizontally
DECLARE SUB rotate ()                     ' rotate the square counterclockwise
DECLARE SUB checksqr ()
DECLARE SUB cyclic ()                     ' cyclic through the 25 transformations,
                                          '  normalizing (as necessary), and saving
DECLARE SUB pan144 ()                     ' normalize (as necessary), and save

DIM sqr1(26)                              ' hold the original
DIM sqr2(26)                              ' hold square after diag to row
DIM sqr3(26)                              ' hold square after 1-3-5-2-4-
DIM sqr4(26)                              ' hold square after diag to row
DIM sqn(26)                               ' holds current cyclical permutated square
DIM sqt(26)                               ' holds temporary square
DIM sqt2(26)                              ' holds temporary square in S. R.

COMMON SHARED cntr, sqn(), sqt(), sqt2()             ' this array is used also in S.R.
cntr = 1                                  ' temporary only, to test that count actually
                                          '  equals 3600, but it spoils formatting

CLS
PRINT " Pan5x5.bas                         hh                         Mar. 31/01"

PRINT "Convert an 'essentially different order-5 pandiagonal magic square to 3"
PRINT "other squares by 1-3-5-2-4 row/column permutations, then each of these"
PRINT "to another square by diagonal to column transformation."
PRINT "Then obtain 24 other squares from each of these 4 by cyclical transformation"
PRINT
PRINT "The resulting solutions are saved in sequential file pan5x5.dat."
PRINT "I then open this mixed up text file in MS Word, put it into a table"
PRINT "sort it (3 columns at a time starting from the right, and save it as"
PRINT "Pan5x5-3600.doc"
PRINT
PRINT "You can also generate just the 4 variations of each of the 36 magic squares as"
PRINT "pan5x5s.dat. Open it in Word, put in a table & sort as above."
PRINT "I then edit the file back to comma delimited text and save it as Pan5x5sl.txt"
PRINT "Renaming it to Pan5x5sl.dat makes it readable in Pan5Read.bas"

PRINT : INPUT "Do you wish to generate only the 144 squares (4 x 36).(y/Y. anything else is no)"; flag$
IF flag$ = "y" OR flag$ = "Y" THEN flg = 1
'IF flg THEN
 '  PRINT "144"
'ELSE
 '  PRINT "3600"
'END IF
IF flg THEN                                  '  open the correct data file
   OPEN "pan5x5s.dat" FOR OUTPUT AS #1      '  the output data file for the short list
ELSE
   OPEN "pan5x5.dat" FOR OUTPUT AS #1        '  the output data file for the complete list
END IF

FOR essential = 1 TO 36                   ' *** start of main loop ***

FOR i = 1 TO 25                           ' put an essentially different square from
   READ sqr1(i)                           '   data statement into Sqr1  
NEXT

IF flg THEN
   FOR k = 1 TO 25                     '  put Sqn into Sqt for normalizing & print
      sqt(k) = sqr1(k)
   NEXT
   pan144                              ' call S.R. to normalize (if necessary) and save
END IF

' ---- convert (original) sqr1 diagonal to column and put in Sqr2 ----
sqr2(1) = sqr1(1): sqr2(2) = sqr1(7): sqr2(3) = sqr1(13): sqr2(4) = sqr1(19)
sqr2(5) = sqr1(25): sqr2(6) = sqr1(10): sqr2(7) = sqr1(11): sqr2(8) = sqr1(17)
sqr2(9) = sqr1(23): sqr2(10) = sqr1(4): sqr2(11) = sqr1(14): sqr2(12) = sqr1(20)
sqr2(13) = sqr1(21): sqr2(14) = sqr1(2): sqr2(15) = sqr1(8): sqr2(16) = sqr1(18)
sqr2(17) = sqr1(24): sqr2(18) = sqr1(5): sqr2(19) = sqr1(6): sqr2(20) = sqr1(12)
sqr2(21) = sqr1(22): sqr2(22) = sqr1(3): sqr2(23) = sqr1(9): sqr2(24) = sqr1(15)
sqr2(25) = sqr1(16)

IF flg THEN
   FOR k = 1 TO 25                     '  put Sqr2 into Sqt for normalizing & print
      sqt(k) = sqr2(k)
   NEXT
   pan144                              ' call S.R. to normalize (if necessary) and save
END IF

' ---- convert Sqr1 row/column 1-3-5-2-4 and put in Sqr3 ----
sqr3(1) = sqr1(1): sqr3(2) = sqr1(3): sqr3(3) = sqr1(5): sqr3(4) = sqr1(2)
sqr3(5) = sqr1(4): sqr3(6) = sqr1(11): sqr3(7) = sqr1(13): sqr3(8) = sqr1(15)
sqr3(9) = sqr1(12): sqr3(10) = sqr1(14): sqr3(11) = sqr1(21): sqr3(12) = sqr1(23)
sqr3(13) = sqr1(25): sqr3(14) = sqr1(22): sqr3(15) = sqr1(24): sqr3(16) = sqr1(6)
sqr3(17) = sqr1(8): sqr3(18) = sqr1(10): sqr3(19) = sqr1(7): sqr3(20) = sqr1(9)
sqr3(21) = sqr1(16): sqr3(22) = sqr1(18): sqr3(23) = sqr1(20): sqr3(24) = sqr1(17)
sqr3(25) = sqr1(19)

IF flg THEN
   FOR k = 1 TO 25                     '  put Sqr3 into Sqt for normalizing & print
      sqt(k) = sqr3(k)
   NEXT
   pan144                              ' call S.R. to normalize (if necessary) and save
END IF

' ---- convert sqr3 diagonal to column and put in Sqr4 ----
sqr4(1) = sqr3(1): sqr4(2) = sqr3(7): sqr4(3) = sqr3(13): sqr4(4) = sqr3(19)
sqr4(5) = sqr3(25): sqr4(6) = sqr3(10): sqr4(7) = sqr3(11): sqr4(8) = sqr3(17)
sqr4(9) = sqr3(23): sqr4(10) = sqr3(4): sqr4(11) = sqr3(14): sqr4(12) = sqr3(20)
sqr4(13) = sqr3(21): sqr4(14) = sqr3(2): sqr4(15) = sqr3(8): sqr4(16) = sqr3(18)
sqr4(17) = sqr3(24): sqr4(18) = sqr3(5): sqr4(19) = sqr3(6): sqr4(20) = sqr3(12)
sqr4(21) = sqr3(22): sqr4(22) = sqr3(3): sqr4(23) = sqr3(9): sqr4(24) = sqr3(15)
sqr4(25) = sqr3(16)

IF flg THEN
   FOR k = 1 TO 25                     '  put Sqr4 into Sqt for normalizing & print
      sqt(k) = sqr4(k)
   NEXT
   pan144                              ' call S.R. to normalize (if necessary) and save
END IF

IF flg THEN GOTO again                ' end the program

' --step through 25 cyclical transformations - first Sqr1, then sqr2, sqr3 and sqr4 --
' Sqn() has to be preserved for all cyclical transformations.
'  So change to Sqt() for normalizing and printing the 25 individual squares

FOR i = 1 TO 25                           ' first put Sqr1 into Sqn
   sqn(i) = sqr1(i)
NEXT

cyclic                                    ' call cyclic transformations S. R.

FOR i = 1 TO 25                           '  put Sqr2 into Sqn
   sqn(i) = sqr2(i)
NEXT

cyclic                                    ' cyclic also handles normalization

FOR i = 1 TO 25                           '  put Sqr3 into Sqn
   sqn(i) = sqr3(i)
NEXT

cyclic                                    ' cyclic also handles printing & file output

FOR i = 1 TO 25                           '  put Sqr4 into Sqn
   sqn(i) = sqr4(i)
NEXT

cyclic                                    ' call cyclic transformations S. R.
again:                                      
NEXT essential                            ' go for rest of the 36 squares

CLOSE #1
END

DATA 1,7,13,19,25,14,20,21,2,8,22,3,9,15,16,10,11,17,23,4,18,24,5,6,12  
DATA 1,7,13,20,24,15,19,21,2,8,22,3,10,14,16,9,11,17,23,5,18,25,4,6,12  
DATA 1,7,13,24,20,14,25,16,2,8,17,3,9,15,21,10,11,22,18,4,23,19,5,6,12  
DATA 1,7,13,25,19,15,24,16,2,8,17,3,10,14,21,9,11,22,18,5,23,20,4,6,12  
DATA 1,7,14,18,25,13,20,21,2,9,22,4,8,15,16,10,11,17,24,3,19,23,5,6,12  
DATA 1,7,14,20,23,15,18,21,2,9,22,4,10,13,16,8,11,17,24,5,19,25,3,6,12  
DATA 1,7,14,23,20,13,25,16,2,9,17,4,8,15,21,10,11,22,19,3,24,18,5,6,12  
DATA 1,7,14,25,18,15,23,16,2,9,17,4,10,13,21,8,11,22,19,5,24,20,3,6,12  
DATA 1,7,15,18,24,13,19,21,2,10,22,5,8,14,16,9,11,17,25,3,20,23,4,6,12  
DATA 1,7,15,19,23,14,18,21,2,10,22,5,9,13,16,8,11,17,25,4,20,24,3,6,12  
DATA 1,7,15,23,19,13,24,16,2,10,17,5,8,14,21,9,11,22,20,3,25,18,4,6,12  
DATA 1,7,15,24,18,14,23,16,2,10,17,5,9,13,21,8,11,22,20,4,25,19,3,6,12  
DATA 1,7,18,14,25,13,24,5,6,17,10,16,12,23,4,22,3,9,20,11,19,15,21,2,8  
DATA 1,7,18,15,24,13,25,4,6,17,9,16,12,23,5,22,3,10,19,11,20,14,21,2,8  
DATA 1,7,18,24,15,19,25,11,2,8,12,3,9,20,21,10,16,22,13,4,23,14,5,6,17  
DATA 1,7,18,25,14,20,24,11,2,8,12,3,10,19,21,9,16,22,13,5,23,15,4,6,17  
DATA 1,7,19,13,25,14,23,5,6,17,10,16,12,24,3,22,4,8,20,11,18,15,21,2,9  
DATA 1,7,19,15,23,14,25,3,6,17,8,16,12,24,5,22,4,10,18,11,20,13,21,2,9  
DATA 1,7,19,23,15,18,25,11,2,9,12,4,8,20,21,10,16,22,14,3,24,13,5,6,17  
DATA 1,7,19,25,13,20,23,11,2,9,12,4,10,18,21,8,16,22,14,5,24,15,3,6,17  
DATA 1,7,20,13,24,15,23,4,6,17,9,16,12,25,3,22,5,8,19,11,18,14,21,2,10  
DATA 1,7,20,14,23,15,24,3,6,17,8,16,12,25,4,22,5,9,18,11,19,13,21,2,10  
DATA 1,7,20,23,14,18,24,11,2,10,12,5,8,19,21,9,16,22,15,3,25,13,4,6,17  
DATA 1,7,20,24,13,19,23,11,2,10,12,5,9,18,21,8,16,22,15,4,25,14,3,6,17  
DATA 1,7,23,14,20,13,19,5,6,22,10,21,12,18,4,17,3,9,25,11,24,15,16,2,8  
DATA 1,7,23,15,19,13,20,4,6,22,9,21,12,18,5,17,3,10,24,11,25,14,16,2,8  
DATA 1,7,23,19,15,18,14,5,6,22,10,21,17,13,4,12,3,9,25,16,24,20,11,2,8  
DATA 1,7,23,20,14,18,15,4,6,22,9,21,17,13,5,12,3,10,24,16,25,19,11,2,8  
DATA 1,7,24,13,20,14,18,5,6,22,10,21,12,19,3,17,4,8,25,11,23,15,16,2,9  
DATA 1,7,24,15,18,14,20,3,6,22,8,21,12,19,5,17,4,10,23,11,25,13,16,2,9  
DATA 1,7,24,18,15,19,13,5,6,22,10,21,17,14,3,12,4,8,25,16,23,20,11,2,9  
DATA 1,7,24,20,13,19,15,3,6,22,8,21,17,14,5,12,4,10,23,16,25,18,11,2,9  
DATA 1,7,25,13,19,15,18,4,6,22,9,21,12,20,3,17,5,8,24,11,23,14,16,2,10  
DATA 1,7,25,14,18,15,19,3,6,22,8,21,12,20,4,17,5,9,23,11,24,13,16,2,10  
DATA 1,7,25,18,14,20,13,4,6,22,9,21,17,15,3,12,5,8,24,16,23,19,11,2,10  
DATA 1,7,25,19,13,20,14,3,6,22,8,21,17,15,4,12,5,9,23,16,24,18,11,2,10  

SUB b2top

' ----- move a row from bottom to top -----
sqt(1) = sqn(21): sqt(2) = sqn(22): sqt(3) = sqn(23): sqt(4) = sqn(24)
sqt(5) = sqn(25): sqt(6) = sqn(1): sqt(7) = sqn(2): sqt(8) = sqn(3)
sqt(9) = sqn(4): sqt(10) = sqn(5): sqt(11) = sqn(6): sqt(12) = sqn(7)
sqt(13) = sqn(8): sqt(14) = sqn(9): sqt(15) = sqn(10): sqt(16) = sqn(11)
sqt(17) = sqn(12): sqt(18) = sqn(13): sqt(19) = sqn(14): sqt(20) = sqn(15)
sqt(21) = sqn(16): sqt(22) = sqn(17): sqt(23) = sqn(18): sqt(24) = sqn(19)
sqt(25) = sqn(20)

FOR k = 1 TO 25                           ' now put sqt back into sqn
   sqn(k) = sqt(k)
NEXT

END SUB

SUB checksqr

'This sub routine checks 8 lines of the square for magic
'  It is actually to test for typos in data statements.

L1 = sqt(1) + sqt(2) + sqt(3) + sqt(4) + sqt(5)
L2 = sqt(6) + sqt(7) + sqt(8) + sqt(9) + sqt(10)
L3 = sqt(11) + sqt(12) + sqt(13) + sqt(14) + sqt(15)
L4 = sqt(16) + sqt(17) + sqt(18) + sqt(19) + sqt(20)
L5 = sqt(21) + sqt(22) + sqt(23) + sqt(24) + sqt(25)
l6 = sqt(1) + sqt(7) + sqt(13) + sqt(19) + sqt(25)       ' leading diagonal
L7 = sqt(1) + sqt(6) + sqt(11) + sqt(16) + sqt(21)       ' 1st column
L8 = sqt(3) + sqt(8) + sqt(13) + sqt(18) + sqt(23)          ' 3rd column
IF L1 + L2 + L3 + L4 + L5 + l6 + L7 + L8 <> 520 THEN STOP

' I didn't bother with other 4 lines
END SUB

SUB cyclic

' Cycle through row and column transformations by moving columns from right hand
'  side to left side. Then move a row from bottom to top, and repeat column moves, etc.
' This S. R. also looks after normalization and printing of the 25 panmagic squares.
' Magic squares enter cyclic S.R. in sqn()

' Within cyclic, they enter b2top & r2left S.R. in sqn(), but for normalizing and
'   printing they are put into sqt().

FOR i = 1 TO 5                            ' move a row from the bottom to the top
   FOR j = 1 TO 5                         ' move a column from the right to the left

      r2left                              ' call column exchange S. R.

      FOR k = 1 TO 25                     '  put Sqn into Sqt for normalizing & print
         sqt(k) = sqn(k)
      NEXT

      DO
         IF sqt(1) < sqt(5) AND sqt(1) < sqt(21) AND sqt(1) < sqt(25) THEN EXIT DO
         rotate
      LOOP

       IF sqt(2) > sqt(6) THEN reflect       ' reflect if necessary
      
      PRINT cntr;                            ' solution counter (screen only)
      FOR cell = 1 TO 25                     ' write to screen and file
         PRINT USING "###"; sqt(cell);
         PRINT #1, sqt(cell);
      NEXT
      cntr = cntr + 1: PRINT : PRINT #1,     ' increment counter and do a line feed

   NEXT j                                    ' move next column
   b2top                                     ' call row exchange S. R.
NEXT i

END SUB

SUB pan144

'This S.R. generates only the 3 squares derived from each of the 36 "essentially"
' different" squares, normalizes as necessary, and prints to data file P144.dat

'      FOR k = 1 TO 25                     '  put Sqn into Sqt for normalizing & print
 '        sqt(k) = sqn(k)
  '    NEXT

      DO
         IF sqt(1) < sqt(5) AND sqt(1) < sqt(21) AND sqt(1) < sqt(25) THEN EXIT DO
         rotate
      LOOP

       IF sqt(2) > sqt(6) THEN reflect       ' reflect if necessary
     
      PRINT cntr; : PRINT #1, cntr;          ' solution counter
      FOR cell = 1 TO 25                     ' write to screen and file
         PRINT USING "###"; sqt(cell);
         PRINT #1, sqt(cell);
      NEXT
      cntr = cntr + 1: PRINT : PRINT #1,     ' increment counter and do a line feed

END SUB

SUB r2left

' ----- move a column from right to left -----
sqt(1) = sqn(5): sqt(2) = sqn(1): sqt(3) = sqn(2): sqt(4) = sqn(3)
sqt(5) = sqn(4): sqt(6) = sqn(10): sqt(7) = sqn(6): sqt(8) = sqn(7)
sqt(9) = sqn(8): sqt(10) = sqn(9): sqt(11) = sqn(15): sqt(12) = sqn(11)
sqt(13) = sqn(12): sqt(14) = sqn(13): sqt(15) = sqn(14): sqt(16) = sqn(20)
sqt(17) = sqn(16): sqt(18) = sqn(17): sqt(19) = sqn(18): sqt(20) = sqn(19)
sqt(21) = sqn(25): sqt(22) = sqn(21): sqt(23) = sqn(22): sqt(24) = sqn(23)
sqt(25) = sqn(24)

FOR k = 1 TO 25                           ' now put sqt back into sqn
   sqn(k) = sqt(k)
NEXT

END SUB

SUB reflect

' this subroutine is called if it is necessary to reflect the magic square
' it reflects around the leading diagonal

sqt2(1) = sqt(1): sqt2(2) = sqt(6): sqt2(3) = sqt(11): sqt2(4) = sqt(16)
sqt2(5) = sqt(21): sqt2(6) = sqt(2): sqt2(7) = sqt(7): sqt2(8) = sqt(12)
sqt2(9) = sqt(17): sqt2(10) = sqt(22): sqt2(11) = sqt(3): sqt2(12) = sqt(8)
sqt2(13) = sqt(13): sqt2(14) = sqt(18): sqt2(15) = sqt(23): sqt2(16) = sqt(4)
sqt2(17) = sqt(9): sqt2(18) = sqt(14): sqt2(19) = sqt(19): sqt2(20) = sqt(24)
sqt2(21) = sqt(5): sqt2(22) = sqt(10): sqt2(23) = sqt(15): sqt2(24) = sqt(20)
sqt2(25) = sqt(25)

FOR k = 1 TO 25                           ' now put sqt2 back into sqt
   sqt(k) = sqt2(k)
NEXT
checksqr                                  ' check that this is magic
                                          ' I put it in to check for typos
END SUB

SUB rotate
' this subroutine is called if it is necessary to rotate the magic square
' it rotates counter-clockwise. It may need to be called up to 3 times.

sqt2(1) = sqt(5): sqt2(2) = sqt(10): sqt2(3) = sqt(15): sqt2(4) = sqt(20)
sqt2(5) = sqt(25): sqt2(6) = sqt(4): sqt2(7) = sqt(9): sqt2(8) = sqt(14)
sqt2(9) = sqt(19): sqt2(10) = sqt(24): sqt2(11) = sqt(3): sqt2(12) = sqt(8)
sqt2(13) = sqt(13): sqt2(14) = sqt(18): sqt2(15) = sqt(23): sqt2(16) = sqt(2)
sqt2(17) = sqt(7): sqt2(18) = sqt(12): sqt2(19) = sqt(17): sqt2(20) = sqt(22)
sqt2(21) = sqt(1): sqt2(22) = sqt(6): sqt2(23) = sqt(11): sqt2(24) = sqt(16)
sqt2(25) = sqt(21)

FOR k = 1 TO 25                           ' now put sqt2 back into sqt
   sqt(k) = sqt2(k)
NEXT

checksqr                                  ' put in to check for data statement typos

END SUB