1st commit on 062_haskell

2 files changed, 61 insertions, 0 deletions

diff --git a/challenge-062/stuart-little/haskell/ch-1.hs b/challenge-062/stuart-little/haskell/ch-1.hs
new file mode 100755
index 0000000000..bf57550078
--- /dev/null
+++ b/challenge-062/stuart-little/haskell/ch-1.hs
@@ -0,0 +1,27 @@
+#!/usr/bin/env runghc
+
+-- run <script> <optional '-u' flag> <space-separated list of file paths>
+
+import Data.Char (toLower)
+import Data.List (sortOn)
+import Data.List.Extra (nubSortOn)
+import Data.List.Split (splitOn)
+import System.Environment (getArgs)
+
+normEmail :: String -> (String,String)
+normEmail em = (map toLower dom, base) where
+  (base,dom) = (\(x:xs)-> (x,concat xs)) $ splitOn "@" em
+
+sortEmails :: Bool -> [String] -> [String]
+sortEmails flag = srt normEmail where
+  srt = if (flag == True)
+        then nubSortOn
+        else sortOn
+
+main = do
+  args <- getArgs
+  let (flag,paths) = if (head args == "-u")
+                     then (True,tail args)
+                     else (False,args)
+  addresses <- (mapM readFile paths) >>= return . concat . (map lines)
+  mapM_ putStrLn $ sortEmails flag addresses
diff --git a/challenge-062/stuart-little/haskell/ch-2.hs b/challenge-062/stuart-little/haskell/ch-2.hs
new file mode 100755
index 0000000000..0dbdddc11c
--- /dev/null
+++ b/challenge-062/stuart-little/haskell/ch-2.hs
@@ -0,0 +1,34 @@
+#!/usr/bin/env runghc
+
+{-
+run <script> <size N of N x N x N board, or nothing to default to N=2>
+
+Returns a list of three-coordinate positions for the queens, and is very slow for boards 4 x 4 x 4 or larger.
+-}
+
+import Data.List (group)
+import Data.Tree (Tree,unfoldTree,levels)
+import Safe (headDef)
+import System.Environment (getArgs)
+
+type Poss = [[Int]]
+
+board :: Int -> Int -> [[Int]]
+board dm n = sequence $ replicate dm [0..n-1]
+
+attacks :: (Eq a, Num a) => [a] -> [a] -> Bool
+attacks xs ys = (<=1) . length . group . filter (/=0) $ ls where
+  ls = abs <$> (zipWith (-) xs ys)
+
+elimAttacks :: (Eq a, Num a) => [[a]] -> [[a]] -> [[a]]
+elimAttacks xss yss = filter (\ys -> all (not . attacks ys) xss) yss
+
+nextNonAtt :: Poss -> Poss -> (Poss, [Poss])
+nextNonAtt brd poss = (poss, map (:poss) $ elimAttacks poss brd)
+
+quTree :: Int -> Int -> Tree Poss
+quTree dm n = unfoldTree (nextNonAtt $ board dm n) []
+
+main = do
+  n <- getArgs >>= return . (read::String->Int) . headDef "2"
+  print $ head $ last $ levels $ quTree 3 n