module Day19 where
import Data.List.Split (splitOn)
import Debug.Trace (trace, traceShow)
import Data.List (delete, transpose, maximumBy, sort, nub)
import Data.Ord (comparing)
import qualified Data.Bifunctor

type Coord = (Int,Int,Int)

add :: Coord -> Coord -> Coord
add (x,y,z) (a,b,c) = (x+a, y+b, z+c)

readScanner :: [String] -> [Coord]
readScanner [] = error "empty scanner"
readScanner (x:xs) = map pos xs where
    pos line = (x,y,z) where [x,y,z] = map read $ splitOn "," line

-- shamelessly stolen from spoiler
transformCoord :: Coord -> [Coord]
transformCoord (x,y,z) = [
        (x,y,z),
        (-x,-y,z),
        (-x,y,-z),
        (x,-y,-z),
        (y,z,x),
        (-y,-z,x),
        (-y,z,-x),
        (y,-z,-x),
        (z,x,y),
        (-z,-x,y),
        (-z,x,-y),
        (z,-x,-y),
        (x,z,-y),
        (x,-z,y),
        (-x,z,y),
        (-x,-z,-y),
        (y,x,-z),
        (y,-x,z),
        (-y,x,z),
        (-y,-x,-z),
        (z,y,-x),
        (z,-y,x),
        (-z,y,x),
        (-z,-y,-x)]

deltas :: [Coord] -> [(Coord, [Coord])]
deltas coords = map (\c -> (c, deltas' c)) coords where
    deltas' c = map (delta c) (c `delete` coords)
    delta (x,y,z) (a,b,c) = (x-a, y-b, z-c)

findOverlap :: [Coord] -> [Coord] -> [Coord]
findOverlap sc1 sc2 = map fst $ filter (in2 . snd) d1 where
    d1 = deltas sc1
    d2 = concatMap snd (deltas sc2)
    in2 c = any (`elem` d2) c

maxi :: (Ord a1) => [a1] -> (a1, Int)
maxi xs = maximumBy (comparing fst) (zip xs [0..])

merge :: ([Coord], [Coord]) -> ([Coord], [Coord]) -> ([Coord], [Coord])
merge (diffs, known) (overlappingNew, scanner) = (diff:diffs, nub $ sort $ known ++ map (add diff) scanner) where
    overlappingOrig = findOverlap scanner known
    diff = (x-nx, y-ny, z-nz) where (x,y,z) = minimum overlappingNew; (nx,ny,nz) = minimum overlappingOrig


discover :: [Coord] -> [Coord] -> [[[Coord]]] -> ([Coord], [Coord], [[[Coord]]])
discover diffs known [] = (diffs, known, [])
discover diffs known aux = trace (show (map (length.fst) bestPer)) $
                            if bestScore < 12 then (diffs, known, aux) else (diffs ++ fst newKnown, snd newKnown, newAux) where
    overlapKnown = map (map (\x -> (findOverlap known x, x))) aux
    bestPer = map (maximumBy (\x y -> compare (length $ fst x) (length $ fst y))) overlapKnown
    bestScore = maximum $ map (length . fst) bestPer
    scanners = filter (\scanner -> length (fst scanner) >= 12) bestPer
    newKnown = foldl merge ([], known) scanners
    newAux = filter (\s -> all ((`notElem` s) . snd) scanners) aux

discoverUntil :: [Coord] -> [Coord] -> [[[Coord]]] -> ([Coord], [Coord], [[[Coord]]])
discoverUntil diffs known aux = if known == known' then (diffs', known', aux') else discoverUntil diffs' known' aux' where
    (diffs', known', aux') = discover diffs known aux

manhattan :: Coord -> Coord -> Int
manhattan (a,b,c) (x,y,z) = abs (a-x) + abs (b-y) + abs (c-z)

main :: IO ()
main = do
    input <- map readScanner . splitOn [""] . lines <$> getContents

    let known = head input
    let aux = transpose $ map (\i -> map (map (\c -> transformCoord c !! i)) (tail input)) [0..23]

    let (diffs, final, aux') = discoverUntil [] known aux

    putStr "part 1: "
    print $ length final

    putStr "part 2: "
    let manhattans = concatMap (\s -> map (manhattan s) diffs) diffs
    print $ maximum manhattans