Solve day 10 part 1
This commit is contained in:
parent
4b45590f37
commit
cdc54a27aa
@ -70,7 +70,7 @@ import Data.Foldable1
|
||||
import Data.Function
|
||||
import Data.Functor
|
||||
import Data.List (sortOn, transpose)
|
||||
import Data.List.Extra (dropEnd, enumerate, notNull, splitOn)
|
||||
import Data.List.Extra (dropEnd, enumerate, firstJust, notNull, splitOn)
|
||||
import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty, some1, tail, tails)
|
||||
import Data.Maybe
|
||||
import Data.Ord
|
||||
|
||||
@ -2,14 +2,49 @@ module Puzzles.Day10 (puzzle) where
|
||||
|
||||
import Pre
|
||||
|
||||
import Data.IntMap qualified as IM
|
||||
|
||||
puzzle :: Puzzle
|
||||
puzzle =
|
||||
Puzzle
|
||||
{ number = 10
|
||||
, parser = mempty
|
||||
, parser = const $ flip sepEndBy newline do
|
||||
void $ single '['
|
||||
lights <- some $ (single '.' $> Off) <|> (single '#' $> On)
|
||||
void $ single ']'
|
||||
void space1
|
||||
switches <- flip sepEndBy space1 do
|
||||
void $ single '('
|
||||
r <- Switch <$> decimal `sepBy` single ','
|
||||
void $ single ')'
|
||||
pure r
|
||||
void $ single '{'
|
||||
void $ decimal @_ @_ @_ @Int `sepBy` single ','
|
||||
void $ single '}'
|
||||
pure (Lights $ IM.fromList $ zip [0 ..] lights, switches)
|
||||
, parts =
|
||||
[ \() ->
|
||||
()
|
||||
[ sum . map \(lights, switches) ->
|
||||
maybe (error "no solution") length
|
||||
. firstJust (firstJust (\(s, ls) -> guard (allOff ls) $> s))
|
||||
$ flip iterate [([], lights)] \ls ->
|
||||
concatMap (\s -> map (\(ss, l) -> (s : ss, applySwitch s l)) ls) switches
|
||||
]
|
||||
, extraTests = mempty
|
||||
}
|
||||
|
||||
data Light = On | Off
|
||||
deriving (Eq, Ord, Show)
|
||||
flipLight :: Light -> Light
|
||||
flipLight = \case
|
||||
On -> Off
|
||||
Off -> On
|
||||
|
||||
newtype Lights = Lights (IM.IntMap Light)
|
||||
deriving (Eq, Ord, Show)
|
||||
allOff :: Lights -> Bool
|
||||
allOff (Lights ls) = all (== Off) $ map snd $ IM.toList ls
|
||||
|
||||
newtype Switch = Switch [Int]
|
||||
deriving (Eq, Ord, Show)
|
||||
applySwitch :: Switch -> Lights -> Lights
|
||||
applySwitch (Switch ss) (Lights ls) = Lights $ foldl' (flip $ IM.adjust flipLight) ls ss
|
||||
|
||||
1
outputs/real/10/1
Normal file
1
outputs/real/10/1
Normal file
@ -0,0 +1 @@
|
||||
473
|
||||
Loading…
x
Reference in New Issue
Block a user