1st commit on 097_haskell

2 files changed, 40 insertions, 0 deletions

diff --git a/challenge-097/stuart-little/haskell/ch-1.hs b/challenge-097/stuart-little/haskell/ch-1.hs
new file mode 100755
index 0000000000..6dbe278140
--- /dev/null
+++ b/challenge-097/stuart-little/haskell/ch-1.hs
@@ -0,0 +1,18 @@
+#!/usr/bin/env runghc
+
+-- run <script> <quoted string> <number>
+
+import Data.Char (ord,chr,)
+import System.Environment (getArgs,)
+
+shiftCaps :: Int -> Char -> Char
+shiftCaps n c
+  |elem c ['A'..'Z'] = chr $ ord 'A' + mod ((ord c -ord 'A') - (mod n 26)) 26
+  |otherwise =c   
+
+rot :: Int -> String -> String
+rot n str = map (shiftCaps n) str
+
+main = do
+  (str,shift) <- getArgs >>= return.(\(x:y:_)->(x,(read::String->Int) y))
+  putStrLn $ rot shift str
diff --git a/challenge-097/stuart-little/haskell/ch-2.hs b/challenge-097/stuart-little/haskell/ch-2.hs
new file mode 100755
index 0000000000..d8b0afe2f8
--- /dev/null
+++ b/challenge-097/stuart-little/haskell/ch-2.hs
@@ -0,0 +1,22 @@
+#!/usr/bin/env runghc
+
+-- run <script> <binary string> <number>
+
+import Data.List (transpose,elemIndices)
+import Data.List.Extra (maximumOn)
+import Data.List.Split (chunksOf)
+import System.Environment (getArgs)
+
+mostOccsTgt :: Eq a => [[a]] -> [a]
+mostOccsTgt xss = map (\ys -> maximumOn (length . (flip elemIndices ys)) ys) $ transpose xss
+
+nrFlips :: Eq a => [a] -> [[a]] -> Int
+nrFlips tgt strs = sum $ map (\s -> length $ filter (\(p,q)-> p/=q) $ zip tgt s) strs
+
+main = do
+  (bin,nr) <- getArgs >>= return.(\(x:y:_)-> (x,(read::String->Int) y))
+  let bins = chunksOf nr bin
+      tgt = mostOccsTgt bins
+  putStrLn $ "Initial binary words:\n" ++ (unlines bins)
+  putStrLn $ "Target string: " ++ tgt
+  putStrLn $ "Need to flip " ++ (show $ nrFlips tgt bins) ++ " position(s)."