73 lines
1.4 KiB
Text
73 lines
1.4 KiB
Text
Module LatinSquare (n, z=1, f$="latin.dat", NewFile As Boolean=False) {
|
|
If Not Exist(f$) Or NewFile Then
|
|
Open f$ For Wide Output As f
|
|
Else
|
|
Open f$ For Wide Append As f
|
|
End If
|
|
ArrayToString=Lambda -> {
|
|
Shift 2 ' swap two top values in stack
|
|
Push Letter$+Str$(Number)
|
|
}
|
|
Dim line(1 to n)
|
|
flush ' erase current stack of value
|
|
z=if(z<1->1, z)
|
|
newColumn()
|
|
For j=1 To z
|
|
Profiler
|
|
ResetColumns()
|
|
For i=1 To n
|
|
placeColumn()
|
|
Next
|
|
Print "A latin square of ";n;" by ";n
|
|
For i=1 To n
|
|
Print line(i)
|
|
Print #f, line(i)#Fold$(ArrayToString)
|
|
Next
|
|
Print TimeCount
|
|
Refresh
|
|
Next
|
|
close #f
|
|
Flush ' empty stack again
|
|
End
|
|
Sub ResetColumns()
|
|
Local i
|
|
For i=1 To n:line(i)=(,):Next
|
|
End Sub
|
|
Sub newColumn()
|
|
Local i
|
|
For i=1 To n : Push i: Next
|
|
End Sub
|
|
Sub shuffle()
|
|
Local i
|
|
For i=1 To n div 2: Shift Random(2, n): Next
|
|
End Sub
|
|
Sub shuffleLocal(x)
|
|
If Stack.size<=x Then Exit Sub
|
|
Shift Random(x+1, Stack.size)
|
|
Shiftback x
|
|
End Sub
|
|
Sub PlaceColumn()
|
|
Local i, a, b, k
|
|
shuffle()
|
|
Do
|
|
data number ' rotate one position
|
|
k=0
|
|
For i=1 To n
|
|
a=line(i) ' get the pointer
|
|
Do
|
|
If a#Pos(Stackitem(i))=-1 Then k=0 :Exit Do
|
|
shuffleLocal(i)
|
|
k++
|
|
Until k>Stack.size-i
|
|
If k>0 Then Exit For
|
|
Next
|
|
Until k=0
|
|
For i=1 To n
|
|
a=line(i)
|
|
Append a, (Stackitem(i),)
|
|
Next
|
|
End Sub
|
|
}
|
|
Form 100,50
|
|
LatinSquare 5, 2, True
|
|
LatinSquare 16
|