Just Juxt #43: Latin Square Slicing (4clojure #152)
A Latin square of order n is an n x n array that contains n different elements, each occurring exactly once in each row, and exactly once in each column. For example, among the following arrays only the first one forms a Latin square:
A B C A B C A B C
B C A B C A B D A
C A B C A C C A B
Let V be a vector of such vectors(Of course, we can consider sequences instead of vectors) that they may differ in length(Length of a vector is the number of elements in the vector). We will say that an arrangement of vectors of V in consecutive rows is an alignment (of vectors) of V if the following conditions are satisfied:
All vectors of V are used. Each row contains just one vector. The order of V is preserved. All vectors of maximal length are horizontally aligned each other. If a vector is not of maximal length then all its elements are aligned with elements of some subvector of a vector of maximal length. Let L denote a Latin square of order 2 or greater. We will say that L is included in V or that V includes L iff there exists an alignment of V such that contains a subsquare that is equal to L. For example, if V equals [1 2 3[3 1 2]] then there are nine alignments of V (brackets omitted):
1 2 3
1 2 3 1 2 3 1 2 3
A 2 3 1 2 1 2 3 1 2 1 2 3 1 2 1
3 1 2 3 1 2 3 1 2
1 2 3 1 2 3 1 2 3
B 2 3 1 2 1 2 3 1 2 1 2 3 1 2 1
3 1 2 3 1 2 3 1 2
1 2 3 1 2 3 1 2 3
C 2 3 1 2 1 2 3 1 2 1 2 3 1 2 1
3 1 2 3 1 2 3 1 2
Alignment A1 contains Latin square [1 2 3[3 1 2]], alignments A2, A3, B1, B2, B3 contain no Latin squares, and alignments C1, C2, C3 contain [2 1]. Thus in this case V includes one Latin square of order 3 and one of order 2 which is included three times. Our aim is to implement a function which accepts a vector of vectors V as an argument, and returns a map which keys and values are integers. Each key should be the order of a Latin square included in V, and its value a count of different Latin squares of that order included in V. If V does not include any Latin squares an empty map should be returned. In the previous example the correct output of such a function is {3 1, 2 1} and not {3 1, 2 3}.
(ns live.test
(:require [cljs.test :refer-macros [deftest is run-tests]]))
(defn latin-slice [m]
(let [width (apply max (map count m))
squares (fn [m]
(let [[c-max c-min] (apply (juxt max min) (map count m))
n (count m)
sizes (map count m)
space #(- (apply min (map - sizes %)) n)
invert (fn [v] (map #(map (partial - (apply max %)) %) v))
cart (fn cart [[a & r]]
(if a (for [x a y (cart r)] (cons x y)) [[]]))
aligns (filter
#(>= (space %) 0)
(distinct (invert (cart
(map #(range (inc (- width (count %)))) m)))))
shift (fn [v] (mapv
#(subvec %2 %1 (+ n %1))
v m))]
(map shift
(for [a aligns t (range (inc (space a)))]
(map #(+ t %) a)))))
latin? (fn [m]
(and
(= (count (set (flatten m))) (count m))
(every?
#(apply distinct? %)
(concat m (apply map vector m)))))
max-sub (reduce
#(if (> %1 %2) (dec %1) %1)
(count m)
(map count m))]
(apply hash-map
(mapcat
(fn[n] (#(if (> % 0) [n %] [])
(count
(filter latin?
(reduce #(conj %1 %2)
#{}
(mapcat squares (partition n 1 m)))))))
(range 2 (inc max-sub))))))
(deftest latin-slice-test
(is (= (latin-slice '[[A B C D]
[A C D B]
[B A D C]
[D C A B]])
{}))
(is (= (latin-slice '[[A B C D E F]
[B C D E F A]
[C D E F A B]
[D E F A B C]
[E F A B C D]
[F A B C D E]])
{6 1}))
(is (= (latin-slice '[[A B C D]
[B A D C]
[D C B A]
[C D A B]])
{4 1, 2 4}))
(is (= (latin-slice '[[B D A C B]
[D A B C A]
[A B C A B]
[B C A B C]
[A D B C A]])
{3 3}))
(is (= (latin-slice [ [2 4 6 3]
[3 4 6 2]
[6 2 4] ])
{}))
(is (= (latin-slice [[1]
[1 2 1 2]
[2 1 2 1]
[1 2 1 2]
[] ])
{2 2}))
(is (= (latin-slice [[3 1 2]
[1 2 3 1 3 4]
[2 3 1 3] ])
{3 1, 2 2}))
(is (= (latin-slice [[8 6 7 3 2 5 1 4]
[6 8 3 7]
[7 3 8 6]
[3 7 6 8 1 4 5 2]
[1 8 5 2 4]
[8 1 2 4 5]])
{4 1, 3 1, 2 7})))
(run-tests)