Number of normal magic order-6 squares (estimate)

gb32 source code - Walter Trump - w@trump.de - 2001

sqWin("2001-10-17 - Version 2.19")
sqInitVar
sqMain
sqEnd
'magic ~ord6~max34~mag99

Proc sqWin(ByVal s As String)
  FullW 1 : Me.Caption = "regular magic 6x6-squares - Walter Trump - (c) 2001-08-31 to " + s
  :         Me.AutoRedraw = 1 : Me.SetFont "Courier New", _Y Div 50, 1
  :         Me.ControlBox = False : Me.Visible = True

Proc sqInitVar
  Global StartTime As Double = Timer
  Global Nos       As Int = 0           // Number of squares for a special corner
  Global Int aTotal, bTotal, Total      // Number of total squares
  Global StoRed As Double = 1           // Stochastic Reduction
  Global TrfRed As Double = 24           // Transformation Reduction
  ' start 1x ----------
  StoRed *= 01  // i11 fix
  StoRed *= 01  // i21 for
  StoRed *= 01  // i31 for
  StoRed *= 01  // i41 for
  StoRed *= 01  // i51 for
  StoRed *= 01  // i61 calc
  ' updiag
  StoRed *= 01  // i16 for
  StoRed *= 29  // i52 rand
  StoRed *= 28  // i25 rand
  StoRed *= 01  // i34 w
  StoRed *= 01  // i43 w
  ' col 2 -------------
  StoRed *= 25  // i26 rand
  StoRed *= 24  // i22 rand
  StoRed *= 01  // i23 w
  StoRed *= 01  // i24 w
  ' downdiag
  StoRed *= 21  // i55 rand
  StoRed *= 20  // i66 rand
  StoRed *= 19  // i33 rand
  StoRed *= 01  // i44 w
  ' col 5 -------------
  StoRed *= 17  // i56 rand
  StoRed *= 16  // i53 rand
  StoRed *= 01  // i54 w
  ' row 6 -------------
  StoRed *= 01  // i36 w
  StoRed *= 01  // i46 w
  ' col 3 -------------
  StoRed *= 01  // i32 w
  StoRed *= 01  // i32 w
  ' col 4 -------------
  StoRed *= 01  // i42 w
  StoRed *= 01  // i45 w
  ' row 3 -------------
  StoRed *= 01  // i13 w
  StoRed *= 01  // i63 w
  ' row 4 -------------
  StoRed *= 01  // i14 w
  StoRed *= 01  // i64 w
  ' Lastcells
  StoRed *= 01  // i12 w
  StoRed *= 01  // i62 w
  StoRed *= 01  // i15 calc
  StoRed *= 01  // i65 correct
  '
  Global Int i = 0 , s245, s24                         // Counter
  Global Int i11, i21, i31, i41, i51, i61    // Numbers in the 1. row
  Global Int i12, i22, i32, i42, i52, i62    // Numbers in the 2. row
  Global Int i13, i23, i33, i43, i53, i63    // Numbers in the 3. row
  Global Int i14, i24, i34, i44, i54, i64    // Numbers in the 4. row
  Global Int i15, i25, i35, i45, i55, i65    // Numbers in the 5. row
  Global Int i16, i26, i36, i46, i56, i66    // Numbers in the 6. row
  Global Byte st(-100 ... 200)       // Status of a number (1 = available, 0 = not available)
  ArrayFill st(), 0
  For i = -1 To 34 : st(i) = 1 : End For // Numbers from -1 to 34 are available
  ' We use numbers from -1 to 34, this allows faster calculations of random-numbers
  ' and makes a magic constant of 99.
  ' InitFile
  Global String FileRoot = "Normal-6x6-" + App.ComputerName + "-", sqFile = ""
  i = 0 : Do : i++ : Exit If i > 99 : sqFile = FileRoot + Dec(i, 2) + ".txt"
  Loop While Exist(sqFile)
  Open sqFile for Output As # 1
  Print # 1, "Normal magic 6x6-squares Estimate - Walter Trump 2001-08"
  Print # 1, "Reduction by transformations:"; TrfRed
  Print # 1, "Stochastic Reduction:"; StoRed
  Commit # 1
End Proc

