From d4c395b7138a6dd838a9068ec3804e74e367b7e0 Mon Sep 17 00:00:00 2001
From: Joscha <joscha@plugh.de>
Date: Tue, 22 Dec 2020 11:48:26 +0000
Subject: [PATCH] [hs] Solve 2020_22 part 2

---
 hs/src/Aoc/Y2020/D22.hs | 50 +++++++++++++++++++++++++++++------------
 1 file changed, 36 insertions(+), 14 deletions(-)

diff --git a/hs/src/Aoc/Y2020/D22.hs b/hs/src/Aoc/Y2020/D22.hs
index 6e6b08a..6120d62 100644
--- a/hs/src/Aoc/Y2020/D22.hs
+++ b/hs/src/Aoc/Y2020/D22.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE MultiWayIf        #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Aoc.Y2020.D22
@@ -8,11 +9,14 @@ import           Control.Monad
 import           Data.Foldable
 
 import qualified Data.Sequence as Seq
+import qualified Data.Set      as Set
 
 import           Aoc.Day
 import           Aoc.Parse
 
-parser :: Parser (Seq.Seq Int, Seq.Seq Int)
+type Hand = Seq.Seq Int
+
+parser :: Parser (Hand, Hand)
 parser = do
   void $ string "Player 1:\n"
   p1 <- many (decimal <* newline)
@@ -20,23 +24,41 @@ parser = do
   p2 <- many (decimal <* newline)
   pure (Seq.fromList p1, Seq.fromList p2)
 
-step :: (Seq.Seq Int, Seq.Seq Int) -> Either (Seq.Seq Int) (Seq.Seq Int, Seq.Seq Int)
-step (Seq.Empty, crab) = Left crab
-step (self, Seq.Empty) = Left self
-step (s Seq.:<| self, c Seq.:<| crab)
-  | s >= c    = Right (self Seq.|> s Seq.|> c, crab)
-  | otherwise = Right (self, crab Seq.|> c Seq.|> s)
+combat :: (Hand, Hand) -> Hand
+combat (Seq.Empty, crab) = crab
+combat (self, Seq.Empty) = self
+combat (s Seq.:<| self, c Seq.:<| crab)
+  | s >= c    = combat (self Seq.|> s Seq.|> c, crab)
+  | otherwise = combat (self, crab Seq.|> c Seq.|> s)
 
-untilLeft :: (a -> Either b a) -> a -> b
-untilLeft f a = case f a of
-  Left b   -> b
-  Right a2 -> untilLeft f a2
+recursiveCombat :: Set.Set (Hand, Hand) -> (Hand, Hand) -> Either Hand Hand
+recursiveCombat _ (Seq.Empty, crab) = Right crab
+recursiveCombat _ (self, Seq.Empty) = Left self
+recursiveCombat previously now@(s Seq.:<| self, c Seq.:<| crab)
+  | now `Set.member` previously = Left self
+  | otherwise = recursiveCombat (Set.insert now previously) $ case winner of
+      Left  _ -> (self Seq.|> s Seq.|> c, crab)
+      Right _ -> (self, crab Seq.|> c Seq.|> s)
+  where
+    sLen = Seq.length self
+    cLen = Seq.length crab
+    winner = if
+      | s <= sLen && c <= cLen -> recursiveCombat Set.empty (Seq.take s self, Seq.take c crab)
+      | s >= c                 -> Left self
+      | otherwise              -> Right crab
 
-solver :: (Seq.Seq Int, Seq.Seq Int) -> IO ()
+
+score :: Hand -> Int
+score = sum . zipWith (*) [1..] . toList . Seq.reverse
+
+solver :: (Hand, Hand) -> IO ()
 solver (self, crab) = do
   putStrLn ">> Part 1"
-  let winner = untilLeft step (self, crab)
-  print $ sum $ zipWith (*) [1..] $ toList $ Seq.reverse winner
+  print $ score $ combat (self, crab)
+
+  putStrLn ""
+  putStrLn ">> Part 2"
+  print $ score $ either id id $ recursiveCombat Set.empty (self, crab)
 
 day :: Day
 day = dayParse parser solver