Day03

advent-of-code.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 0456e61cfa016cf17aad0abf7f92802d2cb8dedcf88bf3baa66b23b5bc0b363d
+-- hash: d0abf202c4eba2ff7fab75c855986accb76fb57450829814ad1465b2b166f300
 
 name:           advent-of-code
 version:        0.0.0
@@ -36,4 +36,5 @@ executable advent-of-code
   ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N
   build-depends:
       base >=4.7 && <5
+    , text
   default-language: Haskell2010

package.yaml

@@ -15,6 +15,7 @@ description:         Please see the README at <https://git.eisfunke.com/research
 
 dependencies:
 - base >= 4.7 && < 5
+- text
 
 executables:
   advent-of-code:

src/Day03.hs

+{-# LANGUAGE OverloadedStrings #-}
+
 module Day03 (part1, part2) where
 
+import qualified Data.Text as T
+import Data.List
+import Data.Maybe
+
 
 part1 :: [String] -> IO ()
-part1 input = undefined
+part1 input = print $ (count ((>1) . length)) . concat . claimedBy . catMaybes . (parseClaim <$>) $ input
 
 part2 :: [String] -> IO ()
-part2 input = undefined
+part2 input = print $ findUniques . concat . claimedBy . catMaybes . (parseClaim <$>) $ input
+
+example1 :: [String]
+example1 = ["#1 @ 1,3: 4x4",
+    "#2 @ 3,1: 4x4",
+    "#3 @ 5,5: 2x2"]
+
+
+data Claim = Claim {
+    claimId :: Int,
+    left :: Int,
+    top :: Int,
+    width :: Int,
+    height :: Int
+} deriving Show
+
+parseClaim :: String -> Maybe Claim
+parseClaim str = do
+    let txt = T.pack str
+    txt1 <- T.stripPrefix "#" txt
+    let (cid, txt2) = T.breakOn " @ " txt1
+    txt3 <- T.stripPrefix " @ " txt2
+    let (le, txt4) = T.breakOn "," txt3
+    txt5 <- T.stripPrefix "," txt4
+    let (ri, txt6) = T.breakOn ": " txt5
+    txt7 <- T.stripPrefix ": " txt6
+    let (wi, txt8) = T.breakOn "x" txt7
+    he <- T.stripPrefix "x" txt8
+    return $ Claim (read $ T.unpack cid) (read $ T.unpack le) (read $ T.unpack ri) (read $ T.unpack wi) (read $ T.unpack he)
+
+claimedBy :: [Claim] -> [[[Int]]]
+claimedBy [] = replicate 1000 (replicate 1000 [])
+claimedBy (c:cs) = (mapOn (left c) (width c) . mapOn (top c) (height c)) ((claimId c):) (claimedBy cs)
+
+mapOn :: Int -> Int -> (a -> a) -> [a] -> [a]
+mapOn from to f ls = before ++ map f mid ++ after where
+    (before, midAndAfter) = splitAt from ls
+    (mid, after) = splitAt to midAndAfter
+
+indexRange :: Int -> Int -> [a] -> [a]
+indexRange from to = take (to - from) . drop from
+
+count :: (a -> Bool) -> [a] -> Int
+count p = foldr f 0 where
+    f x n
+        | p x = n + 1
+        | otherwise = n
+
+-- |Finds the elements that only ever occur alone in the given lists.
+findUniques :: (Eq a) => [[a]] -> [a]
+findUniques xss = loop [] [] xss where
+    loop found notUnique [] = found
+    loop found notUnique ([x]:xss)
+        | x `notElem` notUnique = loop (found `union` [x]) (notUnique) xss
+        | otherwise = loop found notUnique xss
+    loop found notUnique (xs:xss) = loop (found \\ xs) (notUnique `union` xs) xss