[= Demo - Magic Square Command: magic.bat Algorithms from :- http://www.1728.org/magicsq2.htm http://www.1728.org/magicsq3.htm Purpose: =] [= Type for the actual grid of numbers - an open 2D array =] Type TGrid = Number[,]; Type TAssend = Logical[0 To 3, 0 To 3]; Const Number MaxOrder = 32; [= PROGRAM ------- =] Program(Number order = 3) TGrid maingrid; Logical ok; Begin [= check that order is in range =] If order < 3 Or order > MaxOrder Then TextBlock("order out of range ( 3 to " + Format(MaxOrder) + " )"); Return; EndIf; [= set everything up =] If Not Setup(order, maingrid) Then Return; EndIf; If order Mod 2 == 1 Then ok := OddSquare(order, maingrid); ElseIf order Mod 4 == 0 Then ok := DoublyEven(order, maingrid); Else ok := SinglyEven(order, maingrid); EndIf; If ok Then [=Output maingrid;=] [= always a good idea to have internal checks =] If CheckGrid(order, maingrid) Then Grid(maingrid, (Canvas.width - 20) // order) => {10, 10}; EndIf; EndIf; OnError [= we really should not get here =] Output "**** unexpected error"; Output Status; End; [= SETUP ----- =] Function Logical Setup(Number order, Ref TGrid maingrid) Begin maingrid := Array(order, order); Return True; End; [= ODD SQUARE ---------- =] Function Logical OddSquare(Number order, Ref TGrid grid) Number row, col, nextrow, nextcol; Number n; Logical done; Begin [= set up the first square =] row := 1; col := ( order + 1 ) // 2; grid[row, col] := 1; For n From 2 To order * order Do [= try up right =] If row == 1 Then nextrow := order; Else nextrow := row - 1; EndIf; If col == order Then nextcol := 1; Else nextcol := col + 1; EndIf; [= see if cell already filled =] If grid[nextrow, nextcol] <> Null Then [= need to move down =] If row == order Then nextrow := 1; Else nextrow := row + 1; EndIf; [= column does not change =] nextcol := col; EndIf; [= update the coordinates =] row := nextrow; col := nextcol; [= fill in the target square =] grid[row, col] := n; EndFor; Return True; End; [= SINGLY EVEN ----------- Use single even i.e. 4k + 2. =] Function Logical SinglyEven(Number order, Ref TGrid grid) Number suborder = order // 2, submax = suborder * suborder; TGrid subgrid; Number row, col, val, shift; Begin [= allocate a sub-grid =] subgrid := Array(suborder, suborder); [= create the quadrans square =] If Not OddSquare(suborder, subgrid) Then Return False; EndIf; [= do the ADCB fill =] For row From 1 To suborder Do For col From 1 To suborder Do val := subgrid[row, col]; grid[row, col] := val; grid[row, col + suborder ] := val + submax * 2; grid[row + suborder, col ] := val + submax * 3; grid[row + suborder, col + suborder ] := val + submax * 1; EndFor; EndFor; [= do the left fixup =] For row From 1 To suborder Do [= see if special middle row case =] If row == ( suborder + 1 ) // 2 Then shift := 1; Else shift := 0; EndIf; For col From 1 To ( suborder - 1 ) // 2 Do [= save bottom value =] val := grid[row + suborder, col + shift]; [= over write with top value =] grid[row + suborder, col + shift] := grid[row, col + shift]; [= overwrite top with saved value =] grid[row, col + shift] := val; EndFor; EndFor; [= do the right fixup =] If suborder > 3 Then [= do the right fixup =] For col From order - ( suborder - 3 ) // 2 + 1 To order Do For row From 1 To suborder Do [= save the bottom value =] val := grid[row + suborder, col]; [= move top to bottom =] grid[row + suborder, col] := grid[row, col]; [= replace the top =] grid[row, col] := val; EndFor; EndFor; EndIf; Return True; End; [= DOUBLY EVEN ----------- Use single even i.e. 4k. =] Function Logical DoublyEven(Number order, Ref TGrid grid) [= flag array for asssend or decending =] TAssend assend = [ [False, True , True , False], [True , False, False, True ], [True , False, False, True ], [False, True , True , False] ]; Number row, col, index, indexmax; Begin index := 1; indexmax := order * order; For row From 1 To order Do For col From 1 To order Do If assend[(row - 1) // ( order // 4), (col - 1) // ( order // 4)] Then grid[row, col] := index; Else grid[row, col] := indexmax - index + 1; EndIf; index += 1; EndFor; EndFor; Return True; End; [= GRID ---- =] Shape Grid(TGrid grid, Number cellsize) Number order; Number r, c; TFont textfont; Begin order := ArrayHigh(grid, 1); textfont := Font { size -> cellsize // 2 }; For r From 0 To order Do Line( {0, r * cellsize}, {order * cellsize, r * cellsize} ); Line( {r * cellsize, 0}, {r * cellsize, order * cellsize} ); EndFor; For r From 1 To order Do For c From 1 To order Do TextBlock(Format(grid[r,c]), halign -> Centre, valign -> Centre) => { c * cellsize - cellsize // 2, r * cellsize - cellsize // 2 }, textfont; EndFor; EndFor; End; [= CHECK GRID ----------- Check all rows, columns, and diagonals. =] Function Logical CheckGrid(Number order, Const Ref TGrid grid) Number i, r, rsum, csum, expsum; Begin [= get the expected sum =] expsum := ExpectSum(order); [= go through rows and columns together =] For r From 1 To order Do [= clear the sums =] rsum := 0; csum := 0; [= go through all elements =] For i From 1 To order Do rsum += grid[r, i]; csum += grid[i, r]; EndFor; [= check them =] If rsum <> expsum Then Output "error row ", r; Return False; EndIf; If csum <> expsum Then Output "error column ", r; Return False; EndIf; EndFor; [= do the diagonals =] rsum := 0; csum := 0; For i From 1 To order Do rsum += grid[i,i]; csum += grid[i,order - i + 1]; EndFor; If rsum <> expsum Then Output "error in leading diagonal"; Return False; EndIf; If csum <> expsum Then Output "error in reverse diagonal"; Return False; EndIf; [= reached here so all ok =] Return True; End; [= EXPECT SUM ---------- Calculate the expected sum for each row/column/diagonal. This is only used for checking. =] Function Number ExpectSum(Number order) Begin Return order * ( order * order + 1 ) // 2; End;