Proc sqMain
  Do
    Print AT(32, 1); "a =       "; : Print AT(45, 1); "b =        ";
    Print AT(1, 3); " Magic 6x6-squares - Estimation"
    Print " Exit with [Esc]"
    Nos = 0 : start1x
    aTotal = Nos
    Nos = 0 : startx1
    bTotal = Nos
    Print AT(5, 6); "a ="; Str(aTotal, 5);
    Print AT(5, 7); "b ="; Str(bTotal, 5);
    Total = aTotal + bTotal
    Print AT(5, 8); "c ="; Str(Total, 5); " * "; TrfRed; " *"; StoRed
    Print AT(5, 9); "c ="; TrfRed * StoRed * Total
    Print : Print " Calculation-time in s: " ; Round(Timer - StartTime, 3)
    ' File-Output
    Print # 1, "a ="; aTotal
    Print # 1, "b ="; bTotal
    Print # 1, "c ="; TrfRed * StoRed * Total
  Nos = 0 : StartTime = Timer : Loop
End Proc

Proc start1x()  Naked
  $StepOff : $ArrayCheckOff
  i11 = -1 : st(i11) = 0
  Print AT(10, 1); "-1 xx xx xx xx xx";
  For i21 = 0 To 31 : st(i21) = 0
    Print AT(13, 1); Dec(i21, 2);
    For i31 = i21 + 1 To 33 : If st(i31) : st(i31) = 0
        Print AT(16, 1); Dec(i31, 2);
        Print AT(35, 1); Str(Nos, 7)
        PeekEvent
        For i41 = i31 + 1 To 34 : If st(i41) : st(i41) = 0
            For i51 = i21 + 1 To 34 : If st(i51) : st(i51) = 0
                i61 = 99 - (i11 + i21 + i31 + i41 + i51) : If st(i61) : st(i61) = 0
                  upDiagonal_a
                st(i61) = 1 : End If
            st(i51) = 1 : End If : End For
        st(i41) = 1 : End If : End For
    st(i31) = 1 : End If : End For
  st(i21) = 1 : End For
  st(i11) = 1
End Proc

Proc upDiagonal_a()  Naked
  $StepOff : $ArrayCheckOff
  For i16 = i61 + 1 To 34 : If st(i16) : st(i16) = 0
      Repeat : i52 = Rand(35) : Until st(i52) : st(i52) = 0
      Repeat : i25 = Rand(35) : Until st(i25) : st(i25) = 0
      i34 = 0 : i43 = 99 - i16 - i25 - i52 - i61
      If i43 > 34 Then i34 = i43 - 34 : i43 = 34
      Do While i34 < i43
        If st(i34) And st(i43)
          st(i34) = 0 : st(i43) = 0
          Col_2_a
          st(i34) = 1 : st(i43) = 1
        End If
      i34++ : i43-- : Loop
      st(i25) = 1
      st(i52) = 1
  st(i16) = 1 : End If :  End For
  ' m*gic ~col2~rnd2~lft34~nxt downdiagonal

Proc Col_2_a() Naked
  $StepOff : $ArrayCheckOff
  Repeat : i26 = Rand(35) : Until st(i26) : st(i26) = 0
  Repeat : i22 = Rand(35) : Until st(i22) : st(i22) = 0
  i23 = 0 : i24 = 99 - i21 - i22 - i25 - i26
  If i24 > 34 Then i23 = i24 - 34 : i24 = 34
  Do While i23 < i24
    If st(i23) And st(i24)
      st(i23) = 0 : st(i24) = 0
      downDiagonal
      st(i23) = 1 : st(i24) = 1
    End If
  i23++ : i24-- : Loop
  st(i22) = 1
  st(i26) = 1

