alt 05

code/src/05/Main2.hs

@@ -0,0 +1,90 @@
+-- why is this slower than the other one? i dont get it
+
+module Main where
+
+import Data.Tuple
+import Data.List
+import qualified Text.Parsec as P
+import qualified Data.Map as M
+import Data.Map.Strict (insertWith)
+
+type Point = (Int,Int)
+type Segment = (Point,Point)
+type Op = Db -> Db
+type Db = M.Map Point Int
+data Line =
+    Straight Segment
+  | Diag Segment
+
+main :: IO ()
+main = do
+  raw <- getContents
+  let input = parseInput raw
+      (straight, diag) = splitLines input
+      partAdb = toOps straight $ M.empty
+      partBdb = toOps diag $ partAdb
+  putStrLn $ "day5a: " ++ show (solve $ partAdb)
+  putStrLn $ "day5b: " ++ show (solve $ partBdb)
+
+solve :: Db -> Int
+solve db = M.size $ M.filter (>= 2) db
+
+toOps :: [Line] -> Op
+toOps ls = foldl (.) id $ map toOp ls
+
+toOp :: Line -> Op
+toOp l = foldl (.) id $ map f (createSpots l)
+  where
+    f p = insertWith (+) p 1
+
+splitLines :: [Line] -> ([Line], [Line])
+splitLines = go ([],[])
+  where
+    go acc [] = acc
+    go (al,ar) (l@(Straight s):ls) = go ((l:al),ar) ls
+    go (al,ar) (l@(Diag s):ls) = go (al,(l:ar)) ls
+
+parseInput :: String -> [Line]
+parseInput raw = [ toLine l | Right l <- segs ]
+  where
+    segs = map (P.parse lineP []) $ lines raw
+
+toLine :: Segment -> Line
+toLine s@((x1,y1),(x2,y2))
+  | x1 == x2 || y1 == y2 = Straight s
+  | otherwise = Diag s
+
+lineP :: P.Parsec String () Segment
+lineP = do
+  x1 <- P.many1 P.digit
+  _ <- P.char ','
+  y1 <- P.many1 P.digit
+  _ <- P.string " -> "
+  x2 <- P.many1 P.digit
+  _ <- P.char ','
+  y2 <- P.many1 P.digit
+  return ((read x1, read y1), (read x2, read y2))
+
+range :: Int -> Int -> [Int]
+range x y = [ i .. j ]
+  where
+    (i,j) = if x > y then (y,x) else (x,y)
+
+createSpots :: Line -> [Point]
+createSpots (Straight ps) = runStraight ps
+createSpots (Diag ps) = runDiag ps
+
+runStraight :: Segment -> [Point]
+runStraight ((x1,y1),(x2,y2))
+  | x1 == x2 = [ (x1,j) | j <- range y1 y2 ]
+  | otherwise = [ (i,y1) | i <- range x1 x2 ]
+
+runDiag :: Segment -> [Point]
+runDiag ((x1,y1),(x2,y2)) = take n $ iterate f start
+  where
+    dl (x,y) = (x+1,y+1)
+    dr (x,y) = (x-1,y+1)
+    n = (abs (x1-x2)) + 1
+    f = if (fst start) < (fst end) then dl else dr
+    (start,end) = (if y1 < y2 then id else swap) ((x1,y1),(x2,y2))
+