Latin Squares in reduced form

From Rosetta Code
Task
Latin Squares in reduced form
You are encouraged to solve this task according to the task description, using any language you may know.

A Latin Square is in its reduced form if the first row and first column contain items in their natural order. The order n is the number of items. For any given n there is a set of reduced Latin Squares whose size increases rapidly with n. g is a number which identifies a unique element within the set of reduced Latin Squares of order n. The objective of this task is to construct the set of all Latin Squares of a given order and to provide a means which given suitable values for g any element within the set may be obtained.

For a reduced Latin Square the first row is always 1 to n. The second row is all Permutations/Derangements of 1 to n starting with 2. The third row is all Permutations/Derangements of 1 to n starting with 3 which do not clash (do not have the same item in any column) with row 2. The fourth row is all Permutations/Derangements of 1 to n starting with 4 which do not clash with rows 2 or 3. Likewise continuing to the nth row.

Demonstrate by:

  • displaying the four reduced Latin Squares of order 4.
  • for n = 1 to 6 (or more) produce the set of reduced Latin Squares; produce a table which shows the size of the set of reduced Latin Squares and compares this value times n! times (n-1)! with the values in OEIS A002860.



11l

Translation of: Python
F dList(n, =start)
   start--
   V a = Array(0 .< n)
   a[start] = a[0]
   a[0] = start
   a.sort_range(1..)
   V first = a[1]
   [[Int]] r
   F recurse(Int last) -> N
      I (last == @first)
         L(v) @a[1..]
            I L.index + 1 == v
               R
         V b = @a.map(x -> x + 1)
         @r.append(b)
         R
      L(i) (last .< 0).step(-1)
         swap(&@a[i], &@a[last])
         @recurse(last - 1)
         swap(&@a[i], &@a[last])
   recurse(n - 1)
   R r

F printSquare(latin, n)
   L(row) latin
      print(row)
   print()

F reducedLatinSquares(n, echo)
   I n <= 0
      I echo
         print(‘[]’)
      R 0
   E I n == 1
      I echo
         print([1])
      R 1

   V rlatin = [[0] * n] * n
   L(j) 0 .< n
      rlatin[0][j] = j + 1

   V count = 0
   F recurse(Int i) -> N
      V rows = dList(@n, i)

      L(r) 0 .< rows.len
         @rlatin[i - 1] = rows[r]
         V justContinue = 0B
         V k = 0
         L !justContinue & k < i - 1
            L(j) 1 .< @n
               I @rlatin[k][j] == @rlatin[i - 1][j]
                  I r < rows.len - 1
                     justContinue = 1B
                     L.break
                  I i > 2
                     R
            k++
         I !justContinue
            I i < @n
               @recurse(i + 1)
            E
               @count++
               I @echo
                  printSquare(@rlatin, @n)

   recurse(2)
   R count

print("The four reduced latin squares of order 4 are:\n")
reducedLatinSquares(4, 1B)

print(‘The size of the set of reduced latin squares for the following orders’)
print("and hence the total number of latin squares of these orders are:\n")
L(n) 1..6
   V size = reducedLatinSquares(n, 0B)
   V f = factorial(n - 1)
   f *= f * n * size
   print(‘Order #.: Size #<4 x #.! x #.! => Total #.’.format(n, size, n, n - 1, f))
Output:
The four reduced latin squares of order 4 are:

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 1, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 2, 1]
[4, 3, 1, 2]

[1, 2, 3, 4]
[2, 4, 1, 3]
[3, 1, 4, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 3, 4, 1]
[3, 4, 1, 2]
[4, 1, 2, 3]

The size of the set of reduced latin squares for the following orders
and hence the total number of latin squares of these orders are:

Order 1: Size 1    x 1! x 0! => Total 1
Order 2: Size 1    x 2! x 1! => Total 2
Order 3: Size 1    x 3! x 2! => Total 12
Order 4: Size 4    x 4! x 3! => Total 576
Order 5: Size 56   x 5! x 4! => Total 161280
Order 6: Size 9408 x 6! x 5! => Total 812851200

C#

Translation of: D
using System;
using System.Collections.Generic;
using System.Linq;

namespace LatinSquares {
    using matrix = List<List<int>>;

    class Program {
        static void Swap<T>(ref T a, ref T b) {
            var t = a;
            a = b;
            b = t;
        }

        static matrix DList(int n, int start) {
            start--; // use 0 basing
            var a = Enumerable.Range(0, n).ToArray();
            a[start] = a[0];
            a[0] = start;
            Array.Sort(a, 1, a.Length - 1);
            var first = a[1];
            // recursive closure permutes a[1:]
            matrix r = new matrix();
            void recurse(int last) {
                if (last == first) {
                    // bottom of recursion. you get here once for each permutation.
                    // test if permutation is deranged.
                    for (int j = 1; j < a.Length; j++) {
                        var v = a[j];
                        if (j == v) {
                            return; //no, ignore it
                        }
                    }
                    // yes, save a copy with 1 based indexing
                    var b = a.Select(v => v + 1).ToArray();
                    r.Add(b.ToList());
                    return;
                }
                for (int i = last; i >= 1; i--) {
                    Swap(ref a[i], ref a[last]);
                    recurse(last - 1);
                    Swap(ref a[i], ref a[last]);
                }
            }
            recurse(n - 1);
            return r;
        }

        static ulong ReducedLatinSquares(int n, bool echo) {
            if (n <= 0) {
                if (echo) {
                    Console.WriteLine("[]\n");
                }
                return 0;
            } else if (n == 1) {
                if (echo) {
                    Console.WriteLine("[1]\n");
                }
                return 1;
            }

            matrix rlatin = new matrix();
            for (int i = 0; i < n; i++) {
                rlatin.Add(new List<int>());
                for (int j = 0; j < n; j++) {
                    rlatin[i].Add(0);
                }
            }
            // first row
            for (int j = 0; j < n; j++) {
                rlatin[0][j] = j + 1;
            }

            ulong count = 0;
            void recurse(int i) {
                var rows = DList(n, i);

                for (int r = 0; r < rows.Count; r++) {
                    rlatin[i - 1] = rows[r];
                    for (int k = 0; k < i - 1; k++) {
                        for (int j = 1; j < n; j++) {
                            if (rlatin[k][j] == rlatin[i - 1][j]) {
                                if (r < rows.Count - 1) {
                                    goto outer;
                                }
                                if (i > 2) {
                                    return;
                                }
                            }
                        }
                    }
                    if (i < n) {
                        recurse(i + 1);
                    } else {
                        count++;
                        if (echo) {
                            PrintSquare(rlatin, n);
                        }
                    }
                outer: { }
                }
            }

            //remaing rows
            recurse(2);
            return count;
        }

        static void PrintSquare(matrix latin, int n) {
            foreach (var row in latin) {
                var it = row.GetEnumerator();
                Console.Write("[");
                if (it.MoveNext()) {
                    Console.Write(it.Current);
                }
                while (it.MoveNext()) {
                    Console.Write(", {0}", it.Current);
                }
                Console.WriteLine("]");
            }
            Console.WriteLine();
        }

        static ulong Factorial(ulong n) {
            if (n <= 0) {
                return 1;
            }
            ulong prod = 1;
            for (ulong i = 2; i < n + 1; i++) {
                prod *= i;
            }
            return prod;
        }

        static void Main() {
            Console.WriteLine("The four reduced latin squares of order 4 are:\n");
            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:\n");
            for (int n = 1; n < 7; n++) {
                ulong nu = (ulong)n;

                var size = ReducedLatinSquares(n, false);
                var f = Factorial(nu - 1);
                f *= f * nu * size;
                Console.WriteLine("Order {0}: Size {1} x {2}! x {3}! => Total {4}", n, size, n, n - 1, f);
            }
        }
    }
}
Output:
The four reduced latin squares of order 4 are:

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 1, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 2, 1]
[4, 3, 1, 2]

[1, 2, 3, 4]
[2, 4, 1, 3]
[3, 1, 4, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 3, 4, 1]
[3, 4, 1, 2]
[4, 1, 2, 3]

The size of the set of reduced latin squares for the following orders
and hence the total number of latin squares of these orders are:

Order 1: Size 1 x 1! x 0! => Total 1
Order 2: Size 1 x 2! x 1! => Total 2
Order 3: Size 1 x 3! x 2! => Total 12
Order 4: Size 4 x 4! x 3! => Total 576
Order 5: Size 56 x 5! x 4! => Total 161280
Order 6: Size 9408 x 6! x 5! => Total 812851200

C++

Translation of: C#
#include <algorithm>
#include <functional>
#include <iostream>
#include <numeric>
#include <vector>

typedef std::vector<std::vector<int>> matrix;

