' FourSqr.bas July/00 H.Heinz
' This program finds all 880 magic square solutions for order-4 and lists them in index order.
' It is adapted from Star_8A.bas testing each line for correct sum before proceding.
' Columns 1 and 2 are also tested as soon as possible with program proceding only if O.K.
' Columns and main diagonals are then tested. If incorrect,stepping through numbers continues.
' The numbers are presented row by row, with 'a' being the first (leftmost)
' number in the first row. 'e' is the leftmost number in the second row, etc.
' To generate the solutions in index order
' 'a' is stepped from 1 to 7
' 'd','m',' p' are stepped from 'a' + 1 to 16 (other 3 corners)
' 'e' is stepped from 'b' + 1 to 16
' all others are stepped from 1 to 16.
' The results are listed to the screen and also save in data file FourSqr.dat
' Group # is composed as follows: xxyz: xx = group, z = 1 for semi-pan, 2 for simple (group 6
' y=1 for original orientation, 2 for 90 degree rotation, 3 for 180 degree, 4 for 270 degree
DEFINT A-Z
CONST false = 0, true = NOT false
DIM used(1 TO 16) ' store the number in location corresponding to letter
COMMON SHARED used(), index, nflag
DECLARE SUB clearused () ' cleared the array at & above the current position
DECLARE SUB usedtest (number) ' tests if the integer has already been used
nflag = false ' usedtest() returns true for nflag if number not used
index = 1 ' this is the current position & indicates so in used array
counter = 0 ' count the solutions
sum = 34 ' this is the magic constant for an 8-point star
space = 111 ' insert special character for find and repale by Word
CLS
PRINT "July/00 FourSqr.bas hh"
PRINT : PRINT "This program finds all combinations of the numbers from 1 to 16 that form"
PRINT "Basic solutions for the order-4 magic square. ** Press 'esc' to end program **"
PRINT "The solutions are arranged in index order (Frenicle)."
PRINT "This output is also being saved in FourSqr.dat. "
PRINT "Place these numbers in row order, starting with the top left cell."
PRINT "Group =xxyz; xx = group, y = 1 for normal orientation, 2 for 90 degree, z = 1 for semi-pan, 2 for simple (group 6)"
PRINT : INPUT "Do you wish a hardcopy list (Y/y, anything else is no)"; response$
IF response$ = "Y" OR response$ = "y" THEN pflag = true
PRINT "index # a b c d e f g h i j k l m n o p "
IF pflag THEN
LPRINT "July/00 FourSqr.bas hh"
LPRINT "Basic solutions for the order-4 magic square."
LPRINT "The solutions are arranged in index order (Frenicle)."
LPRINT "This output is also saved in FourSqr.dat. "
LPRINT "Place these numbers in row order, starting with the top left cell."
LPRINT : LPRINT "index # Group a b c d e f g h i j k l m n o p "
LineNum = 7
END IF
OPEN "FourSqr.dat" FOR OUTPUT AS #1 ' open to start a NEW data file
CLOSE #1
FOR a = 1 TO 7 ' this covers all basic solutions
used(1) = a ' show this number used
FOR b = 1 TO 15 ' position 2, b 16 THEN EXIT FOR
LOOP
FOR c = 1 TO 16 ' position 3
nflag = false: index = 3 ' nflag will be true when an unused # is found
clearused ' clear from this posit. up (to free up unused #'s
DO UNTIL nflag = true
usedtest (c) ' is this number used?
IF NOT nflag THEN c = c + 1 ' yes, so get next number
IF c > 16 THEN EXIT FOR
LOOP
FOR d = a + 1 TO 16 ' pos. 4 - d>a condition for indexing
nflag = false: index = 4
clearused
DO UNTIL nflag = true
firstline: usedtest (d) ' loop until 1st line is O.K.
IF NOT nflag THEN d = d + 1
IF d > 16 THEN EXIT FOR
IF a + b + c + d <> 34 THEN ' make first line correct before proceeding
d = d + 1
IF d > 16 THEN EXIT FOR ' i.e. go back for next c
GOTO firstline
END IF
LOOP
FOR e = b + 1 TO 16 ' position 5, e>b condition for indexing
nflag = false: index = 5
clearused
DO UNTIL nflag = true
usedtest (e)
IF NOT nflag THEN e = e + 1
IF e > 16 THEN EXIT FOR ' i.e. go back for next d
LOOP
FOR f = 1 TO 16 ' position 6
nflag = false: index = 6 ' nflag will be true when an unused # is found
clearused ' clear from this posit. up (to free up unused #'s
DO UNTIL nflag = true
usedtest (f) ' is this number used?
IF NOT nflag THEN f = f + 1 ' yes, so get next number
IF f > 16 THEN EXIT FOR ' i.e. go back for next e
LOOP
FOR g = 1 TO 16 ' position 7
nflag = false: index = 7
clearused
DO UNTIL nflag = true
usedtest (g)
IF NOT nflag THEN g = g + 1
IF g > 16 THEN EXIT FOR ' i.e. go back for next f
LOOP
FOR h = 1 TO 16 ' position 8
nflag = false: index = 8
clearused
DO UNTIL nflag = true
secondline: usedtest (h) ' loop until 2nd line is O.K.
IF NOT nflag THEN h = h + 1
IF h > 16 THEN EXIT FOR ' i.e. go back for next g
IF e + f + g + h <> 34 THEN ' make second line correct before proceeding
h = h + 1
IF h > 16 THEN EXIT FOR ' i.e. go back for next g
GOTO secondline ' loop to make 2nd line correct
END IF
LOOP
linepos = CSRLIN ' show the program is running and progress
LOCATE 25, 10: PRINT a; b; c; d; " "; e; f; g; h, " a to h ";
LOCATE linepos, 1
FOR i = 1 TO 16 ' position 9
nflag = false: index = 9 ' nflag will be true when an unused # is found
clearused ' clear from this posit. up (to free up unused #'s
DO UNTIL nflag = true
usedtest (i) ' is this number used?
IF NOT nflag THEN i = i + 1 ' yes, so get next number
IF i > 16 THEN EXIT FOR ' go back for next h
LOOP
FOR j = 1 TO 16 ' position 10
nflag = false: index = 10
clearused
DO UNTIL nflag = true
usedtest (j) ' loop to make 3rd line O.K.
IF NOT nflag THEN j = j + 1
IF j > 16 THEN EXIT FOR ' i.e. go back for next i
LOOP
FOR k = 1 TO 16 ' position 11
nflag = false: index = 11
clearused
DO UNTIL nflag = true
usedtest (k)
IF NOT nflag THEN k = k + 1
IF k > 16 THEN EXIT FOR ' i.e. go back for next j
LOOP
FOR l = 1 TO 16 ' position 12
nflag = false: index = 12
clearused
DO UNTIL nflag = true
thirdline: ' get correct third line before continuing
usedtest (l) ' is this number used?
IF NOT nflag THEN l = l + 1 ' yes, so get next number
IF l > 16 THEN EXIT FOR ' get next k
IF i + j + k + l <> 34 THEN ' make third line correct before proceeding
l = l + 1
IF l > 16 THEN EXIT FOR ' i.e. go back for next k
GOTO thirdline ' loop until line 3 is correct
END IF
LOOP
FOR m = a + 1 TO 16 ' position 13 - m>a condition for indexing
nflag = false: index = 13
clearused
DO UNTIL nflag = true
firstcol: ' get correct third line before continuing
usedtest (m) ' is this number used?
IF NOT nflag THEN m = m + 1 ' yes, so get next number
IF m > 16 THEN EXIT FOR ' get next l
IF a + e + i + m <> 34 THEN ' make 1st column correct before proceeding
m = m + 1
IF m > 16 THEN EXIT FOR ' i.e. go back for next m
GOTO firstcol ' loop until column 1 is correct
END IF
LOOP
FOR n = 1 TO 16 ' position 14
nflag = false: index = 14
clearused
DO UNTIL nflag = true
secondcol: ' make 2nd column correct before continuing
usedtest (n) ' is this number used?
IF NOT nflag THEN n = n + 1 ' yes, so get next number
IF n > 16 THEN EXIT FOR ' get next m
IF b + f + j + n <> 34 THEN ' make 1st column correct before proceeding
n = n + 1
IF n > 16 THEN EXIT FOR ' i.e. go back for next m
GOTO secondcol ' loop until line 3 is correct
END IF
LOOP
FOR o = 1 TO 16 ' position 15
nflag = false: index = 15 ' nflag will be true when an unused # is found
clearused ' clear from this posit. up (to free up unused #'s
DO UNTIL nflag = true
usedtest (o) ' is this number used?
IF NOT nflag THEN o = o + 1 ' yes, so get next number
IF o > 16 THEN EXIT FOR
LOOP
FOR p = a + 1 TO 16 ' position 16 - p>a condition for indexing
nflag = false: index = 16
clearused
DO UNTIL nflag = true ' is not necessary as this is the last spot
forthline: ' get correct forth line before continuing
usedtest (p) ' is this number used?
IF NOT nflag THEN p = p + 1 ' yes, so get next number
IF p > 16 THEN EXIT FOR
IF m + n + o + p <> 34 THEN
p = p + 1
IF p > 16 THEN EXIT FOR ' get next o
GOTO forthline
END IF
LOOP
IF c + g + k + o <> 34 THEN GOTO notmagic 'test last 2 columns and 2 diagonals
IF d + h + l + p <> 34 THEN GOTO notmagic
IF a + f + k + p <> 34 THEN GOTO notmagic
IF m + j + g + d <> 34 THEN GOTO notmagic
group = 0 'reset to 0 to help debug
IF a + k = 17 THEN group = 100 ' find group # for this magic square
IF a + f = 17 THEN group = 200
IF a + p = 17 THEN group = 300
IF a + e = 17 AND b + f = 17 THEN group = 410
IF a + b = 17 AND e + f = 17 THEN group = 420
IF a + i = 17 AND c + k = 17 THEN group = 510
IF a + c = 17 AND i + k = 17 THEN group = 520
IF a + m = 17 AND b + n = 17 THEN IF e + b + o + l = 34 THEN group = 611 ELSE group = 612
IF a + d = 17 AND e + h = 17 THEN IF e + b + o + l = 34 THEN group = 621 ELSE group = 622
IF a + m = 17 AND b + f = 17 THEN group = 710
IF a + d = 17 AND g + h = 17 THEN group = 720
IF a + i = 17 AND b + n = 17 THEN group = 810
IF a + c = 17 AND e + h = 17 THEN group = 820
IF a + e = 17 AND b + n = 17 THEN group = 910
IF a + b = 17 AND e + h = 17 THEN group = 920
IF a + m = 17 AND b + j = 17 THEN group = 1010
IF a + d = 17 AND f + h = 17 THEN group = 1020
IF a + e = 17 AND b + h = 17 THEN group = 1110
IF a + b = 17 AND g + p = 17 THEN group = 1120
IF a + g = 17 AND d + h = 17 THEN group = 1130
IF a + j = 17 AND o + p = 17 THEN group = 1140
IF a + i = 17 AND c + l = 17 THEN group = 1210
IF a + c = 17 AND j + p = 17 THEN group = 1220
IF a + j = 17 AND d + l = 17 THEN group = 1230
IF a + g = 17 AND n + p = 17 THEN group = 1240
counter = counter + 1 ' and solution number
PRINT USING "###"; counter; : PRINT " ";
PRINT USING "####"; group; : PRINT " ";
PRINT USING "###"; a; b; c; d; : PRINT " ";
PRINT USING "###"; e; f; g; h; : PRINT " ";
PRINT USING "###"; i; j; k; l; : PRINT " ";
PRINT USING "###"; m; n; o; p
IF pflag THEN
LPRINT counter; " "; a; b; c; d; " "; e; f; g; h; " "; i; j; k; l; " "; m; n; o; p
LineNum = LineNum + 1
IF LineNum = 64 THEN LineNum = 2: LPRINT : LPRINT : LPRINT : LPRINT
END IF
OPEN "FourSqr.dat" FOR APPEND AS #1 ' and write to file
WRITE #1, counter, space, group, space, a, b, c, d, space, e, f, g, h, space, i, j, k, l, space, m, n, o, p
CLOSE #1
notmagic: ' columns or diagonals are not magic so continue
IF INKEY$ = CHR$(27) THEN END ' exit program if 'esc' pressed
NEXT p, o, n, m, l, k, j, i, h, g, f, e, d, c, b ' go find more solutions
NEXT a ' increment the first position
PRINT : PRINT "index # Group a b c d e f g h i j k l m n o p "
PRINT startDate$; " "; startTime$; " "; DATE$; " "; TIME$ ' record length of run
IF pflag THEN
LPRINT : LPRINT "index # a b c d e f g h i j k l m n o p "
LPRINT startDate$; " "; startTime$; " "; DATE$; " "; TIME$, "Run completed !" ' record length of run
END IF
END
SUB clearused
' resets the used() array for the position of letter calling & all above
' this is done when incrementing a previous position so all subsequent positions are
' vacant and the numbers previously used for them are freed up
FOR index2 = index TO 16
used(index2) = 0
NEXT index2
END SUB
SUB usedtest (number)
' test if a number is used yet
' number is the number to be tested
FOR index2 = 1 TO 16 ' search to see if number being used
IF used(index2) = number THEN ' yes so indicate
nflag = false
EXIT FOR ' and end search
ELSE
nflag = true ' no (this will toggle, final is what counts
END IF
NEXT index2
IF nflag = true THEN used(index) = number ' OK so store this number @ correct position
END SUB