Number of Magic Series up to Order 100
sqWin("2005-02-02 - Version 1.15")
sqDimVar
sqArraySetup
sqBasis
sqCalc
sqEnd
Proc sqWin(ByVal s As String)
FullW 1 : Me.Caption = "Floatingpoint-Number of magic series - Walter Trump - (c) 2002-09-02 to " + s
: Me.AutoRedraw = 1 : Me.SetFont "Courier New", _Y Div 80, 1
: Me.ControlBox = True : Me.Visible = True : Me.SetFocus : Me.PrintScroll = True
Proc sqDimVar
Global Const n As Int = 100 // ******************* make changes here
Global Const nn As Int = n * n // largest integer in series of order n
Global Const mc As Integer = n * (n ^ 2 + 1) \ 2 // magic constant of order n
Print "Memory load:"; Str(nn * mc * 8 / 1024, 6, 0); " kB"
Global Int mag(1 To n), Sd(1 To n), smax(1 To n), smin(1 To n)
' memSize muss ein Vielfaches von n sein, weil n Zeilen gleichzeitig gespeichert werden.
Public Int memsize = (Min(mc + 1, (850 * 1024 * 1024) \ nn \ 8) \ n) * n
Global Double No(1 To nn, 0 To memsize - 1)
Global Double SNo(1 To nn)
Global Byte memBlock(0 To memsize - 1)
ArrayFill memBlock(), 0
Global Byte memCheck(0 To mc)
ArrayFill memCheck(), False
Global Double StartTime = Timer
Global sqOut As String
Proc sqArraySetup
Local Int k
smin(n) = mc : smax(n) = mc : mag(n) = mc
Sd(n) = (n * (n - 1)) \ 2 // = 1 + 2 + 3 + ... + (n-1)
For k = n - 1 DownTo 1
mag(k) = (k * (k ^ 2 + 1)) \ 2 // Magic Constant of Order k
Sd(k) = Sd(k + 1) - k // = 1 + 2 + 3 + ... + (k-1)
' Upper border: Gesucht wird das größte s für das No(u,s)>0 gilt mit s+u=smax(k+1)
smax(k) = (k * (2 * smax(k + 1) - k + 1)) \ (2 * k + 2)
' Lower border: Gesucht wird das kleinste s für das No(u,s)>0 gilt mit s+u=smin(k+1)
smin(k) = Min(Max((k * (k + 1)) \ 2, smin(k + 1) - nn), mag(k))
End For
Proc sqBasis
$StepOff : $ArrayCheckOff : $ForFast
Local Int u, s
If smax(1) >= memsize Then Print "Zu wenig Speicher!" : Stop
' ArrayFill No(), 0 // Löschung des Speichers ist nicht notwendig
Print
Print Format$(1, " 00:");
For s = memsize - 1 DownTo 1
memCheck(s) = True
End For
For s = 1 To smax(1)
If s Mod 100 = 0
HTab(10) : Print Str(s \ 100, 6);
DoEvents
End If
For u = s To nn
No(u, s) = 1
End For
End For
sqPrint(1)
Proc sqCalc
$StepOff : $ArrayCheckOff : $ForFast
Local Int k, u, s, umin, umax, ms, mp
Local Double Sum
For k = 2 To n
Print Format$(k, " 00:");
For s = smax(k) DownTo smin(k)
If s Mod 100 = 0
DoEvents
HTab(10) : Print Str(s \ 100, 6);
End If
Sum = 0
umin = Max(k, Ceil((s + Sd(k)) / k))
umax = Min(s - Sd(k), nn)
For u = umin - 1 DownTo 1
SNo(u) = 0
End For
For u = umin To umax
If memCheck(s - u) = False Then GetNo(s - u)
Sum += No(u - 1, (s - u) Mod memsize)
SNo(u) = Sum
End For
For u = umax + 1 To nn
SNo(u) = Sum
End For
PutNo(s)
End For
sqPrint(k)
End For
Proc GetNo(ByVal s As Int)
$StepOff : $ArrayCheckOff : $ForFast
Local Int ms, mp, Bstart, i, a, b
ms = s Mod memsize
mp = s Div memsize
If memBlock(ms) <> mp
Bstart = (ms \ n) * n
DoEvents
BSave "magic-data\" + Dec(memBlock(ms) * memsize + Bstart, 6) + ".txt", VarPtr(No(1, Bstart)), nn * n * 8
Try
BLoad "magic-data\" + Dec(mp * memsize + Bstart, 6) + ".txt", VarPtr(No(1, Bstart))
Catch
Print
Print "magic-data\" + Dec(mp * memsize + Bstart, 6) + ".txt"
Print s, ms, mp, memBlock(ms)
Stop
End Catch
a = memBlock(ms) * memsize + Bstart
b = mp * memsize + Bstart
For i = n - 1 DownTo 0
memCheck(a + i) = False
memCheck(b + i) = True
memBlock(Bstart + i) = mp
End For
End If
Proc PutNo(ByVal s As Int)
$StepOff : $ArrayCheckOff : $ForFast
' Es werden stets n Zeilen gleichzeitig gespeichert.
Local Int ms, mp, Bstart, i, a, b
ms = s Mod memsize
mp = s Div memsize
If memBlock(ms) <> mp
Bstart = (ms \ n) * n
DoEvents
BSave "magic-data\" + Dec(memBlock(ms) * memsize + Bstart, 6) + ".txt", VarPtr(No(1, Bstart)), nn * n * 8
a = memBlock(ms) * memsize + Bstart
b = mp * memsize + Bstart
For i = n - 1 DownTo 0
memCheck(a + i) = False
memCheck(b + i) = True
memBlock(Bstart + i) = mp
End For
End If
BMove VarPtr(SNo(1)), VarPtr(No(1, ms)), nn * 8
End Proc
Proc sqPrint(ByVal k As Int)
If memCheck(mag(k)) = False Then GetNo(mag(k))
sqOut = Format$(No(k * k, mag(k) Mod memsize), " 0.00000000000000 E+000")
HTab(10) : Print sqOut
sqOutput(k)
Proc sqOutput(ByVal k As Int)
Open "float-magic-series-100.txt" for Append As # 1
Print # 1, Format$(k, "N(000) =");
Print # 1, sqOut
Close # 1
Proc sqEnd
Print "Calculation time in sec ="; Round(Timer - StartTime, 2)
Do : Sleep : Until Me Is Nothing : End
Sub Win_1_KeyPress(Ascii&)
DoEvents : DoEvents : DoEvents : DoEvents
If Ascii& = VK_ESCAPE
DoEvents
If Alert(1, "Do you want to stop the calculation|and exit the program?", 1, "Exit|Continue") = 1
DoEvents
CloseW 1 : End
End If : End If
End Sub