matrix dList(int n, int start) {
    start--; // use 0 basing

    std::vector<int> a(n);
    std::iota(a.begin(), a.end(), 0);
    a[start] = a[0];
    a[0] = start;
    std::sort(a.begin() + 1, a.end());
    auto first = a[1];
    // recursive closure permutes a[1:]
    matrix r;
    std::function<void(int)> recurse;
    recurse = [&](int last) {
        if (last == first) {
            // bottom of recursion you get here once for each permutation.
            // test if permutation is deranged.
            for (size_t j = 1; j < a.size(); j++) {
                auto v = a[j];
                if (j == v) {
                    return; //no, ignore it
                }
            }
            // yes, save a copy with 1 based indexing
            std::vector<int> b;
            std::transform(a.cbegin(), a.cend(), std::back_inserter(b), [](int v) { return v + 1; });
            r.push_back(b);
            return;
        }
        for (int i = last; i >= 1; i--) {
            std::swap(a[i], a[last]);
            recurse(last - 1);
            std::swap(a[i], a[last]);
        }
    };
    recurse(n - 1);
    return r;
}

void printSquare(const matrix &latin, int n) {
    for (auto &row : latin) {
        auto it = row.cbegin();
        auto end = row.cend();
        std::cout << '[';
        if (it != end) {
            std::cout << *it;
            it = std::next(it);
        }
        while (it != end) {
            std::cout << ", " << *it;
            it = std::next(it);
        }
        std::cout << "]\n";
    }
    std::cout << '\n';
}

unsigned long reducedLatinSquares(int n, bool echo) {
    if (n <= 0) {
        if (echo) {
            std::cout << "[]\n";
        }
        return 0;
    } else if (n == 1) {
        if (echo) {
            std::cout << "[1]\n";
        }
        return 1;
    }

    matrix rlatin;
    for (int i = 0; i < n; i++) {
        rlatin.push_back({});
        for (int j = 0; j < n; j++) {
            rlatin[i].push_back(j);
        }
    }
    // first row
    for (int j = 0; j < n; j++) {
        rlatin[0][j] = j + 1;
    }

    unsigned long count = 0;
    std::function<void(int)> recurse;
    recurse = [&](int i) {
        auto rows = dList(n, i);

        for (size_t r = 0; r < rows.size(); r++) {
            rlatin[i - 1] = rows[r];
            for (int k = 0; k < i - 1; k++) {
                for (int j = 1; j < n; j++) {
                    if (rlatin[k][j] == rlatin[i - 1][j]) {
                        if (r < rows.size() - 1) {
                            goto outer;
                        }
                        if (i > 2) {
                            return;
                        }
                    }
                }
            }
            if (i < n) {
                recurse(i + 1);
            } else {
                count++;
                if (echo) {
                    printSquare(rlatin, n);
                }
            }
        outer: {}
        }
    };

    //remaining rows
    recurse(2);
    return count;
}

unsigned long factorial(unsigned long n) {
    if (n <= 0) return 1;
    unsigned long prod = 1;
    for (unsigned long i = 2; i <= n; i++) {
        prod *= i;
    }
    return prod;
}

int main() {
    std::cout << "The four reduced lating squares of order 4 are:\n";
    reducedLatinSquares(4, true);

    std::cout << "The size of the set of reduced latin squares for the following orders\n";
    std::cout << "and hence the total number of latin squares of these orders are:\n\n";
    for (int n = 1; n < 7; n++) {
        auto size = reducedLatinSquares(n, false);
        auto f = factorial(n - 1);
        f *= f * n * size;
        std::cout << "Order " << n << ": Size " << size << " x " << n << "! x " << (n - 1) << "! => Total " << f << '\n';
    }

    return 0;
}
Output:
The four reduced lating squares of order 4 are:
[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 1, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 2, 1]
[4, 3, 1, 2]

[1, 2, 3, 4]
[2, 4, 1, 3]
[3, 1, 4, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 3, 4, 1]
[3, 4, 1, 2]
[4, 1, 2, 3]

The size of the set of reduced latin squares for the following orders
and hence the total number of latin squares of these orders are:

Order 1: Size 1 x 1! x 0! => Total 1
Order 2: Size 1 x 2! x 1! => Total 2
Order 3: Size 1 x 3! x 2! => Total 12
Order 4: Size 4 x 4! x 3! => Total 576
Order 5: Size 56 x 5! x 4! => Total 161280
Order 6: Size 9408 x 6! x 5! => Total 812851200

D

Translation of: Go
import std.algorithm;
import std.array;
import std.range;
import std.stdio;

alias matrix = int[][];

auto dList(int n, int start) {
    start--;    // use 0 basing
    auto a = iota(0, n).array;
    a[start] = a[0];
    a[0] = start;
    sort(a[1..$]);
    auto first = a[1];
    // recursive closure permutes a[1:]
    matrix r;
    void recurse(int last) {
        if (last == first) {
            // bottom of recursion. you get here once for each permutation.
            // test if permutation is deranged.
            foreach (j,v; a[1..$]) {
                if (j + 1 == v) {
                    return; //no, ignore it
                }
            }
            // yes, save a copy with 1 based indexing
            auto b = a.map!"a+1".array;
            r ~= b;
            return;
        }
        for (int i = last; i >= 1; i--) {
            swap(a[i], a[last]);
            recurse(last -1);
            swap(a[i], a[last]);
        }
    }
    recurse(n - 1);
    return r;
}

ulong reducedLatinSquares(int n, bool echo) {
    if (n <= 0) {
        if (echo) {
            writeln("[]\n");
        }
        return 0;
    } else if (n == 1) {
        if (echo) {
            writeln("[1]\n");
        }
        return 1;
    }

    matrix rlatin = uninitializedArray!matrix(n);
    foreach (i; 0..n) {
        rlatin[i] = uninitializedArray!(int[])(n);
    }
    // first row
    foreach (j; 0..n) {
        rlatin[0][j] = j + 1;
    }

    ulong count;
    void recurse(int i) {
        auto rows = dList(n, i);

        outer:
        foreach (r; 0..rows.length) {
            rlatin[i-1] = rows[r].dup;
            foreach (k; 0..i-1) {
                foreach (j; 1..n) {
                    if (rlatin[k][j] == rlatin[i - 1][j]) {
                        if (r < rows.length - 1) {
                            continue outer;
                        }
                        if (i > 2) {
                            return;
                        }
                    }
                }
            }
            if (i < n) {
                recurse(i + 1);
            } else {
                count++;
                if (echo) {
                    printSquare(rlatin, n);
                }
            }
        }
    }

    // remaining rows
    recurse(2);
    return count;
}

void printSquare(matrix latin, int n) {
    foreach (row; latin) {
        writeln(row);
    }
    writeln;
}

ulong factorial(ulong n) {
    if (n == 0) {
        return 1;
    }
    ulong prod = 1;
    foreach (i; 2..n+1) {
        prod *= i;
    }
    return prod;
}

void main() {
    writeln("The four reduced latin squares of order 4 are:\n");
    reducedLatinSquares(4, true);

    writeln("The size of the set of reduced latin squares for the following orders");
    writeln("and hence the total number of latin squares of these orders are:\n");
    foreach (n; 1..7) {
        auto size = reducedLatinSquares(n, false);
        auto f = factorial(n - 1);
        f *= f * n * size;
        writefln("Order %d: Size %-4d x %d! x %d! => Total %d", n, size, n, n - 1, f);
    }
}
Output:
The four reduced latin squares of order 4 are:

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 1, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 2, 1]
[4, 3, 1, 2]

[1, 2, 3, 4]
[2, 4, 1, 3]
[3, 1, 4, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 3, 4, 1]
[3, 4, 1, 2]
[4, 1, 2, 3]

The size of the set of reduced latin squares for the following orders
and hence the total number of latin squares of these orders are:

Order 1: Size 1    x 1! x 0! => Total 1
Order 2: Size 1    x 2! x 1! => Total 2
Order 3: Size 1    x 3! x 2! => Total 12
Order 4: Size 4    x 4! x 3! => Total 576
Order 5: Size 56   x 5! x 4! => Total 161280
Order 6: Size 9408 x 6! x 5! => Total 812851200

F#

The Function

This task uses Permutations/Derangements#F.23

// Generate Latin Squares in reduced form. Nigel Galloway: July 10th., 2019
let normLS α=
  let N=derange α|>List.ofSeq|>List.groupBy(fun n->n.[0])|>List.sortBy(fun(n,_)->n)|>List.map(fun(_,n)->n)|>Array.ofList
  let rec fG n g=match n with h::t->fG t (g|>List.filter(fun g->Array.forall2((<>)) h g )) |_->g
  let rec normLS n g=seq{for i in fG n N.[g] do if g=α-2 then yield [|1..α|]::(List.rev (i::n)) else yield! normLS (i::n) (g+1)}
  match α with 1->seq[[[|1|]]] |2-> seq[[[|1;2|];[|2;1|]]] |_->Seq.collect(fun n->normLS [n] 1) N.[0]

