From 1b854e8a1917016acca336933f68190622cfc42c Mon Sep 17 00:00:00 2001 From: Eric Mertens <emertens@gmail.com> Date: Tue, 19 Dec 2023 22:31:18 -0800 Subject: [PATCH] 2023-20 --- inputs/2023/20.txt | 58 +++++++++++++++++++++++ solutions/solutions.cabal | 5 ++ solutions/src/2023/20.hs | 98 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 161 insertions(+) create mode 100644 inputs/2023/20.txt create mode 100644 solutions/src/2023/20.hs diff --git a/inputs/2023/20.txt b/inputs/2023/20.txt new file mode 100644 index 0000000..c20d35e --- /dev/null +++ b/inputs/2023/20.txt @@ -0,0 +1,58 @@ +%cf -> hl, qt +&bn -> rx +%nb -> vt +%hm -> jp +%vr -> qt, sl +%gq -> hm, nl +%sl -> jx, qt +&pl -> bn +%hf -> vt, ch +%kx -> dq +%fr -> qf +%rh -> vr +&vt -> lz, dh, kr, kq, lm, qk +&dq -> mz, ml, xd, fb, xs, rc, rt +%hn -> qk, vt +%bv -> nl +%jv -> rh, qt +%kq -> lm +%nd -> hp +%gj -> bv, nl +%lv -> xs, dq +%ch -> vt, kd +%sm -> qt, nd +%nt -> jv +%qk -> cb +%jx -> cf +%hl -> qt, ng +&qt -> sm, rh, nd, jx, nt, pl +%bh -> nl, fr +%kd -> vt, nb +%gx -> mh, dq +%hp -> nt, qt +%rc -> lv +broadcaster -> kr, zb, sm, xd +&mz -> bn +%qf -> rd, nl +%sk -> nl, bh +%rb -> nl, sk +%cb -> hf, vt +%fb -> rt +&lz -> bn +%mh -> dq, kx +%rt -> mt +%xd -> dq, fb +%lm -> hn +%hh -> vt, dh +%ml -> ts +%mt -> rc, dq +%ts -> gx, dq +%rd -> nl, gq +%zb -> nl, rb +%kr -> hh, vt +&nl -> fr, zb, hm, zm +&zm -> bn +%dh -> kq +%ng -> qt +%xs -> ml +%jp -> nl, gj diff --git a/solutions/solutions.cabal b/solutions/solutions.cabal index 02f4012..88d4cd7 100644 --- a/solutions/solutions.cabal +++ b/solutions/solutions.cabal @@ -1079,3 +1079,8 @@ executable sln_2023_19 import: day main-is: 2023/19.hs build-depends: containers + +executable sln_2023_20 + import: day + main-is: 2023/20.hs + build-depends: containers diff --git a/solutions/src/2023/20.hs b/solutions/src/2023/20.hs new file mode 100644 index 0000000..8163fe7 --- /dev/null +++ b/solutions/src/2023/20.hs @@ -0,0 +1,98 @@ +{-# Language QuasiQuotes, TemplateHaskell, BangPatterns, BlockArguments, LambdaCase, ImportQualifiedPost #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} +{-| +Module : Main +Description : Day 20 solution +Copyright : (c) Eric Mertens, 2023 +License : ISC +Maintainer : emertens@gmail.com + +<https://adventofcode.com/2023/day/20> + +This problem requires you to hack around inside your input file, +so if this solution doesn't work on yours, you didn't get lucky +and get a easier case like I did, but I assume we all got the same +kind of dumb easy case as the last LCM problem this year. + +-} +module Main where + +import Advent (format, stageTH) +import Advent.Queue as Queue +import Data.Map (Map) +import Data.Map qualified as Map +import Data.Set (Set) +import Data.Set qualified as Set + +data K = K_PERCENT | K_AMPERSAND deriving (Eq, Ord, Show) + +stageTH + +data Kind = Broad | Conj | Flip + +-- | Parse the input and print both parts. +-- +-- >>> :main +-- 825167435 +-- 225514321828633 +main :: IO () +main = + do input <- [format|2023 20 ((broadcaster|@K%s) -> %s&(, )%n)*|] + let nodes = Map.fromList [matchKind kind conns | (kind, conns) <- input] + let conj = Map.fromListWith (++) [(v, [k]) | (k, (_,vs)) <- Map.assocs nodes, v <- vs] + + let part1 !n !l !h (("button",_,_):_) | n == (1000 :: Int) = l * h :: Int + part1 n l h ((src,_,sig):xs) = + part1 (if src == "button" then n+1 else n) + (if sig then l else l+1) + (if sig then h+1 else h) xs + part1 _ _ _ [] = error "part1 failed" + + print (part1 0 0 0 (sim conj nodes)) + + -- This is one of those sad days that you have to look at your own input :( + print (part2 conj (sim conj nodes)) + + +part2 :: Map String [String] -> [(String, String, Bool)] -> Int +part2 incoming msgs = foldl1 lcm [buttonsFor 0 dude msgs | dude <- incoming Map.! specialConj] + where + [specialConj] = incoming Map.! "rx" + + buttonsFor n gate (("button", _, _):xs) = buttonsFor (n+1) gate xs + buttonsFor n gate ((src, dst, True):_) | src == gate, dst == specialConj = n + buttonsFor n gate (_:xs) = buttonsFor n gate xs + buttonsFor _ _ _ = undefined + +matchKind :: Maybe (K, String) -> a -> (String, (Kind, a)) +matchKind Nothing xs = ("broadcaster", (Broad, xs)) +matchKind (Just (K_PERCENT, name)) xs = (name, (Flip, xs)) +matchKind (Just (K_AMPERSAND, name)) xs = (name, (Conj, xs)) + +sim :: Map String [String] -> Map String (Kind, [String]) -> [(String, String, Bool)] +sim conj conns = go Set.empty Queue.Empty + where + go st q = + case Queue.pop q of + Nothing -> go st (Queue.singleton ("button", "broadcaster", False)) + Just ((src, dst, msg), q') -> + (src, dst, msg) : + case Map.lookup dst conns of + Nothing -> go st q' -- output node, keep going + Just (Broad, next) -> + go st (appendList q' [(dst, t, msg) | t <- next]) + Just (Flip, next) + | msg -> go st q' -- ignored + | otherwise -> -- was on sends low + let active = not (Set.member dst st) + outmsgs = [(dst, t, active) | t <- next] + in go (mark dst active st) (appendList q' outmsgs) + Just (Conj, next) -> + let st1 = mark (src ++ " " ++ dst) msg st + out = not (and [Set.member (inp ++ " " ++ dst) st1 | inp <- conj Map.! dst]) + outmsgs = [(dst, t, out) | t <- next] + in go st1 (Queue.appendList q' outmsgs) + +mark :: Ord a => a -> Bool -> Set a -> Set a +mark key True = Set.insert key +mark key False = Set.delete key