Data commit

Task/N-queens-problem/Haskell/n-queens-problem-1.hs

@@ -0,0 +1,30 @@
+import Control.Monad
+import Data.List
+
+-- given n, "queens n" solves the n-queens problem, returning a list of all the
+-- safe arrangements. each solution is a list of the columns where the queens are
+-- located for each row
+queens :: Int -> [[Int]]
+queens n = map fst $ foldM oneMoreQueen ([],[1..n]) [1..n]  where
+
+  -- foldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
+  -- foldM folds (from left to right) in the list monad, which is convenient for
+  -- "nondeterminstically" finding "all possible solutions" of something. the
+  -- initial value [] corresponds to the only safe arrangement of queens in 0 rows
+
+  -- given a safe arrangement y of queens in the first i rows, and a list of
+  -- possible choices, "oneMoreQueen y _" returns a list of all the safe
+  -- arrangements of queens in the first (i+1) rows along with remaining choices
+  oneMoreQueen (y,d) _ = [(x:y, delete x d) | x <- d, safe x]  where
+
+    -- "safe x" tests whether a queen at column x is safe from previous queens
+    safe x = and [x /= c + n && x /= c - n | (n,c) <- zip [1..] y]
+
+-- prints what the board looks like for a solution; with an extra newline
+printSolution y = do
+     let n = length y
+     mapM_ (\x -> putStrLn [if z == x then 'Q' else '.' | z <- [1..n]]) y
+     putStrLn ""
+
+-- prints all the solutions for 6 queens
+main = mapM_ printSolution $ queens 6

Task/N-queens-problem/Haskell/n-queens-problem-2.hs

@@ -0,0 +1,11 @@
+import Control.Monad (foldM)
+import Data.List ((\\))
+
+main :: IO ()
+main = mapM_ print $ queens 8
+
+queens :: Int -> [[Int]]
+queens n = foldM f [] [1..n]
+    where
+      f qs _ = [q:qs | q <- [1..n] \\ qs, q `notDiag` qs]
+      q `notDiag` qs = and [abs (q - qi) /= i | (qi,i) <- qs `zip` [1..]]

Task/N-queens-problem/Haskell/n-queens-problem-3.hs

@@ -0,0 +1,12 @@
+import Data.List (nub, permutations)
+
+-- checks if queens are on the same diagonal
+-- with [0..] we place each queen on her own row
+check f = length . nub . zipWith f [0..]
+
+-- filters out results where 2 or more queens are on the same diagonal
+-- with [0..n-1] we place each queeen on her own column
+generate n = filter (\x -> check (+) x == n && check (-) x == n) $ permutations [0..n-1]
+
+-- 8 is for "8 queens"
+main = print $ generate 8

Task/N-queens-problem/Haskell/n-queens-problem-4.hs

@@ -0,0 +1,54 @@
+import Data.List (intercalate, transpose)
+
+--------------------- N QUEENS PROBLEM -------------------
+
+queenPuzzle :: Int -> Int -> [[Int]]
+queenPuzzle nRows nCols
+  | nRows <= 0 = [[]]
+  | otherwise =
+      foldr
+        (\x y -> y <> foldr (go x) [] [1 .. nCols])
+        []
+        $ queenPuzzle (pred nRows) nCols
+  where
+    go qs iCol b
+      | safe (nRows - 1) iCol qs = b <> [qs <> [iCol]]
+      | otherwise = b
+
+safe :: Int -> Int -> [Int] -> Bool
+safe iRow iCol qs =
+  (not . or) $
+    zipWith
+      ( \sc sr ->
+          (iCol == sc) || (sc + sr == (iCol + iRow))
+            || (sc - sr == (iCol - iRow))
+      )
+      qs
+      [0 .. iRow - 1]
+
+--------------------------- TEST -------------------------
+-- 10 columns of solutions for the 7*7 board:
+showSolutions :: Int -> Int -> [String]
+showSolutions nCols nSize =
+  unlines
+    . fmap (intercalate "   ")
+    . transpose
+    . map boardLines
+    <$> chunksOf nCols (queenPuzzle nSize nSize)
+  where
+    go r x
+      | r == x = '♛'
+      | otherwise = '.'
+    boardLines rows =
+      [ go r <$> [1 .. (length rows)]
+        | r <- rows
+      ]
+
+chunksOf :: Int -> [a] -> [[a]]
+chunksOf i = splits
+  where
+    splits [] = []
+    splits l = take i l : splits (drop i l)
+
+main :: IO ()
+main = (putStrLn . unlines) $ showSolutions 10 7

Task/N-queens-problem/Haskell/n-queens-problem-5.hs

@@ -0,0 +1,63 @@
+import Control.Monad
+import System.Environment
+
+-- | data types for the puzzle
+type Row    = Int
+type State  = [Row]
+type Thread = [Row]
+
+-- | utility functions
+empty = null
+
+-- | Check for infeasible states
+infeasible :: Int -> (State, Thread) -> Bool
+infeasible n ([], _)    = False
+infeasible n ((r:rs),t) = length rs >= n || attack r rs || infeasible n (rs, t)
+
+feasible n st = not $ infeasible n st
+
+-- | Check if a row is attacking another row of a state
+attack :: Row -> [Row] -> Bool
+attack r rs = r `elem` rs
+            || r `elem` (upperDiag rs)
+            || r `elem` (lowerDiag rs)
+  where
+    upperDiag xs = zipWith (-) xs [1..]
+    lowerDiag xs = zipWith (+) xs [1..]
+
+-- | Check if it is a goal state
+isGoal :: Int -> (State, Thread) -> Bool
+isGoal n (rs,t) = (feasible n (rs,t)) && (length rs == n)
+
+-- | Perform a move
+move :: Int -> (State, Thread) -> (State, Thread)
+move x (s,t)  = (x:s, x:t)
+
+choices n = [1..n]
+moves n   = pure move <*> choices n
+
+emptySt = ([],[])
+
+-- | Breadth-first search
+bfs :: Int -> [(State, Thread)] -> (State, Thread)
+bfs n []                     = error "Could not find a feasible solution"
+bfs n sts | (not.empty) goal = head goal
+          | otherwise        = bfs n sts2
+  where
+    goal = filter (isGoal n) sts2
+    sts2 = filter (feasible n) $ (moves n) <*> sts
+
+-- | Depth-first search
+dfs :: Int -> (State, Thread) -> [(State, Thread)]
+dfs n st | isGoal n st     = [st]
+         | infeasible n st = [emptySt]
+         | otherwise       = do x   <- [1..n]
+                                st2 <- dfs n $ move x st
+                                guard $ st2 /= emptySt
+                                return st2
+
+main = do
+  [narg] <- getArgs
+  let n = read narg :: Int
+  print (bfs n [emptySt])
+  print (head $ dfs n emptySt)