The Task

normLS 4 |> Seq.iter(fun n->List.iter(printfn "%A") n;printfn "");;
Output:
[|1; 2; 3; 4|]
[|2; 3; 4; 1|]
[|3; 4; 1; 2|]
[|4; 1; 2; 3|]

[|1; 2; 3; 4|]
[|2; 1; 4; 3|]
[|3; 4; 2; 1|]
[|4; 3; 1; 2|]

[|1; 2; 3; 4|]
[|2; 1; 4; 3|]
[|3; 4; 1; 2|]
[|4; 3; 2; 1|]

[|1; 2; 3; 4|]
[|2; 4; 1; 3|]
[|3; 1; 4; 2|]
[|4; 3; 2; 1|]
let rec fact n g=if n<2 then g else fact (n-1) n*g
[1..6] |> List.iter(fun n->let nLS=normLS n|>Seq.length in printfn "order=%d number of Reduced Latin Squares nLS=%d nLS*n!*(n-1)!=%d" n nLS (nLS*(fact n 1)*(fact (n-1) 1)))
Output:
order=1 number of Reduced Latin Squares nLS=1 nLS*n!*(n-1)!=1
order=2 number of Reduced Latin Squares nLS=1 nLS*n!*(n-1)!=2
order=3 number of Reduced Latin Squares nLS=1 nLS*n!*(n-1)!=12
order=4 number of Reduced Latin Squares nLS=4 nLS*n!*(n-1)!=576
order=5 number of Reduced Latin Squares nLS=56 nLS*n!*(n-1)!=161280
order=6 number of Reduced Latin Squares nLS=9408 nLS*n!*(n-1)!=812851200

Go

This reuses the dList function from the Permutations/Derangements#Go task, suitably adjusted for the present one.

package main

import (
    "fmt"
    "sort"
)

type matrix [][]int

// generate derangements of first n numbers, with 'start' in first place.
func dList(n, start int) (r matrix) {
    start-- // use 0 basing
    a := make([]int, n)
    for i := range a {
        a[i] = i
    }
    a[0], a[start] = start, a[0]
    sort.Ints(a[1:])
    first := a[1]
    // recursive closure permutes a[1:]
    var recurse func(last int)
    recurse = func(last int) {
        if last == first {
            // bottom of recursion.  you get here once for each permutation.
            // test if permutation is deranged.
            for j, v := range a[1:] { // j starts from 0, not 1
                if j+1 == v {
                    return // no, ignore it
                }
            }
            // yes, save a copy
            b := make([]int, n)
            copy(b, a)
            for i := range b {
                b[i]++ // change back to 1 basing
            }
            r = append(r, b)
            return
        }
        for i := last; i >= 1; i-- {
            a[i], a[last] = a[last], a[i]
            recurse(last - 1)
            a[i], a[last] = a[last], a[i]
        }
    }
    recurse(n - 1)
    return
}

func reducedLatinSquare(n int, echo bool) uint64 {
    if n <= 0 {
        if echo {
            fmt.Println("[]\n")
        }
        return 0
    } else if n == 1 {
        if echo {
            fmt.Println("[1]\n")
        }
        return 1
    }
    rlatin := make(matrix, n)
    for i := 0; i < n; i++ {
        rlatin[i] = make([]int, n)
    }
    // first row
    for j := 0; j < n; j++ {
        rlatin[0][j] = j + 1
    }

    count := uint64(0)
    // recursive closure to compute reduced latin squares and count or print them
    var recurse func(i int)
    recurse = func(i int) {
        rows := dList(n, i) // get derangements of first n numbers, with 'i' first.
    outer:
        for r := 0; r < len(rows); r++ {
            copy(rlatin[i-1], rows[r])
            for k := 0; k < i-1; k++ {
                for j := 1; j < n; j++ {
                    if rlatin[k][j] == rlatin[i-1][j] {
                        if r < len(rows)-1 {
                            continue outer
                        } else if i > 2 {
                            return
                        }
                    }
                }
            }
            if i < n {
                recurse(i + 1)
            } else {
                count++
                if echo {
                    printSquare(rlatin, n)
                }
            }
        }
        return
    }

    // remaining rows
    recurse(2)
    return count
}

func printSquare(latin matrix, n int) {
    for i := 0; i < n; i++ {
        fmt.Println(latin[i])
    }
    fmt.Println()
}

func factorial(n uint64) uint64 {
    if n == 0 {
        return 1
    }
    prod := uint64(1)
    for i := uint64(2); i <= n; i++ {
        prod *= i
    }
    return prod
}

func main() {
    fmt.Println("The four reduced latin squares of order 4 are:\n")
    reducedLatinSquare(4, true)

    fmt.Println("The size of the set of reduced latin squares for the following orders")
    fmt.Println("and hence the total number of latin squares of these orders are:\n")
    for n := uint64(1); n <= 6; n++ {
        size := reducedLatinSquare(int(n), false)
        f := factorial(n - 1)
        f *= f * n * size
        fmt.Printf("Order %d: Size %-4d x %d! x %d! => Total %d\n", n, size, n, n-1, f)
    }
}
Output:
The four reduced latin squares of order 4 are:

[1 2 3 4]
[2 1 4 3]
[3 4 1 2]
[4 3 2 1]

[1 2 3 4]
[2 1 4 3]
[3 4 2 1]
[4 3 1 2]

[1 2 3 4]
[2 4 1 3]
[3 1 4 2]
[4 3 2 1]

[1 2 3 4]
[2 3 4 1]
[3 4 1 2]
[4 1 2 3]

The size of the set of reduced latin squares for the following orders
and hence the total number of latin squares of these orders are:

Order 1: Size 1    x 1! x 0! => Total 1
Order 2: Size 1    x 2! x 1! => Total 2
Order 3: Size 1    x 3! x 2! => Total 12
Order 4: Size 4    x 4! x 3! => Total 576
Order 5: Size 56   x 5! x 4! => Total 161280
Order 6: Size 9408 x 6! x 5! => Total 812851200

Haskell

The solution uses permutation generator given by Data.List package and List monad for generating all possible latin squares as a fold of permutation list.

import Data.List (permutations, (\\))
import Control.Monad (foldM, forM_)

latinSquares :: Eq a => [a] -> [[[a]]]
latinSquares [] = []
latinSquares set = map reverse <$> squares
  where
    squares = foldM addRow firstRow perm
    perm = tail (groupedPermutations set)
    firstRow = pure <$> set
    addRow tbl rows = [ zipWith (:) row tbl
                      | row <- rows                      
                      , and $ different (tail row) (tail tbl) ]
    different = zipWith $ (not .) . elem
       
groupedPermutations :: Eq a => [a] -> [[[a]]]
groupedPermutations lst = map (\x -> (x :) <$> permutations (lst \\ [x])) lst

printTable :: Show a => [[a]] -> IO () 
printTable tbl = putStrLn $ unlines $ unwords . map show <$> tbl

It is slightly optimized by grouping permutations by the first element according to a set order. Partitioning reduces the filtering procedure by factor of an initial set size.

Examples

λ> latinSquares "abc"
[["abc","bca","cab"]]

λ> mapM_ printTable $ take 3 $ latinSquares [1..9]
1 2 3 4 5 6 7 8 9
2 9 4 8 1 7 3 6 5
3 8 2 5 9 1 4 7 6
4 7 5 6 2 9 8 1 3
5 6 9 1 3 8 2 4 7
6 5 1 7 4 2 9 3 8
7 4 6 3 8 5 1 9 2
8 3 7 9 6 4 5 2 1
9 1 8 2 7 3 6 5 4

1 2 3 4 5 6 7 8 9
2 9 4 8 1 7 3 5 6
3 8 2 5 9 1 4 6 7
4 7 5 6 2 9 8 1 3
5 6 9 1 3 8 2 7 4
6 5 1 7 4 2 9 3 8
7 4 6 3 8 5 1 9 2
8 3 7 9 6 4 5 2 1
9 1 8 2 7 3 6 4 5

1 2 3 4 5 6 7 8 9
2 9 4 8 1 7 3 6 5
3 8 2 5 9 1 4 7 6
4 7 5 6 2 9 1 3 8
5 6 9 1 3 8 2 4 7
6 5 1 7 4 2 8 9 3
7 4 6 3 8 5 9 1 2
8 3 7 9 6 4 5 2 1
9 1 8 2 7 3 6 5 4

Tasks

task1 = do 
  putStrLn "Latin squares of order 4:"
  mapM_ printTable $ latinSquares [1..4]

