Commit d46c264b authored by Nicolas Lenz's avatar Nicolas Lenz ❄️
Browse files

Day03

parent 1448daf8

advent-of-code.cabal

+2 −1
Original line number Diff line number Diff line
@@ -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

input/day03

0 → 100644
+1327 −0

File added.

Preview size limit exceeded, changes collapsed.

package.yaml

+1 −0
Original line number Diff line number Diff line
@@ -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

+63 −2
Original line number Diff line number Diff line 
{-# 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