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

<https://adventofcode.com/2021/day/24>

These programs were composed of 14 nearly-identical program chunks
each of which varies in 3 parameters. Some of these chunks will
always increase the @z@ register and others have the potential to
decrease @z@. Successfully validating an input will require all
blocks with decrease potential to actually decrease. The 'pick'
implementation will only choose a parameter that would decrease
in one of these cases.

-}
module Main (main) where

import Advent (getInputLines, chunks, fromDigits, scanlM)
import Text.Read (readMaybe)

-- | >>> :main
-- 49917929934999
-- 11911316711816
main :: IO ()
IO ()
main =
 do [(Int, Int, Int)]
pgm <- ([[String]] -> (Int, Int, Int))
-> [[[String]]] -> [(Int, Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map [[String]] -> (Int, Int, Int)
extract ([[[String]]] -> [(Int, Int, Int)])
-> ([String] -> [[[String]]]) -> [String] -> [(Int, Int, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [[String]] -> [[[String]]]
forall a. Int -> [a] -> [[a]]
chunks Int
18 ([[String]] -> [[[String]]])
-> ([String] -> [[String]]) -> [String] -> [[[String]]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String]) -> [String] -> [[String]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [String]
words ([String] -> [(Int, Int, Int)])
-> IO [String] -> IO [(Int, Int, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> IO [String]
getInputLines Int
2021 Int
24
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> [(Int, Int, Int)] -> Int
solve [Int
9,Int
8..Int
1] [(Int, Int, Int)]
pgm)
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> [(Int, Int, Int)] -> Int
solve [Int
1,Int
2..Int
9] [(Int, Int, Int)]
pgm)

-- | Compute the input string that satisfies the given program.
solve ::
  [Int]             {- ^ input digit guesses in order of preference -} ->
  [(Int, Int, Int)] {- ^ program blocks -} ->
  Int               {- ^ first valid input -}
solve :: [Int] -> [(Int, Int, Int)] -> Int
solve [Int]
guesses [(Int, Int, Int)]
pgm =
  [Int] -> Int
forall a. HasCallStack => [a] -> a
head [Int -> [Int] -> Int
forall a. (HasCallStack, Integral a) => a -> [a] -> a
fromDigits Int
10 [Int]
input | ([Int]
input, Int
0) <- ((Int, Int, Int) -> Int -> [(Int, Int)])
-> Int -> [(Int, Int, Int)] -> [([Int], Int)]
forall (t :: * -> *) (m :: * -> *) b a c.
(Traversable t, Monad m) =>
(b -> a -> m (c, a)) -> a -> t b -> m (t c, a)
scanlM ([Int] -> (Int, Int, Int) -> Int -> [(Int, Int)]
pick [Int]
guesses) Int
0 [(Int, Int, Int)]
pgm]

-- | Compute the possible input choices and resulting z from each choice.
pick ::
  [Int]           {- ^ input digit guesses in order of preference -} ->
  (Int, Int, Int) {- ^ block parameters -} ->
  Int             {- ^ starting z value -} ->
  [(Int, Int)]    {- ^ selected input value and resulting output z -}
pick :: [Int] -> (Int, Int, Int) -> Int -> [(Int, Int)]
pick [Int]
guesses (Int
a,Int
b,Int
c) Int
z =
  [ (Int
i, Int -> Int -> Int -> Int -> Int -> Int
impl Int
a Int
b Int
c Int
i Int
z)
  | Int
i <- if Int
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
26 then [Int
w | let w :: Int
w = Int
zInt -> Int -> Int
forall a. Integral a => a -> a -> a
`mod`Int
26 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b, Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
w, Int
w Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9]
                    else [Int]
guesses
  ]

-- | Extract the variable parameters from a single block. These parameters
-- can be passed into 'impl' to compute this effect's block on @z@ given
-- an input digit. Programs are comprised of one of these blocks per each
-- digit of the input.
extract :: [[String]] -> (Int, Int, Int)
extract :: [[String]] -> (Int, Int, Int)
extract [
  [String
"inp", String
"w"      ],
  [String
"mul", String
"x", String
"0" ],
  [String
"add", String
"x", String
"z" ],
  [String
"mod", String
"x", String
"26"],
  [String
"div", String
"z", String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe -> Just Int
a],
  [String
"add", String
"x", String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe -> Just Int
b],
  [String
"eql", String
"x", String
"w" ],
  [String
"eql", String
"x", String
"0" ],
  [String
"mul", String
"y", String
"0" ],
  [String
"add", String
"y", String
"25"],
  [String
"mul", String
"y", String
"x" ],
  [String
"add", String
"y", String
"1" ],
  [String
"mul", String
"z", String
"y" ],
  [String
"mul", String
"y", String
"0" ],
  [String
"add", String
"y", String
"w" ],
  [String
"add", String
"y", String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe -> Just Int
c],
  [String
"mul", String
"y", String
"x" ],
  [String
"add", String
"z", String
"y" ]] =
  (Int
a, Int
b, Int
c)
extract [[String]]
x = String -> (Int, Int, Int)
forall a. HasCallStack => String -> a
error ([[String]] -> String
forall a. Show a => a -> String
show [[String]]
x)

-- | Manually compiled behavior of an input block with parameters determined
-- by 'extract'.
impl ::
  Int {- ^ first parameter -} ->
  Int {- ^ second parameter -} ->
  Int {- ^ third parameter -} ->
  Int {- ^ input digit -} ->
  Int {- ^ z register -} ->
  Int {- ^ z register -}
impl :: Int -> Int -> Int -> Int -> Int -> Int
impl Int
a Int
b Int
c Int
w Int
z
  | Int
zInt -> Int -> Int
forall a. Integral a => a -> a -> a
`mod`Int
26 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
w = Int
z Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
a
  | Bool
otherwise         = Int
z Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
26 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c