task2 = do 
  putStrLn "Sizes of latin squares sets for different orders:"
  forM_ [1..6] $ \n -> 
    let size = length $ latinSquares [1..n]
        total = fact n * fact (n-1) * size
        fact i = product [1..i]
    in printf "Order %v: %v*%v!*%v!=%v\n" n size n (n-1) total
λ> task1 >> task2
Latin squares of order 4:
1 2 3 4
4 1 2 3
3 4 1 2
2 3 4 1

1 2 3 4
2 4 1 3
3 1 4 2
4 3 2 1

1 2 3 4
2 1 4 3
4 3 1 2
3 4 2 1

1 2 3 4
2 1 4 3
3 4 1 2
4 3 2 1

Sizes of latin squares sets for different orders:
Order 1: 1*1!*0!=1
Order 2: 1*2!*1!=2
Order 3: 1*3!*2!=12
Order 4: 4*4!*3!=576
Order 5: 56*5!*4!=161280
Order 6: 9408*6!*5!=812851200

J

Implementation:

redlat=: {{
  perms=: (A.&i.~ !)~ y
  sqs=. i.1 1,y
  for_j.}.i.y do.
    p=. (j={."1 perms)#perms
    sel=.-.+./"1 p +./@:="1/"2 sqs
    sqs=.(#~ 1-0*/ .="1{:"2),/sqs,"2 1 sel#"2 p
  end.
}}

Task examples:

   redlat 4
0 1 2 3
1 0 3 2
2 3 0 1
3 2 1 0

0 1 2 3
1 0 3 2
2 3 1 0
3 2 0 1

0 1 2 3
1 2 3 0
2 3 0 1
3 0 1 2

0 1 2 3
1 3 0 2
2 0 3 1
3 2 1 0
   #@redlat every 1 2 3 4 5 6
1 1 1 4 56 9408
   (#@redlat every 1 2 3 4 5 6)*(!1 2 3 4 5 6x)*(!0 1 2 3 4 5x)
1 2 12 576 161280 812851200

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 not the correct row - next permutation.
                    if ( (perm[0]+1) != (fillRow+1) ) {
                        continue;
                    }
                    
                    //  Check permutation against current square.
                    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;
        }

        /*--------------------------------------------------------
         * Generate next permutation (algorithm from Rosen p. 284)
         *--------------------------------------------------------
         */
        public int[] getNext() {
            if ( numLeft.equals(total) ) {
                numLeft = numLeft.subtract (BigInteger.ONE);
                return a;
            }

            // Find largest index j with a[j] < a[j+1]
            int j = a.length - 2;
            while ( a[j] > a[j+1] ) {
                j--;
            }

            // Find index k such that a[k] is smallest integer greater than a[j] to the right of a[j]
            int k = a.length - 1;
            while ( a[j] > a[k] ) {
                k--;
            }

            // Interchange a[j] and a[k]
            int temp = a[k];
            a[k] = a[j];
            a[j] = temp;

            // Put tail end of permutation after jth position in increasing order
            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;
        }
    }

}
Output:
Reduced latin squares of order 4:
[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 1, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 2, 1]
[4, 3, 1, 2]

[1, 2, 3, 4]
[2, 3, 4, 1]
[3, 4, 1, 2]
[4, 1, 2, 3]

[1, 2, 3, 4]
[2, 4, 1, 3]
[3, 1, 4, 2]
[4, 3, 2, 1]

Compute the number of latin squares from count of reduced latin squares:
(Reduced Latin Square Count) * n! * (n-1)! = Latin Square Count
Size = 1, 1 * 1 * 1 = 1
Size = 2, 1 * 2 * 1 = 2
Size = 3, 1 * 6 * 2 = 12
Size = 4, 4 * 24 * 6 = 576
Size = 5, 56 * 120 * 24 = 161,280
Size = 6, 9408 * 720 * 120 = 812,851,200

jq

Works with: jq

Works with recent versions of gojq (e.g. f0faa22 (August 22, 2021))

Preliminaries

def count(s): reduce s as $x (0; .+1);

def factorial: reduce range(2;.+1) as $i (1; . * $i);

def permutations:
  if length == 0 then []
  else
    range(0;length) as $i
    | [.[$i]] + (del(.[$i])|permutations)
  end ;

Latin Squares

def clash($row2; $row1):
  any(range(0;$row2|length); $row1[.] == $row2[.]);

# Input is a row; stream is a stream of rows
def clash(stream):
  . as $row | any(stream; clash($row; .)) ;

# Emit a stream of latin squares of size .
def latin_squares:
  . as $n

  # Emit a stream of arrays of permutation of 1 .. $n inclusive, and beginning with $i
  | def permutations_beginning_with($i):
      [$i] + ([range(1; $i), range($i+1; $n + 1)] | permutations);

  # input: an array of rows, $rows
  # output: a stream of all the permutations starting with $i
  #         that are permissible relative to $rows
  def filter_permuted($i):
    . as $rows
    | permutations_beginning_with($i)
    | select( clash($rows[]) | not ) ;

  # input: an array of the first few rows (at least one) of a latin square
  # output: a stream of possible immediate-successor rows
  def next_latin_square_row:
    filter_permuted(1 + .[-1][0]);

  # recursion makes completing a latin square a snap
  def complete_latin_square:
     if length == $n then .
     else next_latin_square_row as $next
     | . + [$next] | complete_latin_square
     end;

  [[range(1;$n+1)]] 
  | complete_latin_square ;

The Task

def task:
  "The reduced latin squares of order 4 are:",
  (4 | latin_squares),
  "",
  (range(1; 7)
   | . as $i
   | count(latin_squares) as $c
   | ($c * factorial * ((.-1)|factorial)) as $total
   | "There are \($c) reduced latin squares of order \(.); \($c) * \(.)! * \(.-1)! is \($total)"
  ) ;

task
Output:

Invocation: jq -nrc -f latin-squares.jq

The reduced latin squares of order 4 are:
[[1,2,3,4],[2,1,4,3],[3,4,1,2],[4,3,2,1]]
[[1,2,3,4],[2,1,4,3],[3,4,2,1],[4,3,1,2]]
[[1,2,3,4],[2,3,4,1],[3,4,1,2],[4,1,2,3]]
[[1,2,3,4],[2,4,1,3],[3,1,4,2],[4,3,2,1]]

There are 1 reduced latin squares of order 1; 1 * 1! * 0! is  1
There are 1 reduced latin squares of order 2; 1 * 2! * 1! is  2
There are 1 reduced latin squares of order 3; 1 * 3! * 2! is  12
There are 4 reduced latin squares of order 4; 4 * 4! * 3! is  576
There are 56 reduced latin squares of order 5; 56 * 5! * 4! is  161280
There are 9408 reduced latin squares of order 6; 9408 * 6! * 5! is  812851200


Julia

using Combinatorics

clash(row2, row1::Vector{Int}) = any(i -> row1[i] == row2[i], 1:length(row2))

clash(row, rows::Vector{Vector{Int}}) = any(r -> clash(row, r), rows)

permute_onefixed(i, n) = map(vec -> vcat(i, vec), permutations(filter(x -> x != i, 1:n)))

filter_permuted(rows, i, n) = filter(v -> !clash(v, rows), permute_onefixed(i, n))

function makereducedlatinsquares(n)
    matarray = [reshape(collect(1:n), 1, n)]
    for i in 2:n
        newmatarray = Vector{Matrix{Int}}()
        for mat in matarray
            r = size(mat)[1] + 1
            newrows = filter_permuted(collect(row[:] for row in eachrow(mat)), r, n)
            newmat = zeros(Int, r, n)
            newmat[1:r-1, :] .= mat
            append!(newmatarray, 
                [deepcopy(begin newmat[i, :] .= row; newmat end) for row in newrows])
        end
        matarray = newmatarray
    end
    matarray, length(matarray)
end

function testlatinsquares()
    squares, count = makereducedlatinsquares(4)
    println("The four reduced latin squares of order 4 are:")
    for sq in squares, (i, row) in enumerate(eachrow(sq)), j in 1:4
        print(row[j], j == 4 ? (i == 4 ? "\n\n" : "\n") : " ")
    end
    for i in 1:6
        squares, count = makereducedlatinsquares(i)
        println("Order $i: Size ", rpad(count, 5), "* $(i)! * $(i - 1)! = ", 
            count * factorial(i) * factorial(i - 1)) 
    end
end
    
testlatinsquares()
Output:
The four reduced latin squares of order 4 are:
1 2 3 4
2 1 4 3
3 4 1 2
4 3 2 1

1 2 3 4
2 1 4 3
3 4 2 1
4 3 1 2

1 2 3 4
2 3 4 1
3 4 1 2
4 1 2 3

1 2 3 4
2 4 1 3
3 1 4 2
4 3 2 1

