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

<https://adventofcode.com/2022/day/22>

-}
module Main where

import Data.Map (Map)
import Data.Map qualified as Map
import Data.List (foldl')

import Advent (format, stageTH)
import Advent.Coord

data D = DL | DR

stageTH

-- |
-- >>> :main
-- 162186
-- 55267
main :: IO ()
IO ()
main =
 do ([String]
rawmap, [Either Int D]
path) <- [format|2022 22 (( |.|#)*!%n)*%n(%u|@D)*%n|]
    let board :: Map Coord Char
board = (Char -> Bool) -> Map Coord Char -> Map Coord Char
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Char
' ' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=) ([(Coord, Char)] -> Map Coord Char
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([String] -> [(Coord, Char)]
coordLines [String]
rawmap))
    let start :: Coord
start = [Coord] -> Coord
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum (Map Coord Char -> [Coord]
forall k a. Map k a -> [k]
Map.keys Map Coord Char
board)
    Int -> IO ()
forall a. Show a => a -> IO ()
print ((Coord, Coord) -> Int
score ([Either Int D] -> Coord -> Map Coord Char -> (Coord, Coord)
go1 [Either Int D]
path Coord
start Map Coord Char
board))
    Int -> IO ()
forall a. Show a => a -> IO ()
print ((Coord, Coord) -> Int
score ([Either Int D] -> Coord -> Map Coord Char -> (Coord, Coord)
go2 [Either Int D]
path Coord
start Map Coord Char
board))

score :: (Coord, Coord) -> Int
score :: (Coord, Coord) -> Int
score (C Int
y Int
x, Coord
dir) = Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
faceval
  where
    faceval :: Int
faceval
      | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
east  = Int
0
      | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
south = Int
1
      | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
west  = Int
2
      | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
north = Int
3
      | Bool
otherwise = String -> Int
forall a. HasCallStack => String -> a
error String
"faceval: bad direction"

go1 :: [Either Int D] -> Coord -> Map Coord Char -> (Coord, Coord)
go1 :: [Either Int D] -> Coord -> Map Coord Char -> (Coord, Coord)
go1 [Either Int D]
commands Coord
start Map Coord Char
board = ((Coord, Coord) -> Either Int D -> (Coord, Coord))
-> (Coord, Coord) -> [Either Int D] -> (Coord, Coord)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Coord, Coord) -> Either Int D -> (Coord, Coord)
f (Coord
start, Coord
east) [Either Int D]
commands
  where
    f :: (Coord, Coord) -> Either Int D -> (Coord, Coord)
f (!Coord
here, !Coord
dir) = \case
      Left  Int
n  -> (Int -> Coord -> Coord -> Map Coord Char -> Coord
walk1 Int
n Coord
dir Coord
here Map Coord Char
board, Coord
dir)
      Right D
DL -> (Coord
here, Coord -> Coord
turnLeft Coord
dir)
      Right D
DR -> (Coord
here, Coord -> Coord
turnRight Coord
dir)

walk1 :: Int -> Coord -> Coord -> Map Coord Char -> Coord
walk1 :: Int -> Coord -> Coord -> Map Coord Char -> Coord
walk1 Int
0 Coord
_ Coord
here Map Coord Char
_ = Coord
here
walk1 Int
n Coord
dir Coord
here Map Coord Char
board
  | Map Coord Char
board Map Coord Char -> Coord -> Char
forall k a. Ord k => Map k a -> k -> a
Map.! Coord
here' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#' = Coord
here
  | Bool
otherwise = Int -> Coord -> Coord -> Map Coord Char -> Coord
walk1 (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Coord
dir Coord
here' Map Coord Char
board
  where
    here' :: Coord
here'
      | Coord -> Map Coord Char -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (Coord
hereCoord -> Coord -> Coord
forall a. Num a => a -> a -> a
+Coord
dir) Map Coord Char
board = Coord
hereCoord -> Coord -> Coord
forall a. Num a => a -> a -> a
+Coord
dir
      | Bool
otherwise = [Coord] -> Coord
forall a. HasCallStack => [a] -> a
last ((Coord -> Bool) -> [Coord] -> [Coord]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Coord -> Map Coord Char -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.member` Map Coord Char
board) ((Coord -> Coord) -> Coord -> [Coord]
forall a. (a -> a) -> a -> [a]
iterate (Coord -> Coord -> Coord
forall a. Num a => a -> a -> a
subtract Coord
dir) Coord
here))

go2 :: [Either Int D] -> Coord -> Map Coord Char -> (Coord, Coord)
go2 :: [Either Int D] -> Coord -> Map Coord Char -> (Coord, Coord)
go2 [Either Int D]
commands Coord
start Map Coord Char
board = ((Coord, Coord) -> Either Int D -> (Coord, Coord))
-> (Coord, Coord) -> [Either Int D] -> (Coord, Coord)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (Coord, Coord) -> Either Int D -> (Coord, Coord)
f (Coord
start, Coord
east) [Either Int D]
commands
  where
    f :: (Coord, Coord) -> Either Int D -> (Coord, Coord)
f (!Coord
here, !Coord
dir) = \case
      Left Int
n   -> Int -> Coord -> Coord -> Map Coord Char -> (Coord, Coord)
walk2 Int
n Coord
dir Coord
here Map Coord Char
board
      Right D
DL -> (Coord
here, Coord -> Coord
turnLeft Coord
dir)
      Right D
DR -> (Coord
here, Coord -> Coord
turnRight Coord
dir)

walk2 :: Int -> Coord -> Coord -> Map Coord Char -> (Coord, Coord)
walk2 :: Int -> Coord -> Coord -> Map Coord Char -> (Coord, Coord)
walk2 Int
0 Coord
dir Coord
here Map Coord Char
_ = (Coord
here,Coord
dir)
walk2 Int
n Coord
dir Coord
here Map Coord Char
board
  | Map Coord Char
board Map Coord Char -> Coord -> Char
forall k a. Ord k => Map k a -> k -> a
Map.! Coord
here' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#' = (Coord
here,Coord
dir)
  | Bool
otherwise = Int -> Coord -> Coord -> Map Coord Char -> (Coord, Coord)
walk2 (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) Coord
dir' Coord
here' Map Coord Char
board
  where
   (Coord
here', Coord
dir') =
      let fr :: Int
fr = Coord -> Int
coordRow Coord
here Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
50
          fc :: Int
fc = Coord -> Int
coordCol Coord
here Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
50
          fr' :: Int
fr' = Int
49 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
fr in
      case (Coord -> Int
cubeface Coord
here, Coord -> Int
cubeface (Coord
hereCoord -> Coord -> Coord
forall a. Num a => a -> a -> a
+Coord
dir)) of
         (Int
_,Int
y) | -Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
y -> (Coord
hereCoord -> Coord -> Coord
forall a. Num a => a -> a -> a
+Coord
dir, Coord
dir)

         (Int
1,Int
_) | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
north -> (Int -> Int -> Coord
C (Int
150 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fc ) Int
0,Coord
east)
         (Int
1,Int
_) | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
west  -> (Int -> Int -> Coord
C (Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fr') Int
0, Coord
east)

         (Int
2,Int
_) | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
north -> (Int -> Int -> Coord
C Int
199         Int
fc, Coord
north)
         (Int
2,Int
_) | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
east  -> (Int -> Int -> Coord
C (Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fr') Int
99, Coord
west)
         (Int
2,Int
_) | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
south -> (Int -> Int -> Coord
C ( Int
50 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fc ) Int
99, Coord
west)

         (Int
3,Int
_) | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
east -> (Int -> Int -> Coord
C  Int
49 (Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fr), Coord
north)
         (Int
3,Int
_) | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
west -> (Int -> Int -> Coord
C Int
100 Int
fr        , Coord
south)

         (Int
4,Int
_) | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
east  -> (Int -> Int -> Coord
C Int
fr'        Int
149, Coord
west)
         (Int
4,Int
_) | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
south -> (Int -> Int -> Coord
C (Int
150 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fc)  Int
49, Coord
west)

         (Int
5,Int
_) | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
north -> (Int -> Int -> Coord
C (Int
50 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fc) Int
50, Coord
east)
         (Int
5,Int
_) | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
west  -> (Int -> Int -> Coord
C Int
fr'       Int
50, Coord
east)

         (Int
6,Int
_) | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
east  -> (Int -> Int -> Coord
C Int
149 ( Int
50 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fr), Coord
north)
         (Int
6,Int
_) | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
south -> (Int -> Int -> Coord
C   Int
0 (Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fc), Coord
south)
         (Int
6,Int
_) | Coord
dir Coord -> Coord -> Bool
forall a. Eq a => a -> a -> Bool
== Coord
west  -> (Int -> Int -> Coord
C   Int
0 ( Int
50 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
fr), Coord
south)

         (Int
a,Int
b) -> String -> (Coord, Coord)
forall a. HasCallStack => String -> a
error ((Int, Int, Coord) -> String
forall a. Show a => a -> String
show (Int
a,Int
b, Coord
dir))

cubeface :: Coord -> Int
cubeface :: Coord -> Int
cubeface (C Int
y Int
x) =
   case (Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
y Int
50, Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
x Int
50) of
      (Int
0,Int
1) -> Int
1
      (Int
0,Int
2) -> Int
2
      (Int
1,Int
1) -> Int
3
      (Int
2,Int
0) -> Int
5
      (Int
2,Int
1) -> Int
4
      (Int
3,Int
0) -> Int
6
      (Int, Int)
_     -> -Int
1