{-# Language QuasiQuotes, TemplateHaskell, ImportQualifiedPost, ViewPatterns #-}
{-|
Module      : Main
Description : Day 10 solution
Copyright   : (c) Eric Mertens, 2021
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2016/day/10>

-}
module Main where

import Advent (format, stageTH)
import Data.List (sort)
import Data.Map (Map)
import Data.Map qualified as Map

data T = Tbot | Toutput deriving Int -> T -> ShowS
[T] -> ShowS
T -> String
(Int -> T -> ShowS) -> (T -> String) -> ([T] -> ShowS) -> Show T
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> T -> ShowS
showsPrec :: Int -> T -> ShowS
$cshow :: T -> String
show :: T -> String
$cshowList :: [T] -> ShowS
showList :: [T] -> ShowS
Show

stageTH

-- | >>> :main
-- 147
-- 55637
main :: IO ()
IO ()
main =
 do [Either (Int, T, Int) (Int, T, Int, T, Int)]
inp <- [format|2016 10 ((value %u goes to @T %u|bot %u gives low to @T %u and high to @T %u)%n)*|]
    let solution :: Map Target [Int]
solution = [Instr] -> Map Target [Int]
followInstructions (Either (Int, T, Int) (Int, T, Int, T, Int) -> Instr
toInstr (Either (Int, T, Int) (Int, T, Int, T, Int) -> Instr)
-> [Either (Int, T, Int) (Int, T, Int, T, Int)] -> [Instr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either (Int, T, Int) (Int, T, Int, T, Int)]
inp)

    Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall a. HasCallStack => [a] -> a
head [Int
who | (Bot Int
who, [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort -> [Int
17,Int
61]) <- Map Target [Int] -> [(Target, [Int])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Target [Int]
solution])
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Int
v | Int
i <- [Int
0..Int
2], let [Int
v] = Map Target [Int]
solution Map Target [Int] -> Target -> [Int]
forall k a. Ord k => Map k a -> k -> a
Map.! Int -> Target
Output Int
i])

-- Types ---------------------------------------------------------------

data Instr = Value !Int !Target | Gives !Int !Target !Target
  deriving Int -> Instr -> ShowS
[Instr] -> ShowS
Instr -> String
(Int -> Instr -> ShowS)
-> (Instr -> String) -> ([Instr] -> ShowS) -> Show Instr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Instr -> ShowS
showsPrec :: Int -> Instr -> ShowS
$cshow :: Instr -> String
show :: Instr -> String
$cshowList :: [Instr] -> ShowS
showList :: [Instr] -> ShowS
Show

data Target = Bot !Int | Output !Int
  deriving (Target -> Target -> Bool
(Target -> Target -> Bool)
-> (Target -> Target -> Bool) -> Eq Target
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Target -> Target -> Bool
== :: Target -> Target -> Bool
$c/= :: Target -> Target -> Bool
/= :: Target -> Target -> Bool
Eq, Eq Target
Eq Target =>
(Target -> Target -> Ordering)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Bool)
-> (Target -> Target -> Target)
-> (Target -> Target -> Target)
-> Ord Target
Target -> Target -> Bool
Target -> Target -> Ordering
Target -> Target -> Target
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Target -> Target -> Ordering
compare :: Target -> Target -> Ordering
$c< :: Target -> Target -> Bool
< :: Target -> Target -> Bool
$c<= :: Target -> Target -> Bool
<= :: Target -> Target -> Bool
$c> :: Target -> Target -> Bool
> :: Target -> Target -> Bool
$c>= :: Target -> Target -> Bool
>= :: Target -> Target -> Bool
$cmax :: Target -> Target -> Target
max :: Target -> Target -> Target
$cmin :: Target -> Target -> Target
min :: Target -> Target -> Target
Ord, Int -> Target -> ShowS
[Target] -> ShowS
Target -> String
(Int -> Target -> ShowS)
-> (Target -> String) -> ([Target] -> ShowS) -> Show Target
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Target -> ShowS
showsPrec :: Int -> Target -> ShowS
$cshow :: Target -> String
show :: Target -> String
$cshowList :: [Target] -> ShowS
showList :: [Target] -> ShowS
Show)

-- Parsing -------------------------------------------------------------

toInstr :: Either (Int, T, Int) (Int, T, Int, T, Int) -> Instr
toInstr :: Either (Int, T, Int) (Int, T, Int, T, Int) -> Instr
toInstr (Left (Int
n, T
t, Int
tn)) = Int -> Target -> Instr
Value Int
n (T -> Int -> Target
toTarget T
t Int
tn)
toInstr (Right (Int
b, T
tlo, Int
n, T
thi, Int
m)) = Int -> Target -> Target -> Instr
Gives Int
b (T -> Int -> Target
toTarget T
tlo Int
n) (T -> Int -> Target
toTarget T
thi Int
m)

toTarget :: T -> Int -> Target
toTarget :: T -> Int -> Target
toTarget T
Tbot = Int -> Target
Bot
toTarget T
Toutput = Int -> Target
Output

-- Solving -------------------------------------------------------------

followInstructions :: [Instr] -> Map Target [Int]
followInstructions :: [Instr] -> Map Target [Int]
followInstructions [Instr]
xs = Map Target [Int]
result
  where
    result :: Map Target [Int]
result = ([Int] -> [Int] -> [Int]) -> [(Target, [Int])] -> Map Target [Int]
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
(++) ((Instr -> [(Target, [Int])]) -> [Instr] -> [(Target, [Int])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Instr -> [(Target, [Int])]
aux [Instr]
xs)

    aux :: Instr -> [(Target, [Int])]
aux (Value Int
v Target
tgt)     = [(Target
tgt, [Int
v])]
    aux (Gives Int
src Target
lo Target
hi) = [(Target
lo, [Int
l]), (Target
hi, [Int
h])]
      where [Int
l,Int
h] = [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort (Map Target [Int]
result Map Target [Int] -> Target -> [Int]
forall k a. Ord k => Map k a -> k -> a
Map.! Int -> Target
Bot Int
src)