Order 1: Size 1    * 1! * 0! = 1
Order 2: Size 1    * 2! * 1! = 2
Order 3: Size 1    * 3! * 2! = 12
Order 4: Size 4    * 4! * 3! = 576
Order 5: Size 56   * 5! * 4! = 161280
Order 6: Size 9408 * 6! * 5! = 812851200

Kotlin

Translation of: D
typealias Matrix = MutableList<MutableList<Int>>

fun dList(n: Int, sp: Int): Matrix {
    val start = sp - 1 // use 0 basing

    val a = generateSequence(0) { it + 1 }.take(n).toMutableList()
    a[start] = a[0].also { a[0] = a[start] }
    a.subList(1, a.size).sort()

    val first = a[1]
    // recursive closure permutes a[1:]
    val r = mutableListOf<MutableList<Int>>()
    fun recurse(last: Int) {
        if (last == first) {
            // bottom of recursion. you get here once for each permutation.
            // test if permutation is deranged
            for (jv in a.subList(1, a.size).withIndex()) {
                if (jv.index + 1 == jv.value) {
                    return  // no, ignore it
                }
            }
            // yes, save a copy with 1 based indexing
            val b = a.map { it + 1 }
            r.add(b.toMutableList())
            return
        }
        for (i in last.downTo(1)) {
            a[i] = a[last].also { a[last] = a[i] }
            recurse(last - 1)
            a[i] = a[last].also { a[last] = a[i] }
        }
    }
    recurse(n - 1)
    return r
}

fun reducedLatinSquares(n: Int, echo: Boolean): Long {
    if (n <= 0) {
        if (echo) {
            println("[]\n")
        }
        return 0
    } else if (n == 1) {
        if (echo) {
            println("[1]\n")
        }
        return 1
    }

    val rlatin = MutableList(n) { MutableList(n) { it } }
    // first row
    for (j in 0 until n) {
        rlatin[0][j] = j + 1
    }

    var count = 0L
    fun recurse(i: Int) {
        val rows = dList(n, i)

        outer@
        for (r in 0 until rows.size) {
            rlatin[i - 1] = rows[r].toMutableList()
            for (k in 0 until i - 1) {
                for (j in 1 until n) {
                    if (rlatin[k][j] == rlatin[i - 1][j]) {
                        if (r < rows.size - 1) {
                            continue@outer
                        }
                        if (i > 2) {
                            return
                        }
                    }
                }
            }
            if (i < n) {
                recurse(i + 1)
            } else {
                count++
                if (echo) {
                    printSquare(rlatin)
                }
            }
        }
    }

    // remaining rows
    recurse(2)
    return count
}

fun printSquare(latin: Matrix) {
    for (row in latin) {
        println(row)
    }
    println()
}

fun factorial(n: Long): Long {
    if (n == 0L) {
        return 1
    }
    var prod = 1L
    for (i in 2..n) {
        prod *= i
    }
    return prod
}

fun main() {
    println("The four reduced latin squares of order 4 are:\n")
    reducedLatinSquares(4, true)

    println("The size of the set of reduced latin squares for the following orders")
    println("and hence the total number of latin squares of these orders are:\n")
    for (n in 1 until 7) {
        val size = reducedLatinSquares(n, false)
        var f = factorial(n - 1.toLong())
        f *= f * n * size
        println("Order $n: Size %-4d x $n! x ${n - 1}! => Total $f".format(size))
    }
}
Output:
The four reduced latin squares of order 4 are:

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 1, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 2, 1]
[4, 3, 1, 2]

[1, 2, 3, 4]
[2, 4, 1, 3]
[3, 1, 4, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 3, 4, 1]
[3, 4, 1, 2]
[4, 1, 2, 3]

The size of the set of reduced latin squares for the following orders
and hence the total number of latin squares of these orders are:

Order 1: Size 1    x 1! x 0! => Total 1
Order 2: Size 1    x 2! x 1! => Total 2
Order 3: Size 1    x 3! x 2! => Total 12
Order 4: Size 4    x 4! x 3! => Total 576
Order 5: Size 56   x 5! x 4! => Total 161280
Order 6: Size 9408 x 6! x 5! => Total 812851200

MiniZinc

The Model (lsRF.mnz)

%Latin Squares in Reduced Form. Nigel Galloway, September 5th., 2019
include "alldifferent.mzn";
int: N;
array[1..N,1..N] of var 1..N: p; constraint forall(n in 1..N)(p[1,n]=n /\ p[n,1]=n);
constraint forall(n in 1..N)(alldifferent([p[n,g]|g in 1..N])/\alldifferent([p[g,n]|g in 1..N]));

The Tasks

displaying the four reduced Latin Squares of order 4
include "lsRF.mzn";
 output  [show_int(1,p[i,j])++
          if j == 4 then
              if i != 4 then "\n"
              else "" endif
          else "" endif  
          | i,j in 1..4 ] ++ ["\n"];

When the above is run using minizinc --all-solutions -DN=4 the following is produced:

Output:
1234
2143
3421
4312
----------
1234
2143
3412
4321
----------
1234
2413
3142
4321
----------
1234
2341
3412
4123
----------
==========
counting the solutions

minizinc.exe --all-solutions -DN=5 -s lsRF.mzn produces the following:

.
.
.
p = array2d(1..5, 1..5, [1, 2, 3, 4, 5, 2, 3, 4, 5, 1, 3, 1, 5, 2, 4, 4, 5, 2, 1, 3, 5, 4, 1, 3, 2]);
----------
p = array2d(1..5, 1..5, [1, 2, 3, 4, 5, 2, 3, 5, 1, 4, 3, 5, 4, 2, 1, 4, 1, 2, 5, 3, 5, 4, 1, 3, 2]);
----------
p = array2d(1..5, 1..5, [1, 2, 3, 4, 5, 2, 3, 4, 5, 1, 3, 5, 2, 1, 4, 4, 1, 5, 2, 3, 5, 4, 1, 3, 2]);
----------
==========
%%%mzn-stat: initTime=0.057
%%%mzn-stat: solveTime=0.003
%%%mzn-stat: solutions=56
%%%mzn-stat: variables=43
%%%mzn-stat: propagators=8
%%%mzn-stat: propagations=960
%%%mzn-stat: nodes=111
%%%mzn-stat: failures=0
%%%mzn-stat: restarts=0
%%%mzn-stat: peakDepth=7
%%%mzn-stat-end
%%%mzn-stat: nSolutions=56

and minizinc.exe --all-solutions -DN=6 -s lsRF.mzn produces the following:

.
.
.
p = array2d(1..6, 1..6, [1, 2, 3, 4, 5, 6, 2, 4, 5, 6, 3, 1, 3, 1, 4, 2, 6, 5, 4, 6, 2, 5, 1, 3, 5, 3, 6, 1, 2, 4, 6, 5, 1, 3, 4, 2]);
----------
p = array2d(1..6, 1..6, [1, 2, 3, 4, 5, 6, 2, 1, 4, 6, 3, 5, 3, 4, 5, 2, 6, 1, 4, 6, 2, 5, 1, 3, 5, 3, 6, 1, 2, 4, 6, 5, 1, 3, 4, 2]);
----------
==========
%%%mzn-stat: initTime=0.003
%%%mzn-stat: solveTime=6.669
%%%mzn-stat: solutions=9408
%%%mzn-stat: variables=58
%%%mzn-stat: propagators=10
%%%mzn-stat: propagations=179635
%%%mzn-stat: nodes=19035
%%%mzn-stat: failures=110
%%%mzn-stat: restarts=0
%%%mzn-stat: peakDepth=17
%%%mzn-stat-end
%%%mzn-stat: nSolutions=9408

The only way to complete the tasks requirement to produce a table is with another language. Ruby has the ability to run an external program, capture the output, and text handling ability to format it to this tasks requirements. Othe scripting languages are available.

Nim

Translation of: Go, Python, D, Kotlin

We use the Go algorithm but have chosen to create two types, Row and Matrix, to simulate sequences starting at index 1. So, the indexes and tests are somewhat different.

import algorithm, math, sequtils, strformat

type

  # Row managed as a sequence of ints with base index 1.
  Row = object
    value: seq[int]

  # Matrix managed as a sequence of rows with base index 1.
  Matrix = object
    value: seq[Row]

func newRow(n: Natural = 0): Row =
  ## Create a new row of length "n".
  Row(value: newSeq[int](n))

# Create a new matrix of length "n" containing rows of length "p".
func newMatrix(n, p: Natural = 0): Matrix = Matrix(value: newSeqWith(n, newRow(p)))

# Functions for rows.
func `[]`(r: var Row; i: int): var int = r.value[i - 1]
func `[]=`(r: var Row; i, n: int) = r.value[i - 1] = n
func sort(r: var Row; low, high: Positive) =
  r.value.toOpenArray(low - 1, high - 1).sort()
func `$`(r: Row): string = ($r.value)[1..^1]

