Add Haskell solutions for week 77

3 files changed, 89 insertions, 0 deletions

diff --git a/challenge-077/aviral-goel/README b/challenge-077/aviral-goel/README
new file mode 100644
index 0000000000..e64ee14512
--- /dev/null
+++ b/challenge-077/aviral-goel/README
@@ -0,0 +1 @@
+Solutions by Aviral Goel.
diff --git a/challenge-077/aviral-goel/haskell/ch-1.hs b/challenge-077/aviral-goel/haskell/ch-1.hs
new file mode 100644
index 0000000000..9c6977093f
--- /dev/null
+++ b/challenge-077/aviral-goel/haskell/ch-1.hs
@@ -0,0 +1,30 @@
+import System.Environment (getArgs)
+import Data.List (intercalate)
+
+partitions :: [Int] -> Int -> [[Int]]
+partitions _ 0 = [[]]
+partitions [] _ = []
+partitions (x:xs) n | x <= n = others ++ map (x:) (partitions xs (n - x))
+                    | otherwise = others
+                    where others = partitions xs n
+
+fibonacci :: [Int]
+fibonacci = 0:1: zipWith (+) fibonacci (tail fibonacci)
+
+fibonacciPartitions :: Int -> [[Int]]
+fibonacciPartitions n =
+  partitions xs n
+  where xs = takeWhile (<= n) (tail (tail fibonacci))
+
+toString :: [[Int]] -> String
+toString [] = "0"
+toString xss =
+  intercalate "\n" (map toEquation xss)
+  where toEquation xs = intercalate " + " (map show xs) ++ " = " ++ show (sum xs)
+
+main :: IO ()
+main = do
+  n <- fmap head getArgs
+  let xs = fibonacciPartitions (read n)
+  let str = toString xs
+  putStrLn str
diff --git a/challenge-077/aviral-goel/haskell/ch-2.hs b/challenge-077/aviral-goel/haskell/ch-2.hs
new file mode 100644
index 0000000000..951273ff0d
--- /dev/null
+++ b/challenge-077/aviral-goel/haskell/ch-2.hs
@@ -0,0 +1,58 @@
+import Data.List (intersect)
+import Data.Void (Void)
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import System.Environment (getArgs)
+import Data.Maybe (fromMaybe)
+
+data Matrix = Matrix { getRows :: Int
+                     , getColumns :: Int
+                     , getElements :: [[Char]]
+                     }
+
+type Position = (Int, Int)
+
+isLonelyX :: [Position] -> Position -> Bool
+isLonelyX xLocations (m, n) =
+  null $ intersect xLocations adjacentLocations
+  where adjacentLocations = [ (m - 1, n)
+                            , (m + 1, n)
+                            , (m, n - 1)
+                            , (m, n + 1)
+                            , (m - 1, n - 1)
+                            , (m - 1, n + 1)
+                            , (m + 1, n - 1)
+                            , (m + 1, n + 1)
+                            ]
+
+wrap :: Matrix -> Matrix
+wrap (Matrix {getRows = rows, getColumns = columns, getElements = elements}) =
+  Matrix {getRows = rows + 2, getColumns = columns + 2, getElements = elements'}
+  where newrow = [replicate columns '0']
+        elements' = map (\row -> '0':row ++ ['0']) (newrow ++ elements ++ newrow)
+
+-- returns positions of all lonely X
+lonelyX :: Matrix -> [Position]
+lonelyX matrix =
+  filter (isLonelyX xLocations) xLocations
+  where matrix' = wrap matrix
+        elements' = getElements matrix'
+        xLocations = concat [[(m, n) | (n, element) <- zip [0..] row, element == 'X'] | (m, row) <- zip [0..] elements']
+
+type Parser = Parsec Void String
+
+rowParser :: Parser [Char]
+rowParser = space *> char '[' *> space *> many (alphaNumChar <* space) <* char ']'
+
+matrixParser :: Parser [[Char]]
+matrixParser = many rowParser
+
+main :: IO ()
+main = do
+    input <- getArgs
+    let input' = concat input
+    let positions = do
+          matrix <- parseMaybe matrixParser input'
+          let positions' = lonelyX $ Matrix (length matrix) (length (head matrix)) matrix
+          return positions'
+    print $ length $ fromMaybe [] positions