Proc startx1()  Naked
  $StepOff : $ArrayCheckOff
  i21 = -1 : st(i21) = 0
  Print AT(13, 1); "-1 xx xx xx xx";
  For i11 = 0 To 33 : st(i11) = 0
    Print AT(10, 1); Dec(i11, 2);
    For i61 = i11 + 1 To 34 : If st(i61) : st(i61) = 0
        Print AT(25, 1); Dec(i61, 2);
        Print AT(48, 1); Str(Nos, 7)
        PeekEvent
        For i51 =  0 To 33 : If st(i51) : st(i51) = 0
            i31 = 0 : i41 = 99 - i11 - i21 - i51 - i61
            If i41 > 34 Then i31 = i41 - 34 : i41 = 34
            Do While i31 < i41
              If st(i31) And st(i41)
                st(i31) = 0 : st(i41) = 0
                Col_2_b
                st(i31) = 1 : st(i41) = 1
              End If
            i31++ : i41-- : Loop
        st(i51) = 1 : End If : End For
    st(i61) = 1 : End If : End For
  st(i11) = 1 : End For
  st(i21) = 1

Proc Col_2_b() Naked
  $StepOff : $ArrayCheckOff
  For i26 = i51 + 1 To 34 : If st(i26) : st(i26) = 0
      Repeat : i22 = Rand(35) : Until st(i22) : st(i22) = 0
      Repeat : i25 = Rand(35) : Until st(i25) : st(i25) = 0
      i23 = 0 : i24 = 99 - i21 - i22 - i25 - i26
      If i24 > 34 Then i23 = i24 - 34 : i24 = 34
      Do While i23 < i24
        If st(i23) And st(i24)
          st(i23) = 0 : st(i24) = 0
          upDiagonal_b
          st(i23) = 1 : st(i24) = 1
        End If
      i23++ : i24-- : Loop
      st(i25) = 1
      st(i22) = 1
  st(i26) = 1 : End If : End For

Proc upDiagonal_b()  Naked
  $StepOff : $ArrayCheckOff
  Repeat : i16 = Rand(35) : Until st(i16) : st(i16) = 0
  Repeat : i52 = Rand(35) : Until st(i52) : st(i52) = 0
  i34 = 0 : i43 = 99 - i16 - i25 - i52 - i61
  If i43 > 34 Then i34 = i43 - 34 : i43 = 34
  Do While i34 < i43
    If st(i34) And st(i43)
      st(i34) = 0 : st(i43) = 0
      downDiagonal
      st(i34) = 1 : st(i43) = 1
    End If
  i34++ : i43-- : Loop
  st(i52) = 1
  st(i16) = 1
  ' m*gic ~col2~rnd2~lft34~nxt downdiagonal

Proc downDiagonal() Naked
  $StepOff : $ArrayCheckOff
  Repeat : i55 = Rand(35) : Until st(i55) : st(i55) = 0
  Repeat : i66 = Rand(35) : Until st(i66) : st(i66) = 0
  Repeat : i33 = Rand(35) : Until st(i33) : st(i33) = 0
  i44 = 99 - i11 - i22 - i33 - i55 - i66 : If st(i44) : st(i44) = 0
    Col_5
  st(i44) = 1 : End If
  st(i33) = 1
  st(i66) = 1
  st(i55) = 1
  ' m*gic ~col5~rnd6~lft34~nxt row_6

Proc Col_5() Naked
  $StepOff : $ArrayCheckOff
  Repeat : i56 = Rand(35) : Until st(i56) : st(i56) = 0
  Repeat : i53 = Rand(35) : Until st(i53) : st(i53) = 0
  i54 = 99 - i51 - i52 - i53 - i55 - i56
  If st(i54) : st(i54) = 0
    Row_6
  st(i54) = 1 : End If
  st(i53) = 1
  st(i56) = 1
  ' m*gic ~row6~lft34~nxt col_3

Proc Row_6() Naked
  $StepOff : $ArrayCheckOff
  i36 = 0 : i46 = 99 - i16 - i26 - i56 - i66
  If i46 > 34 Then i36 = i46 - 34 : i46 = 34
  Do While i36 < i46
    If st(i36) And st(i46)
      st(i36) = 0 : st(i46) = 0
      Dim h As Register Int
      Col_3 : h = i36 : i36 = i46 : i46 = h
      Col_3 : h = i34 : i34 = i43 : i43 = h
      Col_3 : h = i36 : i36 = i46 : i46 = h
      Col_3 : h = i34 : i34 = i43 : i43 = h
      st(i36) = 1 : st(i46) = 1
    End If
  i36++ : i46-- : Loop
  ' m*gic ~col3~lft25~nxt col_4

