1 files changed, 45 insertions, 0 deletions
diff --git a/4-1.hs b/4-1.hs
new file mode 100644
index 0000000..7fa191a
--- /dev/null
+++ b/4-1.hs
@@ -0,0 +1,45 @@
+import Control.Monad (ap)
+
+transpose :: [[a]] -> [[a]]
+transpose ([]:_) = []
+transpose xss = map head xss : transpose (map tail xss)
+
+diagonals :: Eq a => [[a]] -> [[a]]
+diagonals a =
+  let n = length a
+      m = length (head a)
+  in
+    [[ a!!x!!(d-x) | x <- [max 0 (d-m+1) .. min (n-1) d] ]
+    | d <- [0..n+m-1]]
+
+reverseRows :: [[a]] -> [[a]]
+reverseRows = map reverse
+
+ts :: Eq a => [[[a]] -> [[a]]]
+ts = [ id
+     , reverseRows
+     , transpose
+     , reverseRows . transpose
+     , diagonals
+     , reverseRows . diagonals
+     , diagonals . reverseRows
+     , reverseRows . diagonals . reverseRows
+     ]
+
+transforms :: Eq a => [[a]] -> [[[a]]]
+transforms = ap ts . pure
+
+count :: Eq a => [a] -> [a] -> Integer
+count = count' 0
+
+count' :: Eq a => Integer -> [a] -> [a] -> Integer
+count' n _ [] = n
+count' n s xs = if take (length s) xs == s
+                then count' (n+1) s (drop (length s) xs)
+                else count' n s (tail xs)
+
+result :: [String] -> Integer
+result = sum . map (sum . map (count "XMAS")) . transforms
+
+main :: IO ()
+main = getContents >>= print . result . lines