Random Latin squares: Difference between revisions

Content added Content deleted

Inline

@@ Line 1,114: / Line 1,114: @@
 given first row and first column.
-<lang haskell>latinSquare :: Eq a => [a] -> [a] -> [[a]]
+<lang haskell>import Data.List (permutations, (\\))
+latinSquare :: Eq a => [a] -> [a] -> [[a]]
 latinSquare [] [] = []
-latinSquare c r | head r /= head c = []
+latinSquare c r
+  | head r /= head c = []
-                | otherwise = reverse <$> foldl addRow firstRow perms
+  | otherwise = reverse <$> foldl addRow firstRow perms
   where
     -- permutations grouped by the first element
+    perms =
-    perms = tail $ (\x -> (x :) <$> permutations (r \\ [x])) <$> c
+      tail $
+        fmap
+          (fmap . (:) <*> (permutations . (r \\) . return))
+          c
     firstRow = pure <$> r
-    addRow tbl rows = head [ zipWith (:) row tbl
+    addRow tbl rows =
+      head
-                           | row <- rows
-                           , and $ different (tail row) (tail tbl) ]
+        [ zipWith (:) row tbl
+          | row <- rows,
+            and $ different (tail row) (tail tbl)
+        ]
     different = zipWith $ (not .) . elem
 printTable :: Show a => [[a]] -> IO ()
-printTable tbl = putStrLn $ unlines $ unwords . map show <$> tbl</lang>
+printTable tbl =
+  putStrLn $
+    unlines $
+      unwords . map show <$> tbl</lang>
 <pre>λ> printTable $ latinSquare [1,2,3,4,5] [1,3,2,5,4]