Proc Col_3() Naked
  $StepOff : $ArrayCheckOff
  i32 = 0 : i35 = 99 - i31 - i33 - i34 - i36
  If i35 > 34 Then i32 = i35 - 34 : i35 = 34
  Do While i32 < i35
    If st(i32) And st(i35)
      st(i32) = 0 : st(i35) = 0
      Col_4
      st(i32) = 1 : st(i35) = 1
    End If
  i32++ : i35-- : Loop

Proc Col_4() Naked
  $StepOff : $ArrayCheckOff
  Dim h As Register Int
  i42 = 0 : i45 = 99 - i41 - i43 - i44 - i46
  If i45 > 34 Then i42 = i45 - 34 : i45 = 34
  Do While i42 < i45
    If st(i42) And st(i45)
      st(i42) = 0 : st(i45) = 0
      Row_3 : h = i23 : i23 = i24 : i24 = h
      Row_3 : h = i23 : i23 = i24 : i24 = h
      st(i42) = 1 : st(i45) = 1
    End If
  i42++ : i45-- : Loop
  ' m*gic ~row3~lft16~nxt row_4

Proc Row_3() Naked
  $StepOff : $ArrayCheckOff
  i13 = 0 : i63 = 99 - i23 - i33 - i43 - i53
  If i63 > 34 Then i13 = i63 - 34 : i63 = 34
  Do While i13 < i63
    If st(i13) And st(i63)
      st(i13) = 0 : st(i63) = 0
      Row_4
      st(i13) = 1 : st(i63) = 1
    End If
  i13++ : i63-- : Loop
  ' m*gic ~row4~lft16~nxt lastcells

Proc Row_4() Naked
  $StepOff : $ArrayCheckOff
  i14 = 0 : i64 = 99 - i24 - i34 - i44 - i54
  If i64 > 34 Then i14 = i64 - 34 : i64 = 34
  Do While i14 < i64
    If st(i14) And st(i64)
      st(i14) = 0 : st(i64) = 0
      Dim h As Register Int
      LastCells : h = i42 : i42 = i45 : i45 = h
      LastCells : h = i32 : i32 = i35 : i35 = h
      LastCells : h = i42 : i42 = i45 : i45 = h
      LastCells : h = i32 : i32 = i35 : i35 = h
      st(i14) = 1 : st(i64) = 1
    End If
  i14++ : i64-- : Loop

Proc LastCells()  Naked
  $StepOff : $ArrayCheckOff
  i12 = 0 : i62 = 99 - (i22 + i32 + i42 + i52)
  If i62 > 34 Then i12 = i62 - 34 : i62 = 34
  Do While i12 < i62
    If st(i12) And st(i62)
      st(i12) = 0 : st(i62) = 0
      Dim h As Register Int
      Dim c1 As Register Int
      c1 = 99 - i11 - i13 - i16
      h = i12 : i12 = i62 : i62 = h : i15 = c1 - i12 - i14 : If st(i15) Then Nos++
      h = i14 : i14 = i64 : i64 = h : i15 = c1 - i12 - i14 : If st(i15) Then Nos++
      h = i12 : i12 = i62 : i62 = h : i15 = c1 - i12 - i14 : If st(i15) Then Nos++
      h = i14 : i14 = i64 : i64 = h : i15 = c1 - i12 - i14 : If st(i15) Then Nos++
      h = i13 : i13 = i63 : i63 = h
      c1 = 99 - i11 - i13 - i16
      h = i12 : i12 = i62 : i62 = h : i15 = c1 - i12 - i14 : If st(i15) Then Nos++
      h = i14 : i14 = i64 : i64 = h : i15 = c1 - i12 - i14 : If st(i15) Then Nos++
      h = i12 : i12 = i62 : i62 = h : i15 = c1 - i12 - i14 : If st(i15) Then Nos++
      h = i14 : i14 = i64 : i64 = h : i15 = c1 - i12 - i14 : If st(i15) Then Nos++
      h = i13 : i13 = i63 : i63 = h
      st(i12) = 1 : st(i62) = 1
    End If
  i12++ : i62-- : Loop
End Proc

