1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
{-# LANGUAGE TupleSections #-}
module Main where
import Control.Monad (join)
import Data.Foldable (find)
import Data.List (deleteBy, nub)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe (isJust)
import Debug.Trace (trace, traceShow)
import Utils
type Point = (Int, Int, Int)
type Scanner = (Int, [Point])
cmap :: t -> [t -> b] -> [b]
cmap x = map ($ x)
dot (a, b, c) (d, e, f) = a * d + b * e + c * f
mmulti (a, b, c) v = (dot a v, dot b v, dot c v)
transforms v =
let x = mmulti ((1, 0, 0), (0, 0, -1), (0, 1, 0))
y = mmulti ((0, 0, 1), (0, 1, 0), (-1, 0, 0))
z = mmulti ((0, -1, 0), (1, 0, 0), (0, 0, 1))
in cmap
v
[ id,
x,
y,
z,
x . x,
x . y,
x . z,
y . x,
y . y,
z . y,
z . z,
x . x . x,
x . x . y,
x . x . z,
x . y . x,
x . y . y,
x . z . z,
y . x . x,
y . y . y,
z . z . z,
x . x . x . y,
x . x . y . x,
x . y . x . x,
x . y . y . y
]
transformBeacons :: [Point] -> [[Point]]
transformBeacons beacons =
beacons $> map transforms .> transpose
checkAssumedMatch beacons1 beacons2 (b1, b2) =
let delta = calculateDelta b1 b2
translatedBeacons2 = translateBeacons delta beacons2
matchingCommonBeacons = translatedBeacons2 $> filter (`elem` beacons1)
in if length matchingCommonBeacons >= 12
then Just (translatedBeacons2, delta)
else Nothing
checkCompositeAndScannerTf :: Scanner -> Scanner -> Maybe (Int, [Point], Point)
checkCompositeAndScannerTf (s1, beacons1) (s2, beacons2) =
let pairings = [(b1, b2) | b1 <- beacons1, b2 <- beacons2]
found = map (checkAssumedMatch beacons1 beacons2) pairings $> find isJust .> join
-- if found
composite = concat .> nub
in case found of
Just (newBeacons2, newScannerPos) -> Just (s2, composite [beacons1, newBeacons2], newScannerPos)
Nothing -> Nothing
manhattanD (x, y, z) (x', y', z') = abs (x - x') + abs (y - y') + abs (z - z')
calculateDelta :: Point -> Point -> Point
calculateDelta (x, y, z) (x', y', z') = (x - x', y - y', z - z')
translateBeacons :: Point -> [Point] -> [Point]
translateBeacons (dx, dy, dz) =
map (\(x, y, z) -> (x + dx, y + dy, z + dz))
check2CompositeAndScanner :: Scanner -> Scanner -> Maybe (Int, [Point], Point)
check2CompositeAndScanner scanner1@(s1, beacons1) scanner2@(s2, beacons2) =
let beacons2Tfs = transformBeacons beacons2
found = beacons2Tfs $> map (\bs -> checkCompositeAndScannerTf scanner1 (s2, bs)) .> find isJust .> join
in found
compute _ [] = error "empty scanners list"
compute scannerPositions [composite] = Just (composite, scannerPositions)
compute scannerPositions (scanner@(s, _) : others) =
let scannerPairs = others $> map (scanner,)
found = scannerPairs $> map (uncurry check2CompositeAndScanner) .> find isJust .> join
in case found of
Just (droppedS, compositeBeacons, newScannerPos) ->
let newOthers = filter (fst .> (/=) droppedS) others
newComposite = (s, compositeBeacons)
newScannerPositions = newScannerPos : scannerPositions
in compute newScannerPositions (newComposite : newOthers)
Nothing -> compute scannerPositions others
main :: IO ()
main = do
contents <- getContents
let scanners =
contents
$> lines
.> splitOn null
.> map (drop 1)
.> map (map (splitOn (== ',') .> map read .> \[x, y, z] -> (x, y, z)))
.> zip [0 ..]
let Just ((_, resultBeacons), resultScannerPositions) = compute [] scanners
length resultBeacons $> print
let scannerPairs = [(s1, s2) | s1 <- resultScannerPositions, s2 <- resultScannerPositions, s1 /= s2]
scannerPairs $> map (uncurry manhattanD) .> maximum .> print
|
