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

<https://adventofcode.com/2021/day/19>

To correlate all the scanner readings this program
selects the first scanner to be "correct". All other
scanners will be oriented relative to the first scanner.
As each scanner's location is fixed it will be queued
to be compared to all the uncorrelated scanner outputs.
Scanning in this order ensures no pair of scanners is
compared more than once.

-}
module Main (main) where

import Advent (format, counts)
import Advent.Coord3 (Coord3(..), origin, manhattan, diff, add)
import Control.Monad ((>=>))
import Data.List (transpose)
import Data.Maybe (listToMaybe)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Map qualified as Map
import Data.Either (partitionEithers)

-- | >>> :main
-- 457
-- 13243
main :: IO ()
main :: IO ()
main =
 do [(Int, [(Int, Int, Int)])]
inp <- [format|19 (--- scanner %u ---%n(%d,%d,%d%n)*)&%n|]
    let coord :: (Int, Int, Int) -> Coord3
coord (Int
x,Int
y,Int
z) = Int -> Int -> Int -> Coord3
C3 Int
x Int
y Int
z
    let scanners :: [[Coord3]]
scanners = [((Int, Int, Int) -> Coord3) -> [(Int, Int, Int)] -> [Coord3]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int, Int) -> Coord3
coord [(Int, Int, Int)]
ps | (Int
_,[(Int, Int, Int)]
ps) <- [(Int, [(Int, Int, Int)])]
inp]

    let ([Coord3]
offsets, [Set Coord3]
locations) = [(Coord3, Set Coord3)] -> ([Coord3], [Set Coord3])
forall a b. [(a, b)] -> ([a], [b])
unzip ([[Coord3]] -> [(Coord3, Set Coord3)]
start [[Coord3]]
scanners)
    Int -> IO ()
forall a. Show a => a -> IO ()
print (Set Coord3 -> Int
forall a. Set a -> Int
Set.size ([Set Coord3] -> Set Coord3
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions [Set Coord3]
locations))
    Int -> IO ()
forall a. Show a => a -> IO ()
print ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Coord3 -> Coord3 -> Int
manhattan (Coord3 -> Coord3 -> Int) -> [Coord3] -> [Coord3 -> Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Coord3]
offsets [Coord3 -> Int] -> [Coord3] -> [Int]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Coord3]
offsets))

-- | Starts the scanner reading correlation algorithm.
start ::
  [[Coord3]] {- ^ uncorrelated scanner readings -} ->
  [(Coord3, Set Coord3)] {- ^ correlated scanner locations and readings -}
start :: [[Coord3]] -> [(Coord3, Set Coord3)]
start ([Coord3]
x:[[Coord3]]
xs) = [[Coord3]] -> [(Coord3, Set Coord3)] -> [(Coord3, Set Coord3)]
assemble [[Coord3]]
xs [(Coord3
origin, [Coord3] -> Set Coord3
forall a. Ord a => [a] -> Set a
Set.fromList [Coord3]
x)]
start [] = []

-- | Worker for 'start'.
assemble ::
  [[Coord3]]             {- ^ uncorrelated scanner readings -} ->
  [(Coord3, Set Coord3)] {- ^ recently correlated scanners -} ->
  [(Coord3, Set Coord3)] {- ^ completed correlated locations and readings -}