Proc Test
  $StepOff : $ArrayCheckOff
  Local Int k
  i65 = 99 - i61 - i62 - i63 - i64 - i66
  st(i15) = 0 : st(i65) = 0
  For k = -1 To 34
    If st(k) <> 0 Then Fehler(100 + k)
  End For
  st(i15) = 1 : st(i65) = 1
  ' rows
  If i11 + i21 + i31 + i41 + i51 + i61 <> 99
  Fehler(11) : End If
  If i12 + i22 + i32 + i42 + i52 + i62 <> 99
  Fehler(12) : End If
  If i13 + i23 + i33 + i43 + i53 + i63 <> 99
  Fehler(13) : End If
  If i14 + i24 + i34 + i44 + i54 + i64 <> 99
  Fehler(14) : End If
  If i15 + i25 + i35 + i45 + i55 + i65 <> 99
  Fehler(15) : End If
  If i16 + i26 + i36 + i46 + i56 + i66 <> 99
  Fehler(16) : End If
  ' columns
  If i11 + i12 + i13 + i14 + i15 + i16 <> 99
  Fehler(21) : End If
  If i21 + i22 + i23 + i24 + i25 + i26 <> 99
  Fehler(22) : End If
  If i31 + i32 + i33 + i34 + i35 + i36 <> 99
  Fehler(23) : End If
  If i41 + i42 + i43 + i44 + i45 + i46 <> 99
  Fehler(24) : End If
  If i51 + i52 + i53 + i54 + i55 + i56 <> 99
  Fehler(25) : End If
  If i61 + i62 + i63 + i64 + i65 + i66 <> 99
  Fehler(26) : End If
  ' downward
  If i11 + i22 + i33 + i44 + i55 + i66 <> 99
  Fehler(31) : End If
  ' upward
  If i61 + i52 + i43 + i34 + i25 + i16 <> 99
  Fehler(41) : End If

Proc Fehler(f)
  Color RGB(255, 0, 0)
  If f < 100
    Print AT(40 + 4 * (f Div 10), 2 + 2 * (f Mod 10)); Dec(f, 2);
  Else
    Print AT(40, 10); Dec(f, 3);
  End If
  Color RGB(0, 0, 0)
  SquareWrite
  Stop

Proc SquareWrite
  Print AT(1, 18); "-- Square " + Dec(Nos, 5) + " --"
  Print  " " + Dec(i11, 2) + " " + Dec(i21, 2) + " " + Dec(i31, 2) + " " + Dec(i41, 2) + " " + Dec(i51, 2) + " " + Dec(i61, 2)
  Print  " " + Dec(i12, 2) + " " + Dec(i22, 2) + " " + Dec(i32, 2) + " " + Dec(i42, 2) + " " + Dec(i52, 2) + " " + Dec(i62, 2)
  Print  " " + Dec(i13, 2) + " " + Dec(i23, 2) + " " + Dec(i33, 2) + " " + Dec(i43, 2) + " " + Dec(i53, 2) + " " + Dec(i63, 2)
  Print  " " + Dec(i14, 2) + " " + Dec(i24, 2) + " " + Dec(i34, 2) + " " + Dec(i44, 2) + " " + Dec(i54, 2) + " " + Dec(i64, 2)
  Print  " " + Dec(i15, 2) + " " + Dec(i25, 2) + " " + Dec(i35, 2) + " " + Dec(i45, 2) + " " + Dec(i55, 2) + " " + Dec(i65, 2)
  Print  " " + Dec(i16, 2) + " " + Dec(i26, 2) + " " + Dec(i36, 2) + " " + Dec(i46, 2) + " " + Dec(i56, 2) + " " + Dec(i66, 2)

Proc sqEnd
  Do : Sleep : Until Me Is Nothing
  Close # 1 : End

Sub Win_1_KeyPress(Ascii&)
  PeekEvent : PeekEvent : PeekEvent : PeekEvent
  If Ascii& = VK_ESCAPE
    PeekEvent : PeekEvent : PeekEvent : PeekEvent
    If Alert(1, "Do you want to stop the calculation|and exit the program?", 1, "Exit|Continue") = 1
      PeekEvent : PeekEvent : PeekEvent : PeekEvent
      CloseW 1 : Close # 1 : End
  End If : End If
End Sub