{-# Language QuasiQuotes, DataKinds, NumDecimals, ScopedTypeVariables, OverloadedStrings #-}
{-|
Module      : Main
Description : Day 16 solution
Copyright   : (c) Eric Mertens, 2017
License     : ISC
Maintainer  : emertens@gmail.com

<https://adventofcode.com/2017/day/16>

Day 16 defines a language of renaming and permutations and asks us
to iterate the program one billion times!

The key to this solution is that 'stimes' can used repeated squaring
to efficiently compute the result of multiplication by a large factor.

There are two kind of dance moves: permutation of positions, and renamings
of dancers. These two kinds of moves commute with each other. Both renamings
and permutations can efficiently compose, so we represent a dance as a single
renaming and a single permutation. This representation means that our dance
combination operation ('<>') is associative, as required for dances to be a
'Monoid' because the component permutations themselves support an associative
composition.

-}
module Main where

import Advent.Format ( format )
import Advent.Permutation (Permutation, rotateRight, runPermutation, swap)
import Data.Semigroup (Semigroup, (<>), Dual(..), sconcat, stimes)
import Data.Char (chr, ord)
import GHC.TypeLits (KnownNat)

-- $setup
-- >>> :set -XDataKinds

-- | Print the solutions to both parts of the day 16 problem. The input
-- file can be overridden via command-line arguments.
main :: IO ()
IO ()
main =
 do [Either (Either Int (Int, Int)) (Char, Char)]
input <- [format|2017 16 (s%d|x%d/%d|p%c/%c)&,%n|]

    let toDance :: Either (Either Int (Int, Int)) (Char, Char) -> Dance n
toDance (Left (Left Int
n)) = Int -> Dance n
forall (n :: Nat). KnownNat n => Int -> Dance n
spinDance Int
n
        toDance (Left (Right (Int
x,Int
y))) = Int -> Int -> Dance n
forall (n :: Nat). KnownNat n => Int -> Int -> Dance n
swapDance Int
x Int
y
        toDance (Right (Char
x,Char
y)) = Char -> Char -> Dance n
forall (n :: Nat). KnownNat n => Char -> Char -> Dance n
partDance Char
x Char
y
    let dance :: Dance 16
dance = (Either (Either Int (Int, Int)) (Char, Char) -> Dance 16)
-> [Either (Either Int (Int, Int)) (Char, Char)] -> Dance 16
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Either (Either Int (Int, Int)) (Char, Char) -> Dance 16
forall {n :: Nat}.
KnownNat n =>
Either (Either Int (Int, Int)) (Char, Char) -> Dance n
toDance [Either (Either Int (Int, Int)) (Char, Char)]
input :: Dance 16

    [Char] -> IO ()
putStrLn (Dance 16 -> [Char]
forall (n :: Nat). KnownNat n => Dance n -> [Char]
runDance Dance 16
dance)
    [Char] -> IO ()
putStrLn (Dance 16 -> [Char]
forall (n :: Nat). KnownNat n => Dance n -> [Char]
runDance (Integer -> Dance 16 -> Dance 16
forall b. Integral b => b -> Dance 16 -> Dance 16
forall a b. (Semigroup a, Integral b) => b -> a -> a
stimes Integer
1e9 Dance 16
dance))

-- | Map the numbers starting at @0@ to the letters starting at @a@.
--
-- >>> intToLetter <$> [0..3]
-- "abcd"
intToLetter :: Int -> Char
intToLetter :: Int -> Char
intToLetter Int
i = Int -> Char
chr (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
'a')

-- | Map the letters starting at @a@ to the numbers starting at @0@.
--
-- >>> letterToInt <$> ['a'..'d']
-- [0,1,2,3]
letterToInt :: Char -> Int
letterToInt :: Char -> Int
letterToInt Char
c = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a'

-- | A dance is a renaming of dancers and a permutation of their positions
type Dance n = (Dual (Permutation n), Permutation n) -- ^ renaming, permutation

-- | Compute the final position of the dancers given a dance where
-- dancers start in order.
--
-- >>> let example = spinDance 1 <> swapDance 3 4 <> partDance 'e' 'b' :: Dance 5
-- >>> runDance example
-- "baedc"
-- >>> runDance (stimes 2 example)
-- "ceadb"
runDance :: KnownNat n => Dance n -> String
runDance :: forall (n :: Nat). KnownNat n => Dance n -> [Char]
runDance (Dual Permutation n
r, Permutation n
p) = (Int -> Char) -> Permutation n -> [Char]
forall a (n :: Nat). (Int -> a) -> Permutation n -> [a]
runPermutation Int -> Char
intToLetter (Permutation n
r Permutation n -> Permutation n -> Permutation n
forall a. Semigroup a => a -> a -> a
<> Permutation n
p)

-- | The spin dance where all dancers move some number of positions
-- to the right.
--
-- >>> runDance (spinDance 0 :: Dance 3)
-- "abc"
-- >>> runDance (spinDance 1 :: Dance 3)
-- "cab"
spinDance :: KnownNat n => Int -> Dance n
spinDance :: forall (n :: Nat). KnownNat n => Int -> Dance n
spinDance Int
n = (Dual (Permutation n)
forall a. Monoid a => a
mempty, Int -> Permutation n
forall (n :: Nat). KnownNat n => Int -> Permutation n
rotateRight Int
n)

-- | The swap dance where dancers in the two positions trade places.
--
-- >>> runDance (swapDance 0 1 :: Dance 3)
-- "bac"
-- >>> runDance (swapDance 0 1 <> swapDance 1 2 :: Dance 3)
-- "bca"
swapDance :: KnownNat n => Int -> Int -> Dance n
swapDance :: forall (n :: Nat). KnownNat n => Int -> Int -> Dance n
swapDance Int
x Int
y = (Dual (Permutation n)
forall a. Monoid a => a
mempty, Int -> Int -> Permutation n
forall (n :: Nat). KnownNat n => Int -> Int -> Permutation n
swap Int
x Int
y)

-- | The parter dance where the two named dancers changes positions.
--
-- >>> runDance (partDance 'a' 'b' :: Dance 3)
-- "bac"
-- >>> runDance (partDance 'a' 'b' <> partDance 'a' 'c' :: Dance 3)
-- "bca"
partDance :: KnownNat n => Char -> Char -> Dance n
partDance :: forall (n :: Nat). KnownNat n => Char -> Char -> Dance n
partDance Char
x Char
y = (Permutation n -> Dual (Permutation n)
forall a. a -> Dual a
Dual (Int -> Int -> Permutation n
forall (n :: Nat). KnownNat n => Int -> Int -> Permutation n
swap (Char -> Int
letterToInt Char
x) (Char -> Int
letterToInt Char
y)), Permutation n
forall a. Monoid a => a
mempty)