Task: Latin Squares in reduced form





Java: import java.math.BigInteger;
import java.util.ArrayList;
import java.util.Arrays;
import java.util.List;

public class LatinSquaresInReducedForm {

    public static void main(String[] args) {
        System.out.printf("Reduced latin squares of order 4:%n");
        for ( LatinSquare square : getReducedLatinSquares(4) ) {
            System.out.printf("%s%n", square);
        }
        
        System.out.printf("Compute the number of latin squares from count of reduced latin squares:%n(Reduced Latin Square Count) * n! * (n-1)! = Latin Square Count%n");
        for ( int n = 1 ; n <= 6 ; n++ ) {
            List<LatinSquare> list = getReducedLatinSquares(n);
            System.out.printf("Size = %d, %d * %d * %d = %,d%n", n, list.size(), fact(n), fact(n-1), list.size()*fact(n)*fact(n-1));
        }
    }
    
    private static long fact(int n) {
        if ( n == 0 ) {
            return 1;
        }
        int prod = 1;
        for ( int i = 1 ; i <= n ; i++ ) {
            prod *= i;
        }
        return prod;
    }
    
    private static List<LatinSquare> getReducedLatinSquares(int n) {
        List<LatinSquare> squares = new ArrayList<>();
        
        squares.add(new LatinSquare(n));
        PermutationGenerator permGen = new PermutationGenerator(n);
        for ( int fillRow = 1 ; fillRow < n ; fillRow++ ) {
            List<LatinSquare> squaresNext = new ArrayList<>();
            for ( LatinSquare square : squares ) {
                while ( permGen.hasMore() ) {
                    int[] perm = permGen.getNext();
                    
                    
                    if ( (perm[0]+1) != (fillRow+1) ) {
                        continue;
                    }
                    
                    
                    boolean permOk = true;
                    done:
                    for ( int row = 0 ; row < fillRow ; row++ ) {
                        for ( int col = 0 ; col < n ; col++ ) {
                            if ( square.get(row, col) == (perm[col]+1) ) {
                                permOk = false;
                                break done;
                            }
                        }
                    }
                    if ( permOk ) {
                        LatinSquare newSquare = new LatinSquare(square);
                        for ( int col = 0 ; col < n ; col++ ) {
                            newSquare.set(fillRow, col, perm[col]+1);
                        }
                        squaresNext.add(newSquare);
                    }
                }
                permGen.reset();
            }
            squares = squaresNext;
        }
        
        return squares;
    }
    
    @SuppressWarnings("unused")
    private static int[] display(int[] in) {
        int [] out = new int[in.length];
        for ( int i = 0 ; i < in.length ; i++ ) {
            out[i] = in[i] + 1;
        }
        return out;
    }
    
    private static class LatinSquare {
        
        int[][] square;
        int size;
        
        public LatinSquare(int n) {
            square = new int[n][n];
            size = n;
            for ( int col = 0 ; col < n ; col++ ) {
                set(0, col, col + 1);
            }
        }
        
        public LatinSquare(LatinSquare ls) {
            int n = ls.size;
            square = new int[n][n];
            size = n;
            for ( int row = 0 ; row < n ; row++ ) {
                for ( int col = 0 ; col < n ; col++ ) {
                    set(row, col, ls.get(row, col));
                }
            }
        }
        
        public void set(int row, int col, int value) {
            square[row][col] = value;
        }

        public int get(int row, int col) {
            return square[row][col];
        }

        @Override
        public String toString() {
            StringBuilder sb = new StringBuilder();
            for ( int row = 0 ; row < size ; row++ ) {
                sb.append(Arrays.toString(square[row]));
                sb.append("\n");
            }
            return sb.toString();
        }
        
        
    }

    private static class PermutationGenerator {

        private int[] a;
        private BigInteger numLeft;
        private BigInteger total;

        public PermutationGenerator (int n) {
            if (n < 1) {
                throw new IllegalArgumentException ("Min 1");
            }
            a = new int[n];
            total = getFactorial(n);
            reset();
        }

        private void reset () {
            for ( int i = 0 ; i < a.length ; i++ ) {
                a[i] = i;
            }
            numLeft = new BigInteger(total.toString());
        }

        public boolean hasMore() {
            return numLeft.compareTo(BigInteger.ZERO) == 1;
        }

        private static BigInteger getFactorial (int n) {
            BigInteger fact = BigInteger.ONE;
            for ( int i = n ; i > 1 ; i-- ) {
                fact = fact.multiply(new BigInteger(Integer.toString(i)));
            }
            return fact;
        }

        
        public int[] getNext() {
            if ( numLeft.equals(total) ) {
                numLeft = numLeft.subtract (BigInteger.ONE);
                return a;
            }

            
            int j = a.length - 2;
            while ( a[j] > a[j+1] ) {
                j--;
            }

            
            int k = a.length - 1;
            while ( a[j] > a[k] ) {
                k--;
            }

            
            int temp = a[k];
            a[k] = a[j];
            a[j] = temp;

            
            int r = a.length - 1;
            int s = j + 1;
            while (r > s) {
                int temp2 = a[s];
                a[s] = a[r];
                a[r] = temp2;
                r--;
                s++;
            }

            numLeft = numLeft.subtract(BigInteger.ONE);
            return a;
        }
    }

}