# Functions for matrices.
func `[]`(m: Matrix; i: int): Row = m.value[i - 1]
func `[]`(m: var Matrix; i: int): var Row = m.value[i - 1]
func `[]=`(m: var Matrix; i: int; r: Row) = m.value[i - 1] = r
func high(m: Matrix): Natural = m.value.len
func add(m: var Matrix; r: Row) = m.value.add r
func `$`(m: Matrix): string =
  for row in m.value: result.add $row & '\n'


func dList(n, start: Positive): Matrix =
  ## Generate derangements of first 'n' numbers, with 'start' in first place.

  var a = Row(value: toSeq(1..n))

  swap a[1], a[start]
  a.sort(2, n)
  let first = a[2]
  var r: Matrix

  func recurse(last: int) =
    ## Recursive closure permutes a[2..^1].
    if last == first:
      # Bottom of recursion. You get here once for each permutation.
      # Test if permutation is deranged.
      for i in 2..n:
        if a[i] == i: return  # No: ignore it.
      r.add a
      return
    for i in countdown(last, 2):
      swap a[i], a[last]
      recurse(last - 1)
      swap a[i], a[last]

  recurse(n)
  result = r


proc reducedLatinSquares(n: Positive; print: bool): int =

  if n == 1:
    if print: echo [1]
    return 1

  var rlatin = newMatrix(n, n)
  # Initialize first row.
  for i in 1..n: rlatin[1][i] = i

  var count = 0

  proc recurse(i: int) =
    let rows = dList(n, i)
    for r in 1..rows.high:
      block inner:
        rlatin[i] = rows[r]
        for k in 1..<i:
          for j in 2..n:
            if rlatin[k][j] == rlatin[i][j]:
              if r < rows.high: break inner
              if i > 2: return
        if i < n:
          recurse(i + 1)
        else:
          inc count
          if print: echo rlatin

  # Remaining rows.
  recurse(2)
  result = count


when isMainModule:

  echo "The four reduced latin squares of order 4 are:"
  discard reducedLatinSquares(4, true)

  echo "The size of the set of reduced latin squares for the following orders"
  echo "and hence the total number of latin squares of these orders are:"
  for n in 1..6:
    let size = reducedLatinSquares(n, false)
    let f = fac(n - 1)^2 * n * size
    echo &"Order {n}: Size {size:<4} x {n}! x {n - 1}! => Total {f}"
Output:
The four reduced latin squares of order 4 are:
[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 1, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 2, 1]
[4, 3, 1, 2]

[1, 2, 3, 4]
[2, 4, 1, 3]
[3, 1, 4, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 3, 4, 1]
[3, 4, 1, 2]
[4, 1, 2, 3]

The size of the set of reduced latin squares for the following orders
and hence the total number of latin squares of these orders are:
Order 1: Size 1    x 1! x 0! => Total 1
Order 2: Size 1    x 2! x 1! => Total 2
Order 3: Size 1    x 3! x 2! => Total 12
Order 4: Size 4    x 4! x 3! => Total 576
Order 5: Size 56   x 5! x 4! => Total 161280
Order 6: Size 9408 x 6! x 5! => Total 812851200

Perl

It takes a little under 2 minutes to find order 7.

#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/Latin_Squares_in_reduced_form
use warnings;

my $n = 0;
my $count;
our @perms;

while( ++$n <= 7 )
  {
  $count = 0;
  @perms = perm( my $start = join '', 1 .. $n );
  find( $start );
  print "order $n size $count total @{[$count * fact($n) * fact($n-1)]}\n\n";
  }

sub find
  {
  @_ >= $n and return $count += ($n != 4) || print join "\n", @_, "\n";
  local @perms = grep 0 == ($_[-1] ^ $_) =~ tr/\0//, @perms;
  my $row = @_ + 1;
  find( @_, $_ ) for grep /^$row/, @perms;
  }

sub fact { $_[0] > 1 ? $_[0] * fact($_[0] - 1) : 1 }

