'#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