wip 5

1 files changed, 48 insertions, 0 deletions

diff --git a/3/1.hs b/3/1.hs
new file mode 100644
index 0000000..1651ace
--- /dev/null
+++ b/3/1.hs
@@ -0,0 +1,48 @@
+import Text.Parsec.String (Parser)
+import Text.Parsec
+import System.Environment
+import Control.Monad
+import Debug.Trace
+
+data Tile = EmptyT | Digit Int | Symbol deriving (Show,Eq)
+
+tile :: Parser Tile
+tile = char '.' *>  pure EmptyT <|> Digit <$> (read.pure <$> digit) <|> noneOf "\n" *> pure Symbol 
+
+board = sepBy (many1 tile) newline
+
+symbolPositions l = [(x,y) | (y,r) <- zip [0..] l, (x,Symbol) <- zip [0..] r]
+
+digitPositions l = [(n,x,y) | (y,r) <- zip [0..] l, (x,Digit n) <- zip [0..] r]
+
+groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
+groupBy p = map (uncurry (:)) . groupByNonEmpty p
+
+groupByNonEmpty :: (a -> a -> Bool) -> [a] -> [(a,[a])]
+groupByNonEmpty p =
+   foldr
+      (\x0 yt ->
+         let (xr,yr) =
+               case yt of
+                  (x1,xs):ys ->
+                     if p x0 x1
+                       then (x1:xs,ys)
+                       else ([],yt)
+                  [] -> ([],yt)
+         in  (x0,xr):yr)
+      []
+
+fromDigits :: [Int] -> Int
+fromDigits = foldl ((+) . (10 *)) 0
+
+neighbours = foldMap (\(x,y) -> map (\(dx,dy) -> (x+dx,y+dy)) neigh) where
+    neigh = liftM2 (,) [1,0,-1] [1,0,-1]
+
+solution :: [[Tile]] -> Int
+solution board = sum $ map (fromDigits.map (\(n,_,_) -> n)) partNumbers where
+    blacklisted = neighbours $ symbolPositions board 
+    digs = groupBy (\(_,x1,_) (_,x2,_) -> x2 == succ x1) $ digitPositions board
+    partNumbers = filter (\l -> any (\(_,x,y) -> (x,y) `elem` blacklisted) l) $ digs
+
+
+main = liftM2 (>>=) readFile (((print . solution . either (error.show) id) .) . parse board) =<< head <$> getArgs
\ No newline at end of file