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

<https://adventofcode.com/2019/day/17>

-}
module Main (main) where

import Advent.Format (format)
import Advent.Coord
import Data.Char (ord, chr)
import Data.List (inits, intercalate, tails)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Maybe (isJust, isNothing)
import Intcode (effectList, intcodeToList, run, new, set)

-- | >>> main
-- 7280
-- 1045393
main :: IO ()
IO ()
main =
  do [Int]
inp <- [format|2019 17 %d&,%n|]
     let ascii :: String
ascii = (Int -> Char) -> [Int] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Int -> Int) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) ([Int] -> [Int] -> [Int]
intcodeToList [Int]
inp [])
         world :: Map Coord Char
world = [(Coord, Char)] -> Map Coord Char
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([String] -> [(Coord, Char)]
coordLines (String -> [String]
lines String
ascii))
     Int -> IO ()
forall a. Show a => a -> IO ()
print (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Coord -> Int
coordRow Coord
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Coord -> Int
coordCol Coord
k
                 | Coord
k <- Map Coord Char -> [Coord]
forall k a. Map k a -> [k]
Map.keys Map Coord Char
world
                 , (Coord -> Bool) -> [Coord] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Coord
x -> Char
'#' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Coord -> Map Coord Char -> Char
at Coord
x Map Coord Char
world) (Coord
k Coord -> [Coord] -> [Coord]
forall a. a -> [a] -> [a]
: Coord -> [Coord]
cardinal Coord
k) ]

     Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Map Coord Char -> Int
part2 [Int]
inp Map Coord Char
world)

at :: Coord -> Map Coord Char -> Char
at :: Coord -> Map Coord Char -> Char
at = Char -> Coord -> Map Coord Char -> Char
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Char
'.'

part2 :: [Int] -> Map Coord Char -> Int
part2 :: [Int] -> Map Coord Char -> Int
part2 [Int]
inp Map Coord Char
world =
     [Int] -> Int
forall a. HasCallStack => [a] -> a
last ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Effect -> [Int] -> [Int]
effectList (Machine -> Effect
run (Int -> Int -> Machine -> Machine
set Int
0 Int
2 ([Int] -> Machine
new [Int]
inp)))
          ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Char -> Int) -> String -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) String
input
  where
    start :: Coord
start   = [Coord] -> Coord
forall a. HasCallStack => [a] -> a
head [ Coord
k | (Coord
k,Char
'^') <- Map Coord Char -> [(Coord, Char)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Coord Char
world ]
    p :: [(Dir, Int)]
p       = Map Coord Char -> Coord -> Coord -> [(Dir, Int)]
path Map Coord Char
world Coord
start Coord
north
    String
input:[String]
_ = [String]
-> Maybe [(Dir, Int)]
-> Maybe [(Dir, Int)]
-> Maybe [(Dir, Int)]
-> [(Dir, Int)]
-> [String]
compress [] Maybe [(Dir, Int)]
forall a. Maybe a
Nothing Maybe [(Dir, Int)]
forall a. Maybe a
Nothing Maybe [(Dir, Int)]
forall a. Maybe a
Nothing [(Dir, Int)]
p

data Dir = U | D | L | R
  deriving (Dir -> Dir -> Bool
(Dir -> Dir -> Bool) -> (Dir -> Dir -> Bool) -> Eq Dir
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Dir -> Dir -> Bool
== :: Dir -> Dir -> Bool
$c/= :: Dir -> Dir -> Bool
/= :: Dir -> Dir -> Bool
Eq, Eq Dir
Eq Dir =>
(Dir -> Dir -> Ordering)
-> (Dir -> Dir -> Bool)
-> (Dir -> Dir -> Bool)
-> (Dir -> Dir -> Bool)
-> (Dir -> Dir -> Bool)
-> (Dir -> Dir -> Dir)
-> (Dir -> Dir -> Dir)
-> Ord Dir
Dir -> Dir -> Bool
Dir -> Dir -> Ordering
Dir -> Dir -> Dir
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 :: Dir -> Dir -> Ordering
compare :: Dir -> Dir -> Ordering
$c< :: Dir -> Dir -> Bool
< :: Dir -> Dir -> Bool
$c<= :: Dir -> Dir -> Bool
<= :: Dir -> Dir -> Bool
$c> :: Dir -> Dir -> Bool
> :: Dir -> Dir -> Bool
$c>= :: Dir -> Dir -> Bool
>= :: Dir -> Dir -> Bool
$cmax :: Dir -> Dir -> Dir
max :: Dir -> Dir -> Dir
$cmin :: Dir -> Dir -> Dir
min :: Dir -> Dir -> Dir
Ord, Int -> Dir -> String -> String
[Dir] -> String -> String
Dir -> String
(Int -> Dir -> String -> String)
-> (Dir -> String) -> ([Dir] -> String -> String) -> Show Dir
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Dir -> String -> String
showsPrec :: Int -> Dir -> String -> String
$cshow :: Dir -> String
show :: Dir -> String
$cshowList :: [Dir] -> String -> String
showList :: [Dir] -> String -> String
Show)

path :: Map Coord Char -> Coord -> Coord -> [(Dir,Int)]
path :: Map Coord Char -> Coord -> Coord -> [(Dir, Int)]
path Map Coord Char
world Coord
here Coord
dir
  | Char
'#' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Coord -> Map Coord Char -> Char
at (Coord -> Coord
turnLeft  Coord
dir Coord -> Coord -> Coord
forall a. Num a => a -> a -> a
+ Coord
here) Map Coord Char
world = Dir -> (Coord -> Coord) -> [(Dir, Int)]
walk Dir
L Coord -> Coord
turnLeft
  | Char
'#' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Coord -> Map Coord Char -> Char
at (Coord -> Coord
turnRight Coord
dir Coord -> Coord -> Coord
forall a. Num a => a -> a -> a
+ Coord
here) Map Coord Char
world = Dir -> (Coord -> Coord) -> [(Dir, Int)]
walk Dir
R Coord -> Coord
turnRight
  | Bool
otherwise                              = []
  where
    walk :: Dir -> (Coord -> Coord) -> [(Dir, Int)]
walk Dir
cmd Coord -> Coord
f = (Dir
cmd, Int
n) (Dir, Int) -> [(Dir, Int)] -> [(Dir, Int)]
forall a. a -> [a] -> [a]
: Map Coord Char -> Coord -> Coord -> [(Dir, Int)]
path Map Coord Char
world Coord
endPoint Coord
dir'
      where
        dir' :: Coord
dir'     = Coord -> Coord
f Coord
dir
        steps :: [Coord]
steps    = (Coord -> Bool) -> [Coord] -> [Coord]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Coord
x -> Coord -> Map Coord Char -> Char
at Coord
x Map Coord Char
world Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.')
                 ([Coord] -> [Coord]) -> [Coord] -> [Coord]
forall a b. (a -> b) -> a -> b
$ (Coord -> Coord) -> Coord -> [Coord]
forall a. (a -> a) -> a -> [a]
iterate (Coord
dir' Coord -> Coord -> Coord
forall a. Num a => a -> a -> a
+) Coord
here
        n :: Int
n        = [Coord] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Coord]
steps Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
        endPoint :: Coord
