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

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

-}
module Main (main) where

import Advent
import Advent.Format (format)
import Data.Foldable
import Data.Sequence (Seq(..))
import Data.Sequence qualified as Seq
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Vector.Unboxed (Vector)
import Data.Vector.Unboxed qualified as V

-- |
-- >>> :main
-- 35818
-- 34771
main :: IO ()
IO ()
main =
  do ([Int]
xs,[Int]
ys) <- [format|2020 22 Player 1:%n(%u%n)*%nPlayer 2:%n(%u%n)*|]
     let p1 :: Seq Int
p1 = [Int] -> Seq Int
forall a. [a] -> Seq a
Seq.fromList [Int]
xs
     let p2 :: Seq Int
p2 = [Int] -> Seq Int
forall a. [a] -> Seq a
Seq.fromList [Int]
ys
     Int -> IO ()
forall a. Show a => a -> IO ()
print (Seq Int -> Int
score (Seq Int -> Seq Int -> Seq Int
play1 Seq Int
p1 Seq Int
p2))
     Int -> IO ()
forall a. Show a => a -> IO ()
print (Seq Int -> Int
score ((Bool, Seq Int) -> Seq Int
forall a b. (a, b) -> b
snd (Set Rep -> Seq Int -> Seq Int -> (Bool, Seq Int)
play2 Set Rep
forall a. Set a
Set.empty Seq Int
p1 Seq Int
p2)))

-- | Game deck, draw from left side
type Deck = Seq Int

score :: Deck -> Int
score :: Seq Int -> Int
score = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (Seq Int -> [Int]) -> Seq Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int) -> [Int] -> [Int] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(*) [Int
1..] ([Int] -> [Int]) -> (Seq Int -> [Int]) -> Seq Int -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. [a] -> [a]
reverse ([Int] -> [Int]) -> (Seq Int -> [Int]) -> Seq Int -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seq Int -> [Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

-- | representation of a game state used to find cycles
type Rep = Vector Int

characterize :: Deck -> Deck -> Rep
characterize :: Seq Int -> Seq Int -> Rep
characterize Seq Int
xs Seq Int
ys = [Int] -> Rep
forall a. Unbox a => [a] -> Vector a
V.fromList (Seq Int -> [Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Int
xs [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ (-Int
1) Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: Seq Int -> [Int]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Int
ys)

------------------------------------------------------------------------

-- | Play the game according to part 1 rules and return the winning deck
play1 :: Deck -> Deck -> Deck
play1 :: Seq Int -> Seq Int -> Seq Int
play1 Seq Int
Empty Seq Int
xs = Seq Int
xs
play1 Seq Int
xs Seq Int
Empty = Seq Int
xs
play1 (Int
x :<| Seq Int
xs) (Int
y :<| Seq Int
ys)
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
y     = Seq Int -> Seq Int -> Seq Int
play1 (Seq Int
xs Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
:|> Int
x Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
:|> Int
y) Seq Int
ys
  | Bool
otherwise = Seq Int -> Seq Int -> Seq Int
play1 Seq Int
xs (Seq Int
ys Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
:|> Int
y Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
:|> Int
x)

------------------------------------------------------------------------

-- | Play the game according to part 2 rules and report if player 1 won
-- and the winning deck. Takes a set of previously seen game states to
-- eliminate loops.
play2 :: Set Rep -> Deck -> Deck -> (Bool, Deck)
play2 :: Set Rep -> Seq Int -> Seq Int -> (Bool, Seq Int)
play2 Set Rep
_ Seq Int
Empty Seq Int
xs = (Bool
False, Seq Int
xs)
play2 Set Rep
_ Seq Int
xs Seq Int
Empty = (Bool
True, Seq Int
xs)
play2 Set Rep
seen xxs :: Seq Int
xxs@(Int
x :<| Seq Int
xs) yys :: Seq Int
yys@(Int
y :<| Seq Int
ys)

  -- P1 wins loops
  | Rep -> Set Rep -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Rep
here Set Rep
seen = (Bool
True, Seq Int
xxs)

  -- recursive game
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Seq Int -> Int
forall a. Seq a -> Int
Seq.length Seq Int
xs, Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Seq Int -> Int
forall a. Seq a -> Int
Seq.length Seq Int
ys
  , let x' :: Seq Int
x' = Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
Seq.take Int
x Seq Int
xs
  , let y' :: Seq Int
y' = Int -> Seq Int -> Seq Int
forall a. Int -> Seq a -> Seq a
Seq.take Int
y Seq Int
ys
  , let x1 :: Int
x1 = Seq Int -> Int
forall a. Ord a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum Seq Int
x' -- best P1 card
  , let y1 :: Int
y1 = Seq Int -> Int
forall a. Ord a => Seq a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum Seq Int
y' -- best P2 card

    -- if P1 has the high card that can't be lost to a
    -- recursive game then he will always eventually win:
    -- He'll never lose that card and wins in the case of
    -- a loop. The highest card is always at least as large
    -- as the number of cards in the game because all cards
    -- are unique and start at 1, therefore it can never
    -- trigger a recursive game.
  = if Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
y1 Bool -> Bool -> Bool
|| (Bool, Seq Int) -> Bool
forall a b. (a, b) -> a
fst (Set Rep -> Seq Int -> Seq Int -> (Bool, Seq Int)
play2 Set Rep
forall a. Set a
Set.empty Seq Int
x' Seq Int
y')
      then (Bool, Seq Int)
p1win
      else (Bool, Seq Int)
p2win

  -- regular game
  | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
y     = (Bool, Seq Int)
p1win
  | Bool
otherwise = (Bool, Seq Int)
p2win

  where
    here :: Rep
here  = Seq Int -> Seq Int -> Rep
characterize Seq Int
xxs Seq Int
yys
    seen1 :: Set Rep
seen1 = Rep -> Set Rep -> Set Rep
forall a. Ord a => a -> Set a -> Set a
Set.insert Rep
here Set Rep
seen
    p1win :: (Bool, Seq Int)
p1win = Set Rep -> Seq Int -> Seq Int -> (Bool, Seq Int)
play2 Set Rep
seen1 (Seq Int
xs Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
:|> Int
x Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
:|> Int
y) Seq Int
ys
    p2win :: (Bool, Seq Int)
p2win = Set Rep -> Seq Int -> Seq Int -> (Bool, Seq Int)
play2 Set Rep
seen1 Seq Int
xs (Seq Int
ys Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
:|> Int
y Seq Int -> Int -> Seq Int
forall a. Seq a -> a -> Seq a
:|> Int
x)