September 26, 2018

Just Juxt #43: Latin Square Slicing (4clojure #152)

Latin square

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)
Tags: coding exercises KLIPSE 4clojure Cryogen juxt