endPoint = [Coord] -> Coord
forall a. HasCallStack => [a] -> a
last [Coord]
steps

compress ::
  [String] ->
  Maybe [(Dir,Int)] ->
  Maybe [(Dir,Int)] ->
  Maybe [(Dir,Int)] ->
  [(Dir,Int)] ->
  [String]
compress :: [String]
-> Maybe [(Dir, Int)]
-> Maybe [(Dir, Int)]
-> Maybe [(Dir, Int)]
-> [(Dir, Int)]
-> [String]
compress [String]
acc Maybe [(Dir, Int)]
a Maybe [(Dir, Int)]
b Maybe [(Dir, Int)]
c [] = [[String] -> String
unlines [ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," ([String] -> [String]
forall a. [a] -> [a]
reverse [String]
acc)
                                 , String -> ([(Dir, Int)] -> String) -> Maybe [(Dir, Int)] -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"L" [(Dir, Int)] -> String
instructions Maybe [(Dir, Int)]
a
                                 , String -> ([(Dir, Int)] -> String) -> Maybe [(Dir, Int)] -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"L" [(Dir, Int)] -> String
instructions Maybe [(Dir, Int)]
b
                                 , String -> ([(Dir, Int)] -> String) -> Maybe [(Dir, Int)] -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"L" [(Dir, Int)] -> String
instructions Maybe [(Dir, Int)]
c, String
"n"] ]
compress [String]
acc Maybe [(Dir, Int)]
a Maybe [(Dir, Int)]
b Maybe [(Dir, Int)]
c [(Dir, Int)]
xs =
  do ([(Dir, Int)]
ys,[(Dir, Int)]
zs) <- (([(Dir, Int)], [(Dir, Int)]) -> Bool)
-> [([(Dir, Int)], [(Dir, Int)])] -> [([(Dir, Int)], [(Dir, Int)])]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ([(Dir, Int)] -> Bool
short ([(Dir, Int)] -> Bool)
-> (([(Dir, Int)], [(Dir, Int)]) -> [(Dir, Int)])
-> ([(Dir, Int)], [(Dir, Int)])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Dir, Int)], [(Dir, Int)]) -> [(Dir, Int)]
forall a b. (a, b) -> a
fst) ([(Dir, Int)] -> [([(Dir, Int)], [(Dir, Int)])]
forall a. [a] -> [([a], [a])]
splits [(Dir, Int)]
xs)
     [String] -> [String]
