145 lines
4.1 KiB
Text
145 lines
4.1 KiB
Text
'#include "sort.bas"
|
|
|
|
Sub fourFaceCombs(res() As Integer Ptr, found() As Boolean)
|
|
Dim As Integer i, j, k, l, m, index, key
|
|
|
|
index = 0
|
|
For i = 1 To 4
|
|
For j = 1 To 4
|
|
For k = 1 To 4
|
|
For l = 1 To 4
|
|
Dim As Integer c(3) = {i, j, k, l}
|
|
Sort(c())
|
|
|
|
key = 64 * (c(0) - 1) + 16 * (c(1) - 1) + 4 * (c(2) - 1) + (c(3) - 1)
|
|
If Not found(key) Then
|
|
found(key) = true
|
|
Redim Preserve res(index)
|
|
res(index) = Callocate(4 * Sizeof(Integer))
|
|
For m = 0 To 3
|
|
res(index)[m] = c(m)
|
|
Next
|
|
index += 1
|
|
End If
|
|
Next
|
|
Next
|
|
Next
|
|
Next
|
|
End Sub
|
|
|
|
Function cmp(x As Integer Ptr, y As Integer Ptr) As Integer
|
|
Dim As Integer i, j, xw, yw
|
|
|
|
xw = 0
|
|
yw = 0
|
|
For i = 0 To 3
|
|
For j = 0 To 3
|
|
If x[i] > y[j] Then
|
|
xw += 1
|
|
Elseif y[j] > x[i] Then
|
|
yw += 1
|
|
End If
|
|
Next
|
|
Next
|
|
|
|
Return Sgn(xw - yw)
|
|
End Function
|
|
|
|
Sub findIntransitive3(cs() As Integer Ptr, res() As Integer Ptr Ptr)
|
|
Dim As Integer i, j, k, c, index
|
|
|
|
c = Ubound(cs)
|
|
index = 0
|
|
For i = 0 To c
|
|
For j = 0 To c
|
|
For k = 0 To c
|
|
If cmp(cs(i), cs(j)) = -1 Then
|
|
If cmp(cs(j), cs(k)) = -1 Then
|
|
If cmp(cs(i), cs(k)) = 1 Then
|
|
Redim Preserve res(index)
|
|
res(index) = Callocate(3 * Sizeof(Integer Ptr))
|
|
res(index)[0] = cs(i)
|
|
res(index)[1] = cs(j)
|
|
res(index)[2] = cs(k)
|
|
index += 1
|
|
End If
|
|
End If
|
|
End If
|
|
Next
|
|
Next
|
|
Next
|
|
End Sub
|
|
|
|
Sub findIntransitive4(cs() As Integer Ptr, res() As Integer Ptr Ptr)
|
|
Dim As Integer i, j, k, l, c, index
|
|
|
|
c = Ubound(cs)
|
|
index = 0
|
|
For i = 0 To c
|
|
For j = 0 To c
|
|
For k = 0 To c
|
|
For l = 0 To c
|
|
If cmp(cs(i), cs(j)) = -1 Then
|
|
If cmp(cs(j), cs(k)) = -1 Then
|
|
If cmp(cs(k), cs(l)) = -1 Then
|
|
If cmp(cs(i), cs(l)) = 1 Then
|
|
Redim Preserve res(index)
|
|
res(index) = Callocate(4 * Sizeof(Integer Ptr))
|
|
res(index)[0] = cs(i)
|
|
res(index)[1] = cs(j)
|
|
res(index)[2] = cs(k)
|
|
res(index)[3] = cs(l)
|
|
index += 1
|
|
End If
|
|
End If
|
|
End If
|
|
End If
|
|
Next
|
|
Next
|
|
Next
|
|
Next
|
|
End Sub
|
|
|
|
Sub Main()
|
|
Dim As Integer i, j, k
|
|
Dim As Integer Ptr combs()
|
|
Dim As Boolean found(255)
|
|
fourFaceCombs(combs(), found())
|
|
Print "Number of eligible 4-faced dice"; Ubound(combs) + 1
|
|
|
|
Dim it3() As Integer Ptr Ptr
|
|
findIntransitive3(combs(), it3())
|
|
Print
|
|
Print Ubound(it3) + 1; " ordered lists of 3 non-transitive dice found, namely:"
|
|
For i = 0 To Ubound(it3)
|
|
Print "[";
|
|
For j = 0 To 2
|
|
Print "[";
|
|
For k = 0 To 3
|
|
Print it3(i)[j][k]; ",";
|
|
Next
|
|
Print Chr(8); " ], ";
|
|
Next
|
|
Print Chr(8); Chr(8); "]"
|
|
Next
|
|
|
|
Dim it4() As Integer Ptr Ptr
|
|
findIntransitive4(combs(), it4())
|
|
Print
|
|
Print Ubound(it4) + 1; " ordered lists of 4 non-transitive dice found, namely:"
|
|
For i = 0 To Ubound(it4)
|
|
Print "[";
|
|
For j = 0 To 3
|
|
Print "[";
|
|
For k = 0 To 3
|
|
Print it4(i)[j][k]; ",";
|
|
Next
|
|
Print Chr(8); " ], ";
|
|
Next
|
|
Print Chr(8); Chr(8); "]"
|
|
Next
|
|
End Sub
|
|
|
|
Main()
|
|
|
|
Sleep
|