Merge pull request #4144 from stuart-little/stuart-little_114_haskell

1st commit on 114_haskell

2 files changed, 42 insertions, 0 deletions

diff --git a/challenge-114/stuart-little/haskell/ch-1.hs b/challenge-114/stuart-little/haskell/ch-1.hs
new file mode 100755
index 0000000000..e73af3b7b8
--- /dev/null
+++ b/challenge-114/stuart-little/haskell/ch-1.hs
@@ -0,0 +1,22 @@
+#!/usr/bin/env runghc
+
+-- run <script> <number>
+
+import System.Environment (getArgs)
+
+doubleUp :: Int -> String -> String
+doubleUp nrDigs initHalf = initHalf ++ otherHalf where
+  otherHalf = if (odd nrDigs) then (reverse . init $ initHalf) else (reverse initHalf)
+
+nxtPali :: String -> String
+nxtPali nrStr
+  |nr <= 8 = show (nr + 1)
+  |null $ dropWhile ('9'==) nrStr = show (nr + 2)
+  |otherwise = if pali > nr then show pali else (doubleUp nrDigs . show . (1+) . (read::String->Int) $ initHalf) where
+     nrDigs = length nrStr
+     initHalf = take (div (nrDigs+1) 2) nrStr
+     pali = (read::String->Int) $ doubleUp nrDigs initHalf
+     nr = (read::String->Int) nrStr
+
+main :: IO ()
+main = getArgs >>= putStrLn . nxtPali . head
diff --git a/challenge-114/stuart-little/haskell/ch-2.hs b/challenge-114/stuart-little/haskell/ch-2.hs
new file mode 100755
index 0000000000..0d8a230340
--- /dev/null
+++ b/challenge-114/stuart-little/haskell/ch-2.hs
@@ -0,0 +1,20 @@
+#!/usr/bin/env runghc
+
+-- run <script>
+
+import Data.Char (digitToInt)
+import Data.Digits (digits,unDigits)
+import System.Environment (getArgs)
+import Text.RegexPR (subRegexPR)
+
+nxtSameNrBits :: String -> String
+nxtSameNrBits binNr = if (last binNr == '1')
+                      then subRegexPR "01(1*)$" "10\\1" binNr
+                      else subRegexPR "01(1*)(0*)$" "10\\2\\1" binNr
+
+main = do
+  binNr <- getArgs >>= return . concat . map show . (0:) . (digits 2) . (read::String->Int) . head 
+  putStrLn $ "Initial number in base two: " ++ binNr
+  let nxt = nxtSameNrBits binNr
+  putStrLn $ "Next number in base two: " ++ nxt
+  putStrLn $ "Next number in base ten: " ++ (show . unDigits 2 . map digitToInt $ nxt)