sub perm
  {
  my $s = shift;
  length $s <= 1 ? $s :
    map { my $f = $_; map "$f$_", perm( $s =~ s/$_//r ) } split //, $s;
  }
Output:
order 1 size 1 total 1

order 2 size 1 total 2

order 3 size 1 total 12

1234
2143
3412
4321

1234
2143
3421
4312

1234
2341
3412
4123

1234
2413
3142
4321

order 4 size 4 total 576

order 5 size 56 total 161280

order 6 size 9408 total 812851200

order 7 size 16942080 total 61479419904000

Phix

A Simple backtracking search.
aside: in phix here is no difference between res[r][c] and res[r,c]. I mixed them here, using whichever felt the more natural to me.

string aleph = "123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"
 
function rfls(integer n, bool count_only=true)
    if n>length(aleph) then ?9/0 end if -- too big...
    if n=1 then return iff(count_only?1:{{1}}) end if
    sequence tn = tagset(n),     -- {1..n}
             vcs = repeat(tn,n), -- valid for cols
             vrs = repeat(tn,n), -- valid for rows
             res = repeat(tn,n)  -- (main workspace/one element of result)
    object result = iff(count_only?0:{})
    vcs[1] = {}     -- (not strictly necessary)
    vrs[1] = {}     --          """
    for i=2 to n do
        res[i] = i & repeat(0,n-1)
        vrs[i][i] = 0
        vcs[i][i] = 0
    end for
    integer r = 2, c = 2
    while true do
        -- place with backtrack:
        -- if we successfully place [n,n] add to results and backtrack
        -- terminate when we fail to place or backtrack from [2,2]
        integer rrc = res[r,c]
        if rrc!=0 then  -- backtrack (/undo)
            if vrs[r][rrc]!=0 then ?9/0 end if  -- sanity check
            if vcs[c][rrc]!=0 then ?9/0 end if  --      ""
            res[r,c] = 0
            vrs[r][rrc] = rrc
            vcs[c][rrc] = rrc
        end if
        bool found = false
        for i=rrc+1 to n do
            if vrs[r][i] and vcs[c][i] then
                res[r,c] = i
                vrs[r][i] = 0
                vcs[c][i] = 0
                found = true
                exit
            end if
        end for
        if found then
            if r=n and c=n then
                if count_only then
                    result += 1 
                else
                    result = append(result,res)
                end if
                -- (here, backtracking == not advancing)
            elsif c=n then
                c = 2
                r += 1
            else
                c += 1  
            end if
        else
            -- backtrack
            if r=2 and c=2 then exit end if
            c -= 1
            if c=1 then
                r -= 1
                c = n
            end if
        end if
    end while
    return result
end function
 
procedure reduced_form_latin_squares(integer n)
    sequence res = rfls(n,false)
    for k=1 to length(res) do
        for i=1 to n do
            string line = ""
            for j=1 to n do
                line &= aleph[res[k][i][j]]
            end for
            res[k][i] = line
        end for
        res[k] = join(res[k],"\n")
    end for
    string r = join(res,"\n\n")
    printf(1,"There are %d reduced form latin squares of order %d:\n%s\n",{length(res),n,r})
end procedure

reduced_form_latin_squares(4)
puts(1,"\n")
for n=1 to 6 do
    integer size = rfls(n)
    atom f = factorial(n)*factorial(n-1)*size
    printf(1,"Order %d: Size %-4d x %d! x %d! => Total %d\n", {n, size, n, n-1, f})
end for
Output:
There are 4 reduced form latin squares of order 4:
1234
2143
3412
4321

1234
2143
3421
4312

1234
2341
3412
4123

1234
2413
3142
4321

Order 1: Size 1    x 1! x 0! => Total 1
Order 2: Size 1    x 2! x 1! => Total 2
Order 3: Size 1    x 3! x 2! => Total 12
Order 4: Size 4    x 4! x 3! => Total 576
Order 5: Size 56   x 5! x 4! => Total 161280
Order 6: Size 9408 x 6! x 5! => Total 812851200

Whle the above finishes near-instantly, if you push it to 7 and add an elapsed(), you'll get:

Order 7: Size 16942080 x 7! x 6! => Total 61479419904000
"2 minutes and 23s"

Picat

Using Constraint modelling.

The four solutions for N=4

import cp.

main =>
  N = 4,
  latin_square_reduced_form(N, X),
  foreach(Row in X)
    println(Row.to_list)
  end,
  nl,
  fail.

latin_square_reduced_form(N, X) =>
  X = new_array(N,N),
  X :: 1..N,
  foreach(I in 1..N)
    all_different([X[I,J] : J in 1..N]),
    all_different([X[J,I] : J in 1..N]),    
    X[1,I] #= I,
    X[I,1] #= I
  end,
  solve(X).
Output:
[1,2,3,4]
[2,1,4,3]
[3,4,1,2]
[4,3,2,1]

[1,2,3,4]
[2,1,4,3]
[3,4,2,1]
[4,3,1,2]

[1,2,3,4]
[2,3,4,1]
[3,4,1,2]
[4,1,2,3]

[1,2,3,4]
[2,4,1,3]
[3,1,4,2]
[4,3,2,1]

Number of solutions

import cp.

main =>
  foreach(N in 1..7)
    Count = count_all(latin_square_reduced_form(N, _X)),
    printf("%2d %10d x %d! x %d! %16w\n",N,Count,N,N-1, Count*factorial(N)*factorial(N-1))
  end,
  nl.
Output:
 1          1 x 1! x 0!                1
 2          1 x 2! x 1!                2
 3          1 x 3! x 2!               12
 4          4 x 4! x 3!              576
 5         56 x 5! x 4!           161280
 6       9408 x 6! x 5!        812851200
 7   16942080 x 7! x 6!   61479419904000

For N=1..6 this model takes 23ms. For N=1..7 it takes 28.1s.

Python

Translation of: D
def dList(n, start):
    start -= 1 # use 0 basing
    a = range(n)
    a[start] = a[0]
    a[0] = start
    a[1:] = sorted(a[1:])
    first = a[1]
    # rescursive closure permutes a[1:]
    r = []
    def recurse(last):
        if (last == first):
            # bottom of recursion. you get here once for each permutation.
            # test if permutation is deranged.
            # yes, save a copy with 1 based indexing
            for j,v in enumerate(a[1:]):
                if j + 1 == v:
                    return # no, ignore it
            b = [x + 1 for x in a]
            r.append(b)
            return
        for i in xrange(last, 0, -1):
            a[i], a[last] = a[last], a[i]
            recurse(last - 1)
            a[i], a[last] = a[last], a[i]
    recurse(n - 1)
    return r

def printSquare(latin,n):
    for row in latin:
        print row
    print

def reducedLatinSquares(n,echo):
    if n <= 0:
        if echo:
            print []
        return 0
    elif n == 1:
        if echo:
            print [1]
        return 1

    rlatin = [None] * n
    for i in xrange(n):
        rlatin[i] = [None] * n
    # first row
    for j in xrange(0, n):
        rlatin[0][j] = j + 1

    class OuterScope:
        count = 0
    def recurse(i):
        rows = dList(n, i)

        for r in xrange(len(rows)):
            rlatin[i - 1] = rows[r]
            justContinue = False
            k = 0
            while not justContinue and k < i - 1:
                for j in xrange(1, n):
                    if rlatin[k][j] == rlatin[i - 1][j]:
                        if r < len(rows) - 1:
                            justContinue = True
                            break
                        if i > 2:
                            return
                k += 1
            if not justContinue:
                if i < n:
                    recurse(i + 1)
                else:
                    OuterScope.count += 1
                    if echo:
                        printSquare(rlatin, n)

    # remaining rows
    recurse(2)
    return OuterScope.count

def factorial(n):
    if n == 0:
        return 1
    prod = 1
    for i in xrange(2, n + 1):
        prod *= i
    return prod

print "The four reduced latin squares of order 4 are:\n"
reducedLatinSquares(4,True)

print "The size of the set of reduced latin squares for the following orders"
print "and hence the total number of latin squares of these orders are:\n"
for n in xrange(1, 7):
    size = reducedLatinSquares(n, False)
    f = factorial(n - 1)
    f *= f * n * size
    print "Order %d: Size %-4d x %d! x %d! => Total %d" % (n, size, n, n - 1, f)
Output:
The four reduced latin squares of order 4 are:

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 1, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 2, 1]
[4, 3, 1, 2]

[1, 2, 3, 4]
[2, 4, 1, 3]
[3, 1, 4, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 3, 4, 1]
[3, 4, 1, 2]
[4, 1, 2, 3]

The size of the set of reduced latin squares for the following orders
and hence the total number of latin squares of these orders are:

Order 1: Size 1    x 1! x 0! => Total 1
Order 2: Size 1    x 2! x 1! => Total 2
Order 3: Size 1    x 3! x 2! => Total 12
Order 4: Size 4    x 4! x 3! => Total 576
Order 5: Size 56   x 5! x 4! => Total 161280
Order 6: Size 9408 x 6! x 5! => Total 812851200

Raku

(formerly Perl 6)

# utilities: factorial, sub-factorial, derangements
sub  postfix:<!>($n) { (constant f = 1, |[\×] 1..*)[$n] }
sub   prefix:<!>($n) { (1, 0, 1, -> $a, $b { ($++ + 2) × ($b + $a) } ... *)[$n] }
sub derangements(@l) { @l.permutations.grep(-> @p { none(@p Zeqv @l) }) }

sub LS-reduced (Int $n) {
    return [1] if $n == 1;

    my @LS;
    my @l = 1 X+ ^$n;
    my %D = derangements(@l).classify(*.[0]);

    for [X] (^(!$n/($n-1))) xx $n-1 -> $tuple {
        my @d.push: @l;
        @d.push: %D{2}[$tuple[0]];
        LOOP:
        for 3 .. $n -> $x {
            my @try = |%D{$x}[$tuple[$x-2]];
            last LOOP if any @try »==« @d[$_] for 1..@d-1;
            @d.push: @try;
        }
        next unless @d == $n and [==] [Z+] @d;
        @LS.push: @d;
    }
    @LS
}

say .join("\n") ~ "\n" for LS-reduced(4);
for 1..6 -> $n {
    printf "Order $n: Size %-4d x $n! x {$n-1}! => Total %d\n", $_, $_ * $n! * ($n-1)! given LS-reduced($n).elems
}
Output:
1 2 3 4
2 1 4 3
3 4 1 2
4 3 2 1

1 2 3 4
2 1 4 3
3 4 2 1
4 3 1 2

1 2 3 4
2 3 4 1
3 4 1 2
4 1 2 3

1 2 3 4
2 4 1 3
3 1 4 2
4 3 2 1

Order 1: Size 1    x 1! x 0! => Total 1
Order 2: Size 1    x 2! x 1! => Total 2
Order 3: Size 1    x 3! x 2! => Total 12
Order 4: Size 4    x 4! x 3! => Total 576
Order 5: Size 56   x 5! x 4! => Total 161280
Order 6: Size 9408 x 6! x 5! => Total 812851200

Ruby

Translation of: D
def printSquare(a)
    for row in a
        print row, "\n"
    end
    print "\n"
end

def dList(n, start)
    start = start - 1 # use 0 based indexing
    a = Array.new(n) {|i| i}
    a[0], a[start] = a[start], a[0]
    a[1..] = a[1..].sort
    first = a[1]

    r = []
    recurse = lambda {|last|
        if last == first then
            # bottom of recursion, reached once for each permutation
            # test if permutation is deranged
            a[1..].each_with_index {|v, j|
                if j + 1 == v then
                    return # no, ignore it
                end
            }
            # yes, save a copy with 1 based indexing
            b = a.map { |i| i + 1 }
            r << b
            return
        end

        i = last
        while i >= 1 do
            a[i], a[last] = a[last], a[i]
            recurse.call(last - 1)
            a[i], a[last] = a[last], a[i]
            i = i - 1
        end
    }

    recurse.call(n - 1)
    return r
end

def reducedLatinSquares(n, echo)
    if n <= 0 then
        if echo then
            print "[]\n\n"
        end
        return 0
    end
    if n == 1 then
        if echo then
            print "[1]\n\n"
        end
        return 1
    end

    rlatin = Array.new(n) { Array.new(n, Float::NAN)}

    # first row
    for j in 0 .. n - 1
        rlatin[0][j] = j + 1
    end

    count = 0
    recurse = lambda {|i|
        rows = dList(n, i)

        for r in 0 .. rows.length - 1
            rlatin[i - 1] = rows[r].dup
            catch (:outer) do
                for k in 0 .. i - 2
                    for j in 1 .. n - 1
                        if rlatin[k][j] == rlatin[i - 1][j] then
                            if r < rows.length - 1 then
                                throw :outer
                            end
                            if i > 2 then
                                return
                            end
                        end
                    end
                end
                if i < n then
                    recurse.call(i + 1)
                else
                    count = count + 1
                    if echo then
                        printSquare(rlatin)
                    end
                end
            end
        end
    }

    # remaining rows
    recurse.call(2)
    return count
end

def factorial(n)
    if n == 0 then
        return 1
    end
    prod = 1
    for i in 2 .. n
        prod = prod * i
    end
    return prod
end

print "The four reduced latin squares of order 4 are:\n"
reducedLatinSquares(4, true)

print "The size of the set of reduced latin squares for the following orders\n"
print "and hence the total number of latin squares of these orders are:\n"
for n in 1 .. 6
    size = reducedLatinSquares(n, false)
    f = factorial(n - 1)
    f = f * f * n * size
    print "Order %d Size %-4d x %d! x %d! => Total %d\n" % [n, size, n, n - 1, f]
end
Output:
The four reduced latin squares of order 4 are:
[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 1, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 2, 1]
[4, 3, 1, 2]

[1, 2, 3, 4]
[2, 4, 1, 3]
[3, 1, 4, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 3, 4, 1]
[3, 4, 1, 2]
[4, 1, 2, 3]

The size of the set of reduced latin squares for the following orders
and hence the total number of latin squares of these orders are:
Order 1 Size 1    x 1! x 0! => Total 1
Order 2 Size 1    x 2! x 1! => Total 2
Order 3 Size 1    x 3! x 2! => Total 12
Order 4 Size 4    x 4! x 3! => Total 576
Order 5 Size 56   x 5! x 4! => Total 161280
Order 6 Size 9408 x 6! x 5! => Total 812851200

Visual Basic .NET

Translation of: C#
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
Output:
The four reduced latin squares of order 4 are:

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 1, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 2, 1]
[4, 3, 1, 2]

[1, 2, 3, 4]
[2, 4, 1, 3]
[3, 1, 4, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 3, 4, 1]
[3, 4, 1, 2]
[4, 1, 2, 3]

The size of the set of reduced latin squares for the following orders
and hence the total number of latin squares of these orders are:

Order 1: Size 1 x 1! x 0! => Total 1
Order 2: Size 1 x 2! x 1! => Total 2
Order 3: Size 1 x 3! x 2! => Total 12
Order 4: Size 4 x 4! x 3! => Total 576
Order 5: Size 56 x 5! x 4! => Total 161280
Order 6: Size 9408 x 6! x 5! => Total 812851200

Wren

Translation of: Go
Library: Wren-sort
Library: Wren-math
Library: Wren-fmt
import "./sort" for Sort
import "./math" for Int
import "./fmt" for Fmt

// generate derangements of first n numbers, with 'start' in first place.
var dList = Fn.new { |n, start|
    var r = []
    start = start - 1 // use 0 basing
    var a = [0] * n
    for (i in 1...n) a[i] = i
    a[start] = a[0]
    a[0] = start
    Sort.quick(a, 1, a.count - 1, false)
    var first = a[1]
    var recurse // recursive closure permutes a[1..-1]
    recurse = Fn.new { |last|
        if (last == first) {
            // bottom of recursion.  you get here once for each permutation.
            // test if permutation is deranged.
            var j = 1
            for (v in a.skip(1)) {
                if (j == v) return // no, ignore it
                j = j + 1
            }
            // yes, save a copy
            var b = a.toList
            for (i in 0...b.count) b[i] = b[i] + 1  // change back to 1 basing
            r.add(b)
            return
        }
        var i = last
        while (i >= 1) {
            var t = a[i]
            a[i] = a[last]
            a[last] = t
            recurse.call(last-1)
            t = a[i]
            a[i] = a[last]
            a[last] = t
            i = i - 1
        }
    }
    recurse.call(n-1)
    return r
}

var printSquare = Fn.new { |latin, n|
    System.print(latin.join("\n"))
    System.print()
}

var reducedLatinSquare = Fn.new { |n, echo|
    if (n <= 0) {
        if (echo) System.print("[]\n")
        return 0
    }
    if (n == 1) {
        if (echo) System.print("[1]\n")
        return 1
    }
    var rlatin = List.filled(n, null)
    for (i in 0...n) rlatin[i] = List.filled(n, 0)
    // first row
    for (j in 0...n) rlatin[0][j] = j + 1
    var count = 0
    var recurse // // recursive closure to compute reduced latin squares and count or print them
    recurse = Fn.new { |i|
        var rows = dList.call(n, i) // get derangements of first n numbers, with 'i' first.
        for (r in 0...rows.count) {
            var outer = false
            for (rr in 0...rows[r].count) rlatin[i-1][rr] = rows[r][rr]
            var k = 0
            while (k < i-1) {
                var j = 1
                while (j < n) {
                    if (rlatin[k][j] == rlatin[i-1][j]) {
                        if (r < rows.count - 1) {
                            outer = true
                            break
                        } else if (i > 2) {
                            return
                        }
                    }
                    j = j + 1
                }
                if (outer) break
                k = k + 1
            }
            if (!outer) {
                if (i < n) {
                    recurse.call(i + 1)
                } else {
                    count = count + 1
                    if (echo) printSquare.call(rlatin, n)
                }
            }
        }
    }

    // remaining rows
    recurse.call(2)
    return count
}

System.print("The four reduced latin squares of order 4 are:\n")
reducedLatinSquare.call(4, true)

System.print("The size of the set of reduced latin squares for the following orders")
System.print("and hence the total number of latin squares of these orders are:\n")
for (n in 1..6) {
    var size = reducedLatinSquare.call(n, false)
    var f = Int.factorial(n-1)
    f = f * f * n * size
    Fmt.print("Order $d: Size $-4d x $d! x $d! => Total $d", n, size, n, n-1, f)
}
Output:
The four reduced latin squares of order 4 are:

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 1, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 2, 1]
[4, 3, 1, 2]

[1, 2, 3, 4]
[2, 4, 1, 3]
[3, 1, 4, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 3, 4, 1]
[3, 4, 1, 2]
[4, 1, 2, 3]

The size of the set of reduced latin squares for the following orders
and hence the total number of latin squares of these orders are:

Order 1: Size 1    x 1! x 0! => Total 1
Order 2: Size 1    x 2! x 1! => Total 2
Order 3: Size 1    x 3! x 2! => Total 12
Order 4: Size 4    x 4! x 3! => Total 576
Order 5: Size 56   x 5! x 4! => Total 161280
Order 6: Size 9408 x 6! x 5! => Total 812851200

zkl

Translation of: Go

This reuses the dList function from the Permutations/Derangements#zkl task, suitably adjusted for the present one.

fcn reducedLatinSquare(n,write=False){
   if(n<=1) return(n);
   rlatin:=n.pump(List(), List.createLong(n,0).copy);  // matrix of zeros
   foreach i in (n){ rlatin[0][i]=i+1 }  // first row: (1,2,3..n)

   count:=Ref(0);
   // recursive closure to compute reduced latin squares and count or print them
   rows,rsz := derangements(n), rows.len();
   recurse:='wrap(i){
      foreach r in (rsz){	      // top
         if(rows[r][0]!=i) continue;  // filter by first column, ignore all but i
         rlatin[i-1]=rows[r].copy();
	 foreach k,j in ([0..i-2],[1..n-1]){	// nested loop: foreach foreach
	    if(rlatin[k][j] == rlatin[i-1][j]){
	       if(r < rsz-1) continue(3);	// -->top
	       if(i>2) return();
	    }
	 }
	 if(i<n) self.fcn(i + 1, vm.pasteArgs(1));  // 'wrap hides local data (ie count, rows, etc)
	 else{
	    count.inc();
	    if(write) printSquare(rlatin,n);
	 }
      }
   };
   recurse(2);   // remaining rows
   return(count.value);
}
fcn derangements(n,i){
   enum:=[1..n].pump(List);
   Utils.Helpers.permuteW(enum).tweak('wrap(perm){
      if(perm.zipWith('==,enum).sum(0)) Void.Skip
      else perm
   }).pump(List);
}
fcn printSquare(matrix,n){
   matrix.pump(Console.println,fcn(l){ l.concat(", ","[","]") });
   println();
}
fcn fact(n){ ([1..n]).reduce('*,1) }
println("The four reduced latin squares of order 4 are:");
reducedLatinSquare(4,True);

println("The size of the set of reduced latin squares for the following orders");
println("and hence the total number of latin squares of these orders are:");
foreach n in ([1..6]){
   size,f,f := reducedLatinSquare(n), fact(n - 1), f*f*n*size;;
   println("Order %d: Size %-4d x %d! x %d! -> Total %,d".fmt(n,size,n,n-1,f));
}
Output:
The four reduced latin squares of order 4 are:
[1, 2, 3, 4]
[2, 3, 4, 1]
[3, 4, 1, 2]
[4, 1, 2, 3]

[1, 2, 3, 4]
[2, 4, 1, 3]
[3, 1, 4, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 1, 2]
[4, 3, 2, 1]

[1, 2, 3, 4]
[2, 1, 4, 3]
[3, 4, 2, 1]
[4, 3, 1, 2]

The size of the set of reduced latin squares for the following orders
and hence the total number of latin squares of these orders are:
Order 1: Size 1    x 1! x 0! -> Total 1
Order 2: Size 1    x 2! x 1! -> Total 2
Order 3: Size 1    x 3! x 2! -> Total 12
Order 4: Size 4    x 4! x 3! -> Total 576
Order 5: Size 56   x 5! x 4! -> Total 161,280
Order 6: Size 9408 x 6! x 5! -> Total 812,851,200