VB: Option Strict On

Imports Matrix = System.Collections.Generic.List(Of System.Collections.Generic.List(Of Integer))

Module Module1

    Sub Swap(Of T)(ByRef a As T, ByRef b As T)
        Dim u = a
        a = b
        b = u
    End Sub

    Sub PrintSquare(latin As Matrix)
        For Each row In latin
            Dim it = row.GetEnumerator
            Console.Write("[")
            If it.MoveNext Then
                Console.Write(it.Current)
            End If
            While it.MoveNext
                Console.Write(", ")
                Console.Write(it.Current)
            End While
            Console.WriteLine("]")
        Next
        Console.WriteLine()
    End Sub

    Function DList(n As Integer, start As Integer) As Matrix
        start -= 1 REM use 0 based indexes
        Dim a = Enumerable.Range(0, n).ToArray
        a(start) = a(0)
        a(0) = start
        Array.Sort(a, 1, a.Length - 1)
        Dim first = a(1)
        REM recursive closure permutes a[1:]
        Dim r As New Matrix

        Dim Recurse As Action(Of Integer) = Sub(last As Integer)
                                                If last = first Then
                                                    REM bottom of recursion. you get here once for each permutation
                                                    REM test if permutation is deranged.
                                                    For j = 1 To a.Length - 1
                                                        Dim v = a(j)
                                                        If j = v Then
                                                            Return REM no, ignore it
                                                        End If
                                                    Next
                                                    REM yes, save a copy with 1 based indexing
                                                    Dim b = a.Select(Function(v) v + 1).ToArray
                                                    r.Add(b.ToList)
                                                    Return
                                                End If
                                                For i = last To 1 Step -1
                                                    Swap(a(i), a(last))
                                                    Recurse(last - 1)
                                                    Swap(a(i), a(last))
                                                Next
                                            End Sub
        Recurse(n - 1)
        Return r
    End Function

    Function ReducedLatinSquares(n As Integer, echo As Boolean) As ULong
        If n <= 0 Then
            If echo Then
                Console.WriteLine("[]")
                Console.WriteLine()
            End If
            Return 0
        End If
        If n = 1 Then
            If echo Then
                Console.WriteLine("[1]")
                Console.WriteLine()
            End If
            Return 1
        End If

        Dim rlatin As New Matrix
        For i = 0 To n - 1
            rlatin.Add(New List(Of Integer))
            For j = 0 To n - 1
                rlatin(i).Add(0)
            Next
        Next
        REM first row
        For j = 0 To n - 1
            rlatin(0)(j) = j + 1
        Next

        Dim count As ULong = 0
        Dim Recurse As Action(Of Integer) = Sub(i As Integer)
                                                Dim rows = DList(n, i)

                                                For r = 0 To rows.Count - 1
                                                    rlatin(i - 1) = rows(r)
                                                    For k = 0 To i - 2
                                                        For j = 1 To n - 1
                                                            If rlatin(k)(j) = rlatin(i - 1)(j) Then
                                                                If r < rows.Count - 1 Then
                                                                    GoTo outer
                                                                End If
                                                                If i > 2 Then
                                                                    Return
                                                                End If
                                                            End If
                                                        Next
                                                    Next
                                                    If i < n Then
                                                        Recurse(i + 1)
                                                    Else
                                                        count += 1UL
                                                        If echo Then
                                                            PrintSquare(rlatin)
                                                        End If
                                                    End If
outer:
                                                    While False
                                                        REM empty
                                                    End While
                                                Next
                                            End Sub

        REM remiain rows
        Recurse(2)
        Return count
    End Function

    Function Factorial(n As ULong) As ULong
        If n <= 0 Then
            Return 1
        End If
        Dim prod = 1UL
        For i = 2UL To n
            prod *= i
        Next
        Return prod
    End Function

    Sub Main()
        Console.WriteLine("The four reduced latin squares of order 4 are:")
        Console.WriteLine()
        ReducedLatinSquares(4, True)

        Console.WriteLine("The size of the set of reduced latin squares for the following orders")
        Console.WriteLine("and hence the total number of latin squares of these orders are:")
        Console.WriteLine()
        For n = 1 To 6
            Dim nu As ULong = CULng(n)

            Dim size = ReducedLatinSquares(n, False)
            Dim f = Factorial(nu - 1UL)
            f *= f * nu * size
            Console.WriteLine("Order {0}: Size {1} x {2}! x {3}! => Total {4}", n, size, n, n - 1, f)
        Next
    End Sub

End Module