' 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