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

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

The stepping function is invertible, so any cycles must include
the starting point. This means to find a cycle we just search
for the starting point rather than remembering all states along
the way.

-}
module Main (main) where

import Advent (format)
import Data.List (transpose, elemIndex, foldl')
import Data.Char (isAlpha)

-- | One-dimensional particle with a position and velocity.
data Particle = P !Int !Int -- ^ position velocity
  deriving (Particle -> Particle -> Bool
(Particle -> Particle -> Bool)
-> (Particle -> Particle -> Bool) -> Eq Particle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Particle -> Particle -> Bool
== :: Particle -> Particle -> Bool
$c/= :: Particle -> Particle -> Bool
/= :: Particle -> Particle -> Bool
Eq, Eq Particle
Eq Particle =>
(Particle -> Particle -> Ordering)
-> (Particle -> Particle -> Bool)
-> (Particle -> Particle -> Bool)
-> (Particle -> Particle -> Bool)
-> (Particle -> Particle -> Bool)
-> (Particle -> Particle -> Particle)
-> (Particle -> Particle -> Particle)
-> Ord Particle
Particle -> Particle -> Bool
Particle -> Particle -> Ordering
Particle -> Particle -> Particle
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 :: Particle -> Particle -> Ordering
compare :: Particle -> Particle -> Ordering
$c< :: Particle -> Particle -> Bool
< :: Particle -> Particle -> Bool
$c<= :: Particle -> Particle -> Bool
<= :: Particle -> Particle -> Bool
$c> :: Particle -> Particle -> Bool
> :: Particle -> Particle -> Bool
$c>= :: Particle -> Particle -> Bool
>= :: Particle -> Particle -> Bool
$cmax :: Particle -> Particle -> Particle
max :: Particle -> Particle -> Particle
$cmin :: Particle -> Particle -> Particle
min :: Particle -> Particle -> Particle
Ord, Int -> Particle -> ShowS
[Particle] -> ShowS
Particle -> String
(Int -> Particle -> ShowS)
-> (Particle -> String) -> ([Particle] -> ShowS) -> Show Particle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Particle -> ShowS
showsPrec :: Int -> Particle -> ShowS
$cshow :: Particle -> String
show :: Particle -> String
$cshowList :: [Particle] -> ShowS
showList :: [Particle] -> ShowS
Show)

-- | >>> :main
-- 8538
-- 506359021038056
main :: IO ()
IO ()
main =
 do let toPs :: (Int, Int, Int) -> [Particle]
toPs (Int
x,Int
y,Int
z) = [Int -> Int -> Particle
P Int
x Int
0, Int -> Int -> Particle
P Int
y Int
0, Int -> Int -> Particle
P Int
z Int
0]
    [[Particle]]
threeD_sim <- ((Int, Int, Int) -> [Particle])
-> [(Int, Int, Int)] -> [[Particle]]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int, Int) -> [Particle]
toPs ([(Int, Int, Int)] -> [[Particle]])
-> IO [(Int, Int, Int)] -> IO [[Particle]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [format|2019 12 (<x=%d, y=%d, z=%d>%n)*|]
    let oneD_sims :: [[Particle]]
oneD_sims = [[Particle]] -> [[Particle]]
forall a. [[a]] -> [[a]]
transpose [[Particle]]
threeD_sim
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([[Particle]] -> Int
part1 [[Particle]]
oneD_sims)
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([[Particle]] -> Int
part2 [[Particle]]
oneD_sims)


part1 :: [[Particle]] -> Int
part1 :: [[Particle]] -> Int
part1 [[Particle]]
oneD_sims = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum (([Particle] -> Int) -> [[Particle]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [Particle] -> Int
energy [[Particle]]
threeD_sim1000)
  where
    oneD_sims1000 :: [[Particle]]
oneD_sims1000  = [ ([Particle] -> [Particle]) -> [Particle] -> [[Particle]]
forall a. (a -> a) -> a -> [a]
iterate [Particle] -> [Particle]
stepParticles [Particle]
sim [[Particle]] -> Int -> [Particle]
forall a. HasCallStack => [a] -> Int -> a
!! Int
1000 | [Particle]
sim <- [[Particle]]
oneD_sims ]
    threeD_sim1000 :: [[Particle]]
threeD_sim1000 = [[Particle]] -> [[Particle]]
forall a. [[a]] -> [[a]]
transpose [[Particle]]
oneD_sims1000


part2 :: [[Particle]] -> Int
part2 :: [[Particle]] -> Int
part2 [[Particle]]
oneD_sims = (Int -> Int -> Int) -> Int -> [Int] -> Int
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Integral a => a -> a -> a
lcm Int
1 [Int]
periods
  where
    periods :: [Int]
periods = ([Particle] -> Int) -> [[Particle]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([[Particle]] -> Int
forall a. Eq a => [a] -> Int
repeatLength ([[Particle]] -> Int)
-> ([Particle] -> [[Particle]]) -> [Particle] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Particle] -> [Particle]) -> [Particle] -> [[Particle]]
forall a. (a -> a) -> a -> [a]
iterate [Particle] -> [Particle]
stepParticles) [[Particle]]
oneD_sims


-- | Compute the energy of a multi-dimensional particle given
-- its dimensional components.
energy :: [Particle] -> Int
energy :: [Particle] -> Int
energy [Particle]
ps = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Int -> Int
forall a. Num a => a -> a
abs Int
x | P Int
x Int
_ <- [Particle]
ps ] Int -> Int -> Int
forall a. Num a => a -> a -> a
* [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Int -> Int
forall a. Num a => a -> a
abs Int
v | P Int
_ Int
v <- [Particle]
ps ]

repeatLength :: Eq a => [a] -> Int
repeatLength :: forall a. Eq a => [a] -> Int
repeatLength [] = String -> Int
forall a. HasCallStack => String -> a
error String
"repeatList: no cycle"
repeatLength (a
x:[a]
xs) = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n
  where Just Int
n = a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
x [a]
xs

-- | Advance a particle by its current velocity.
move :: Particle -> Particle
move :: Particle -> Particle
move (P Int
x Int
dx) = Int -> Int -> Particle
P (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
dx) Int
dx

-- | Single step of a one-dimensional, n-body system.
stepParticles :: [Particle] -> [Particle]
stepParticles :: [Particle] -> [Particle]
stepParticles [Particle]
ps = [ Particle -> Particle
move ((Particle -> Particle -> Particle)
-> Particle -> [Particle] -> Particle
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Particle -> Particle -> Particle
gravity Particle
p [Particle]
ps) | Particle
p <- [Particle]
ps ]

-- | Apply gravity to the first particle based on the second.
gravity :: Particle -> Particle -> Particle
gravity :: Particle -> Particle -> Particle
gravity (P Int
x Int
v) (P Int
y Int
_) = Int -> Int -> Particle
P Int
x (Int
v Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
forall a. Num a => a -> a
signum (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
x))