forall a. a -> a
id [ String
z | [(Dir, Int)] -> Maybe [(Dir, Int)]
forall a. a -> Maybe a
Just [(Dir, Int)]
ys Maybe [(Dir, Int)] -> Maybe [(Dir, Int)] -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe [(Dir, Int)]
a, String
z <- [String]
-> Maybe [(Dir, Int)]
-> Maybe [(Dir, Int)]
-> Maybe [(Dir, Int)]
-> [(Dir, Int)]
-> [String]
compress (String
"A"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
acc) Maybe [(Dir, Int)]
a Maybe [(Dir, Int)]
b Maybe [(Dir, Int)]
c [(Dir, Int)]
zs ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
        [ String
z | [(Dir, Int)] -> Maybe [(Dir, Int)]
forall a. a -> Maybe a
Just [(Dir, Int)]
ys Maybe [(Dir, Int)] -> Maybe [(Dir, Int)] -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe [(Dir, Int)]
b, String
z <- [String]
-> Maybe [(Dir, Int)]
-> Maybe [(Dir, Int)]
-> Maybe [(Dir, Int)]
-> [(Dir, Int)]
-> [String]
compress (String
"B"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
acc) Maybe [(Dir, Int)]
a Maybe [(Dir, Int)]
b Maybe [(Dir, Int)]
c [(Dir, Int)]
zs ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
        [ String
z | [(Dir, Int)] -> Maybe [(Dir, Int)]
forall a. a -> Maybe a
Just [(Dir, Int)]
ys Maybe [(Dir, Int)] -> Maybe [(Dir, Int)] -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe [(Dir, Int)]
c, String
z <- [String]
-> Maybe [(Dir, Int)]
-> Maybe [(Dir, Int)]
-> Maybe [(Dir, Int)]
-> [(Dir, Int)]
-> [String]
compress (String
"C"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
acc) Maybe [(Dir, Int)]
a Maybe [(Dir, Int)]
b Maybe [(Dir, Int)]
c [(Dir, Int)]
zs ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
        [ String
z | Maybe [(Dir, Int)] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [(Dir, Int)]
a,                           String
z <- [String]
-> Maybe [(Dir, Int)]
-> Maybe [(Dir, Int)]
-> Maybe [(Dir, Int)]
-> [(Dir, Int)]
-> [String]
compress (String
"A"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
acc) ([(Dir, Int)] -> Maybe [(Dir, Int)]
forall a. a -> Maybe a
Just [(Dir, Int)]
ys) Maybe [(Dir, Int)]
b Maybe [(Dir, Int)]
c [(Dir, Int)]
zs ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
        [ String
z | Maybe [(Dir, Int)] -> Bool
forall a. Maybe a -> Bool
isJust    Maybe [(Dir, Int)]
a, Maybe [(Dir, Int)] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [(Dir, Int)]
b,              String
z <- [String]
-> Maybe [(Dir, Int)]
-> Maybe [(Dir, Int)]
-> Maybe [(Dir, Int)]
-> [(Dir, Int)]
-> [String]
compress (String
"B"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
acc) Maybe [(Dir, Int)]
a ([(Dir, Int)] -> Maybe [(Dir, Int)]
forall a. a -> Maybe a
Just [(Dir, Int)]
ys) Maybe [(Dir, Int)]
c [(Dir, Int)]
zs ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
        [ String
z | Maybe [(Dir, Int)] -> Bool
forall a. Maybe a -> Bool
isJust    Maybe [(Dir, Int)]
a, Maybe [(Dir, Int)] -> Bool
forall a. Maybe a -> Bool
isJust    Maybe [(Dir, Int)]
b, Maybe [(Dir, Int)] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [(Dir, Int)]
c, String
z <- [String]
-> Maybe [(Dir, Int)]
-> Maybe [(Dir, Int)]
-> Maybe [(Dir, Int)]
-> [(Dir, Int)]
-> [String]
compress (String
"C"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
acc) Maybe [(Dir, Int)]
a Maybe [(Dir, Int)]
b ([(Dir, Int)] -> Maybe [(Dir, Int)]
forall a. a -> Maybe a
Just [(Dir, Int)]
ys) [(Dir, Int)]
zs ]

short :: [(Dir,Int)] -> Bool
short :: [(Dir, Int)] -> Bool
short [(Dir, Int)]
xs = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Dir, Int)] -> String
instructions [(Dir, Int)]
xs) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
20

instructions :: [(Dir,Int)] -> String
instructions :: [(Dir, Int)] -> String
instructions [(Dir, Int)]
xs = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"," [ Dir -> String
forall a. Show a => a -> String
show Dir
d String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"," String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n | (Dir
d,Int
n) <- [(Dir, Int)]
xs ]

splits :: [a] -> [([a],[a])]
splits :: forall a. [a] -> [([a], [a])]
splits [a]
xs = [([a], [a])] -> [([a], [a])]
forall a. HasCallStack => [a] -> [a]
tail ([[a]] -> [[a]] -> [([a], [a])]
forall a b. [a] -> [b] -> [(a, b)]
zip ([a] -> [[a]]
forall a. [a] -> [[a]]
inits [a]
xs) ([a] -> [[a]]
forall a. [a] -> [[a]]
tails [a]
xs))