Add haskell solutions for some old challenges

2 files changed, 78 insertions, 0 deletions

diff --git a/challenge-160/alexander-pankoff/haskell/ch-1.hs b/challenge-160/alexander-pankoff/haskell/ch-1.hs
new file mode 100644
index 0000000000..4c895e810b
--- /dev/null
+++ b/challenge-160/alexander-pankoff/haskell/ch-1.hs
@@ -0,0 +1,41 @@
+module Main where
+
+import Data.Char (toLower, toUpper)
+import Data.Foldable (forM_)
+import Data.List (intercalate)
+
+main :: IO ()
+main = do
+  forM_ [One .. Nine] $ putStrLn . fourIsMagic
+
+data Digit
+  = One
+  | Two
+  | Three
+  | Four
+  | Five
+  | Six
+  | Seven
+  | Eight
+  | Nine
+  deriving (Show, Eq, Ord, Enum)
+
+toCardinal :: Digit -> String
+toCardinal = lcFirst . show
+
+fourIsMagic :: Digit -> String
+fourIsMagic x = ucFirst $ intercalate ", " $ reverse $ go [] x
+  where
+    go acc Four = (toCardinal Four ++ " is magic.") : acc
+    go acc x =
+      let cardinal = toCardinal x
+          next = toEnum (length cardinal - 1)
+       in go ((cardinal ++ " is " ++ toCardinal next) : acc) next
+
+lcFirst :: String -> String
+lcFirst [] = []
+lcFirst (x : xs) = toLower x : xs
+
+ucFirst :: String -> String
+ucFirst [] = []
+ucFirst (x : xs) = toUpper x : xs
diff --git a/challenge-160/alexander-pankoff/haskell/ch-2.hs b/challenge-160/alexander-pankoff/haskell/ch-2.hs
new file mode 100644
index 0000000000..1b746695f4
--- /dev/null
+++ b/challenge-160/alexander-pankoff/haskell/ch-2.hs
@@ -0,0 +1,37 @@
+module Main where
+
+import Control.Monad (liftM2)
+import Data.Bifunctor (Bifunctor, bimap)
+import Data.List (findIndex, tails)
+import GHC.OldList (inits)
+
+main :: IO ()
+main = do
+  print $ equilibriumIndex [1 .. 4]
+  print $ equilibriumIndex [1, 2, 1]
+  print $ equilibriumIndex [1.1, -1.1, 2, 0]
+  print $ equilibriumIndex2 [1 .. 4]
+  print $ equilibriumIndex2 [1, 2, 1]
+  print $ equilibriumIndex2 [1.1, -1.1, 2, 0]
+
+equilibriumIndex :: (Eq a, Num a) => [a] -> Maybe Int
+equilibriumIndex xs = go 0 xs
+  where
+    go n xs
+      | n < length xs =
+        if sum (take n xs) == sum (drop (n + 1) xs)
+          then Just n
+          else go (succ n) xs
+      | otherwise = Nothing
+
+equilibriumIndex2 :: (Eq a, Num a) => [a] -> Maybe Int
+equilibriumIndex2 =
+  findIndex
+    (uncurry (==) . both sum)
+    . liftM2
+      zip
+      (init . inits)
+      (tail . init . tails)
+
+both :: Bifunctor f => (a -> b) -> f a a -> f b b
+both f = bimap f f
\ No newline at end of file