Merge pull request #3536 from stuart-little/stuart-little_100_haskell

1st commit on 100_haskell

2 files changed, 39 insertions, 0 deletions

diff --git a/challenge-100/stuart-little/haskell/ch-1.hs b/challenge-100/stuart-little/haskell/ch-1.hs
new file mode 100755
index 0000000000..9639f363e2
--- /dev/null
+++ b/challenge-100/stuart-little/haskell/ch-1.hs
@@ -0,0 +1,23 @@
+#!/usr/bin/env runghc
+
+-- run <script> <time in hh:mm format, followed by am/pm if desired>
+
+import Data.Char (isDigit,toLower)
+import Data.List (isInfixOf)
+import Data.List.Split (splitOn)
+import System.Environment (getArgs)
+import Text.Printf (printf)
+
+fmTime :: String -> Int -> Int -> String
+fmTime mode h m
+  |isInfixOf "am" $ map toLower mode = (printf "%02d" (mod h 12)) ++ ":" ++ (printf "%02d" m)
+  |isInfixOf "pm" $ map toLower mode = (printf "%02d" ((mod h 12)+12)) ++ ":" ++ (printf "%02d" m)
+  |otherwise = (printf "%02d" modh) ++ ":" ++ (printf "%02d" m) ++ mer where
+     mer = if elem h [0..11] then " am" else " pm"
+     modh = if elem h [1..12] then h else (mod (h-12) 24)
+
+main = do
+  (hh:rest:_) <- getArgs >>= return . splitOn ":" . unwords
+  let h = (read::String->Int) hh
+      (m,mode) = (\(x,y) -> ((read::String->Int) x, y)) $ span isDigit rest
+  putStrLn $ fmTime mode h m
diff --git a/challenge-100/stuart-little/haskell/ch-2.hs b/challenge-100/stuart-little/haskell/ch-2.hs
new file mode 100755
index 0000000000..2dc7a433d1
--- /dev/null
+++ b/challenge-100/stuart-little/haskell/ch-2.hs
@@ -0,0 +1,16 @@
+#!/usr/bin/env runghc
+
+-- run <script> <space-separated array entries, right-to-left and top-to-bottom>
+
+import Data.List.Split (splitPlaces)
+import System.Environment (getArgs)
+
+redStep :: (Num a, Ord a) => [a] -> [a] -> [a]
+redStep row1@(h:rest) = zipWith (+) ((h:(zipWith min row1 rest)) ++ [last row1])
+
+collapseTriang :: (Num a, Ord a) => [[a]] -> a
+collapseTriang = minimum . foldl1 redStep
+
+main = do
+  nrs <- getArgs >>= return . map (read::String->Int) 
+  print $ collapseTriang $ splitPlaces [1..] nrs