assemble :: [[Coord3]] -> [(Coord3, Set Coord3)] -> [(Coord3, Set Coord3)]
assemble [[Coord3]]
_ [] = []
assemble [[Coord3]]
remains (c :: (Coord3, Set Coord3)
c@(Coord3
offset,Set Coord3
reference):[(Coord3, Set Coord3)]
cs) = (Coord3, Set Coord3)
c (Coord3, Set Coord3)
-> [(Coord3, Set Coord3)] -> [(Coord3, Set Coord3)]
forall a. a -> [a] -> [a]
: [[Coord3]] -> [(Coord3, Set Coord3)] -> [(Coord3, Set Coord3)]
assemble [[Coord3]]
remain' ([(Coord3, Set Coord3)]
new [(Coord3, Set Coord3)]
-> [(Coord3, Set Coord3)] -> [(Coord3, Set Coord3)]
forall a. [a] -> [a] -> [a]
++ [(Coord3, Set Coord3)]
cs)
  where
    ([(Coord3, Set Coord3)]
new,[[Coord3]]
remain') = [Either (Coord3, Set Coord3) [Coord3]]
-> ([(Coord3, Set Coord3)], [[Coord3]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
      [ Either (Coord3, Set Coord3) [Coord3]
-> ((Coord3, Set Coord3) -> Either (Coord3, Set Coord3) [Coord3])
-> Maybe (Coord3, Set Coord3)
-> Either (Coord3, Set Coord3) [Coord3]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Coord3] -> Either (Coord3, Set Coord3) [Coord3]
forall a b. b -> Either a b
Right [Coord3]
remain) (Coord3, Set Coord3) -> Either (Coord3, Set Coord3) [Coord3]
forall a b. a -> Either a b
Left (Set Coord3 -> [Coord3] -> Maybe (Coord3, Set Coord3)
match Set Coord3
reference [Coord3]
remain)
        | [Coord3]
remain <- [[Coord3]]
remains
      ]

match :: Set Coord3 -> [Coord3] -> Maybe (Coord3, Set Coord3)
match :: Set Coord3 -> [Coord3] -> Maybe (Coord3, Set Coord3)
match Set Coord3
xset [Coord3]
ys = [(Coord3, Set Coord3)] -> Maybe (Coord3, Set Coord3)
forall a. [a] -> Maybe a
listToMaybe
 [(Coord3
offset, Set Coord3
yset')
   | Set Coord3
yset <- [Coord3] -> Set Coord3
forall a. Ord a => [a] -> Set a
Set.fromList ([Coord3] -> Set Coord3) -> [[Coord3]] -> [Set Coord3]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Coord3] -> [[Coord3]]
reorient [Coord3]
ys
   , Coord3
offset <- [Coord3] -> [Coord3]
prefilter (Coord3 -> Coord3 -> Coord3
diff (Coord3 -> Coord3 -> Coord3) -> [Coord3] -> [Coord3 -> Coord3]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Coord3 -> [Coord3]
forall a. Set a -> [a]
Set.toList Set Coord3
xset [Coord3 -> Coord3] -> [Coord3] -> [Coord3]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Set Coord3 -> [Coord3]
forall a. Set a -> [a]
Set.toList Set Coord3
yset)
   , let yset' :: Set Coord3
yset' = (Coord3 -> Coord3) -> Set Coord3 -> Set Coord3
forall a b. (a -> b) -> Set a -> Set b
Set.mapMonotonic (Coord3 -> Coord3 -> Coord3
add Coord3
offset) Set Coord3
yset
   , Int
12 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Set Coord3 -> Int
forall a. Set a -> Int
Set.size (Set Coord3 -> Set Coord3 -> Set Coord3
forall a. Ord a => Set a -> Set a -> Set a
Set.intersection Set Coord3
xset Set Coord3
yset')
 ]

-- | Only bother checking offsets that occur enough times that it's possible
-- to have an overlap
prefilter :: [Coord3] -> [Coord3]
prefilter :: [Coord3] -> [Coord3]
prefilter = Map Coord3 Int -> [Coord3]
forall k a. Map k a -> [k]
Map.keys (Map Coord3 Int -> [Coord3])
-> ([Coord3] -> Map Coord3 Int) -> [Coord3] -> [Coord3]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Bool) -> Map Coord3 Int -> Map Coord3 Int
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
12) (Map Coord3 Int -> Map Coord3 Int)
-> ([Coord3] -> Map Coord3 Int) -> [Coord3] -> Map Coord3 Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Coord3] -> Map Coord3 Int
forall (f :: * -> *) a. (Foldable f, Ord a) => f a -> Map a Int
counts

reorient :: [Coord3] -> [[Coord3]]
reorient :: [Coord3] -> [[Coord3]]
reorient = [[Coord3]] -> [[Coord3]]
forall a. [[a]] -> [[a]]
transpose ([[Coord3]] -> [[Coord3]])
-> ([Coord3] -> [[Coord3]]) -> [Coord3] -> [[Coord3]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coord3 -> [Coord3]) -> [Coord3] -> [[Coord3]]
forall a b. (a -> b) -> [a] -> [b]
map (Coord3 -> [Coord3]
rotations (Coord3 -> [Coord3]) -> (Coord3 -> [Coord3]) -> Coord3 -> [Coord3]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Coord3 -> [Coord3]
faces)

faces :: Coord3 -> [Coord3]
faces :: Coord3 -> [Coord3]
faces (C3 Int
x Int
y Int
z) =
  [
    Int -> Int -> Int -> Coord3
C3 Int
x Int
y Int
z,
    Int -> Int -> Int -> Coord3
C3 Int
y (-Int
x) Int
z,
    Int -> Int -> Int -> Coord3
C3 (-Int
x) (-Int
y) Int
z,
    Int -> Int -> Int -> Coord3
C3 (-Int
y) Int
x Int
z,
    Int -> Int -> Int -> Coord3
C3 Int
y Int
z Int
x,
    Int -> Int -> Int -> Coord3
C3 Int
y (-Int
z) (-Int
x)
  ]

-- | Return the 4 rotations of a point around the x-axis
rotations :: Coord3 -> [Coord3]
rotations :: Coord3 -> [Coord3]
rotations (C3 Int
x Int
y Int
z) =
  [
    Int -> Int -> Int -> Coord3
C3 Int
x Int
y Int
z,
    Int -> Int -> Int -> Coord3
C3 Int
x (-Int
z) Int
y,
    Int -> Int -> Int -> Coord3
C3 Int
x (-Int
y) (-Int
z),
    Int -> Int -> Int -> Coord3
C3 Int
x Int
z (-Int
y)
  ]