[Haskell][11] Adding Solution

haskell/build.sh

@@ -4,6 +4,8 @@ find ./src -name '*.hs' -printf '%T@ %p\n' \
 	| sort -r | head -n1 | cut -d' ' -f2 |  while read file
 do
 	out_file="$(basename "$file" | cut -d'.' -f1)"
+        echo "------------------------------------"
 	echo "Compiling file '${file}' into '${out_file}'"
-	ghc -o "$out_file" "$file"
+	ghc -O2 -i./src -o "$out_file" "$file"
+        echo "------------------------------------"
 done

haskell/src/0004.hs

@@ -24,6 +24,5 @@ solution' x y res = solution' (x + 1) y $! (if (is_palindrome (x * y))
 solution :: Int
 solution = solution' 100 100 0
 
-
 main :: IO ()
 main = putStrLn ("Solution: " ++ show solution)

haskell/src/0011.hs

@@ -0,0 +1,72 @@
+{-
+In the 20 * 20 grid below, four numbers along a diagonal line have been marked in red.
+08 02 22 97 38 15 00 40  00  75  04  05  07 78 52 12 50 77 91 08
+49 49 99 40 17 81 18 57  60  87  17  40  98 43 69 48 04 56 62 00
+81 49 31 73 55 79 14 29  93  71  40  67  53 88 30 03 49 13 36 65
+52 70 95 23 04 60 11 42  69  24  68  56  01 32 56 71 37 02 36 91
+22 31 16 71 51 67 63 89  41  92  36  54  22 40 40 28 66 33 13 80
+24 47 32 60 99 03 45 02  44  75  33  53  78 36 84 20 35 17 12 50
+32 98 81 28 64 23 67 10 *26* 38  40  67  59 54 70 66 18 38 64 70
+67 26 20 68 02 62 12 20  95 *63* 94  39  63 08 40 91 66 49 94 21
+24 55 58 05 66 73 99 26  97  17 *78* 78  96 83 14 88 34 89 63 72
+21 36 23 09 75 00 76 44  20  45  35 *14* 00 61 33 97 34 31 33 95
+78 17 53 28 22 75 31 67  15  94  03  80  04 62 16 14 09 53 56 92
+16 39 05 42 96 35 31 47  55  58  88  24  00 17 54 24 36 29 85 57
+86 56 00 48 35 71 89 07  05  44  44  37  44 60 21 58 51 54 17 58
+19 80 81 68 05 94 47 69  28  73  92  13  86 52 17 77 04 89 55 40
+04 52 08 83 97 35 99 16  07  97  57  32  16 26 26 79 33 27 98 66
+88 36 68 87 57 62 20 72  03  46  33  67  46 55 12 32 63 93 53 69
+04 42 16 73 38 25 39 11  24  94  72  18  08 46 29 32 40 62 76 36
+20 69 36 41 72 30 23 88  34  62  99  69  82 67 59 85 74 04 36 16
+20 73 35 29 78 31 90 01  74  31  49  71  48 86 81 16 23 57 05 54
+01 70 54 71 83 51 54 69  16  92  33  48  61 43 52 01 89 19 67 48
+The product of these numbers is 26 * 63 * 78 * 14 = 1788696.
+What is the greatest product of four adjacent numbers in the same direction (up, down, left, right, or diagonally) in the 20 * 20 grid?
+-}
+
+import Data.List
+import Data.Maybe
+import Utils
+
+bat :: Matrix Int
+bat =
+  [ [08, 02, 22, 97, 38, 15, 00, 40, 00, 75, 04, 05, 07, 78, 52, 12, 50, 77, 91, 08],
+    [49, 49, 99, 40, 17, 81, 18, 57, 60, 87, 17, 40, 98, 43, 69, 48, 04, 56, 62, 00],
+    [81, 49, 31, 73, 55, 79, 14, 29, 93, 71, 40, 67, 53, 88, 30, 03, 49, 13, 36, 65],
+    [52, 70, 95, 23, 04, 60, 11, 42, 69, 24, 68, 56, 01, 32, 56, 71, 37, 02, 36, 91],
+    [22, 31, 16, 71, 51, 67, 63, 89, 41, 92, 36, 54, 22, 40, 40, 28, 66, 33, 13, 80],
+    [24, 47, 32, 60, 99, 03, 45, 02, 44, 75, 33, 53, 78, 36, 84, 20, 35, 17, 12, 50],
+    [32, 98, 81, 28, 64, 23, 67, 10, 26, 38, 40, 67, 59, 54, 70, 66, 18, 38, 64, 70],
+    [67, 26, 20, 68, 02, 62, 12, 20, 95, 63, 94, 39, 63, 08, 40, 91, 66, 49, 94, 21],
+    [24, 55, 58, 05, 66, 73, 99, 26, 97, 17, 78, 78, 96, 83, 14, 88, 34, 89, 63, 72],
+    [21, 36, 23, 09, 75, 00, 76, 44, 20, 45, 35, 14, 00, 61, 33, 97, 34, 31, 33, 95],
+    [78, 17, 53, 28, 22, 75, 31, 67, 15, 94, 03, 80, 04, 62, 16, 14, 09, 53, 56, 92],
+    [16, 39, 05, 42, 96, 35, 31, 47, 55, 58, 88, 24, 00, 17, 54, 24, 36, 29, 85, 57],
+    [86, 56, 00, 48, 35, 71, 89, 07, 05, 44, 44, 37, 44, 60, 21, 58, 51, 54, 17, 58],
+    [19, 80, 81, 68, 05, 94, 47, 69, 28, 73, 92, 13, 86, 52, 17, 77, 04, 89, 55, 40],
+    [04, 52, 08, 83, 97, 35, 99, 16, 07, 97, 57, 32, 16, 26, 26, 79, 33, 27, 98, 66],
+    [88, 36, 68, 87, 57, 62, 20, 72, 03, 46, 33, 67, 46, 55, 12, 32, 63, 93, 53, 69],
+    [04, 42, 16, 73, 38, 25, 39, 11, 24, 94, 72, 18, 08, 46, 29, 32, 40, 62, 76, 36],
+    [20, 69, 36, 41, 72, 30, 23, 88, 34, 62, 99, 69, 82, 67, 59, 85, 74, 04, 36, 16],
+    [20, 73, 35, 29, 78, 31, 90, 01, 74, 31, 49, 71, 48, 86, 81, 16, 23, 57, 05, 54],
+    [01, 70, 54, 71, 83, 51, 54, 69, 16, 92, 33, 48, 61, 43, 52, 01, 89, 19, 67, 48]
+  ]
+
+solution :: Int
+solution =
+  (maximum
+     (map
+        (\x -> foldl' (*) 1 x)
+        (catMaybes
+           [(matrix_get_n bat 4 d (Point x y))
+            | (x, y, d) <- combinations3
+                             [0 .. 19]
+                             [0 .. 19]
+                             allDirection
+           ]
+        )
+     )
+  )
+
+main :: IO ()
+main = putStrLn ("Solution: " ++ show solution)

haskell/src/Utils.hs

@@ -0,0 +1,90 @@
+module Utils where
+  (!?) :: [a] -> Int -> Maybe a
+  l !? i
+    | i >= (length l) = Nothing
+    | i == 0          = car l
+    | otherwise       = cdr l >>= \x -> x !? (i-1)
+
+
+  car :: [a] -> Maybe a
+  car []    = Nothing
+  car [x]   = Just x
+  car (x:_) = Just x
+
+  cdr :: [a] -> Maybe [a]
+  cdr []     = Nothing
+  cdr [_]    = Just []
+  cdr (_:xs) = Just xs
+
+  run_maybe :: Maybe a -> (a -> b) -> Maybe b
+  run_maybe x f = case x of
+                    Nothing -> Nothing
+                    Just x  -> Just (f x)
+
+  to_maybe :: (a -> b) -> (a -> Maybe b)
+  to_maybe f = \x -> Just (f x)
+
+  compareLength :: [a] -> Int -> Ordering
+  compareLength l s
+    | len == s = EQ
+    | len >  s = LT
+    | len <  s = GT
+      where len = length l
+
+  combinations2 :: [a] -> [b] -> [(a, b)]
+  combinations2 x y = go' x y 0 0
+    where
+      go' :: [a] -> [b] -> Int -> Int -> [(a, b)]
+      go' x y xi yi
+        | compareLength x xi == EQ = go' x y 0 (yi+1)
+        | compareLength y yi == EQ = []
+        | otherwise                = [((x !! xi), (y !! yi))] ++ go' x y (xi+1) yi
+
+  combinations3 :: [a] -> [b] -> [c] -> [(a, b, c)]
+  combinations3 x y z = go' x y z 0 0 0
+    where
+      go' :: [a] -> [b] -> [c] -> Int -> Int -> Int -> [(a, b, c)]
+      go' x y z xi yi zi
+        | compareLength x xi == EQ = go' x y z 0 (yi+1) zi
+        | compareLength y yi == EQ = go' x y z 0 0      (zi+1)
+        | compareLength z zi == EQ = []
+        | otherwise                = [((x !! xi), (y !! yi), (z !! zi))] ++ go' x y z (xi+1) yi zi
+
+  data Direction = DUp | DDown | DLeft | DRight | DUpRight | DUpLeft | DDownRight | DDownLeft deriving Show
+  allDirection :: [Direction]
+  allDirection = [DUp, DDown, DLeft, DRight, DUpRight, DUpLeft, DDownRight, DDownLeft]
+
+  data Point = Point { x :: Int, y :: Int } deriving Show
+
+  point_next_dir :: Point -> Direction -> Point
+  point_next_dir p d =
+    case d of
+      DUp        -> Point ((x p)-1) (y p)
+      DDown      -> Point ((x p)+1) (y p)
+      DLeft      -> Point (x p)     ((y p)-1)
+      DRight     -> Point (x p)     ((y p)+1)
+      DUpRight   -> Point ((x p)-1) ((y p)+1)
+      DUpLeft    -> Point ((x p)-1) ((y p)-1)
+      DDownRight -> Point ((x p)+1) ((y p)+1)
+      DDownLeft  -> Point ((x p)+1) ((y p)-1)
+
+  type Matrix a = [[a]]
+
+  matrix_n_rows :: Matrix a -> Int
+  matrix_n_rows m = length m
+
+  matrix_n_cols :: Matrix a -> Maybe Int
+  matrix_n_cols m = car m >>= to_maybe length
+
+  matrix_get :: Matrix a -> Int -> Int -> Maybe a
+  matrix_get m x y = m !? x >>= \z -> z !? y
+
+  matrix_get_n :: Matrix a -> Int -> Direction -> Point -> Maybe [a]
+  matrix_get_n m a d p = go' m a d p 0
+    where
+      go' :: Matrix a -> Int -> Direction -> Point -> Int -> Maybe [a]
+      go' m a d p c
+        | c == a    = Just []
+        | otherwise = case matrix_get m (x p) (y p) of
+                        Nothing -> Nothing
+                        Just z -> go' m a d (point_next_dir p d) (c+1) >>= \w -> Just ([z] ++ w)