adventOfCode/2017/days/Day20.hs at master · GuillaumedeVolpiano/adventOfCode · GitHub

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
module Day20
  ( part1
  , part2
  ) where

import           Data.Bifunctor  (second)
import           Data.List       (groupBy, minimumBy, sortBy)
import           Data.Ord        (comparing)
import           Helpers.Parsers (numbers)
import           Linear.V3       (V3 (..))

data Particle =
  Particle Pos Velocity Acceleration
  deriving (Show)

type Pos = V3 Int

type Velocity = V3 Int

type Acceleration = V3 Int

type Space = [(Int, Particle)]

type Particles = [Particle]

expand :: Space -> Int
expand space
  | all (isMovingAway . snd) space =
    fst . minimumBy (comparing snd) . map (second expansionSpeed) $ space
  | otherwise = expand . fmap (second move) $ space

move :: Particle -> Particle
move (Particle pos vel acc) = Particle pos' vel' acc
  where
    vel' = vel + acc
    pos' = pos + vel'

collide :: Particles -> Int
collide particles
  | all (`allSeparating` particles) particles = length particles
  | otherwise =
    collide
      . concat
      . filter ((== 1) . length)
      . groupBy (\a b -> position a == position b)
      . sortBy (comparing position)
      . map move
      $ particles

separating :: Particle -> Particle -> Bool
separating p1 p2 = dist (move p1) (move p2) >= dist p1 p2

allSeparating :: Particle -> Particles -> Bool
allSeparating p = all (separating p)

position :: Particle -> Pos
position (Particle p _ _) = p

isMovingAway :: Particle -> Bool
isMovingAway (Particle (V3 x y z) (V3 dx dy dz) (V3 ddx ddy ddz)) =
  (signum x == signum dx || (signum dx == 0 && signum ddx == 0))
    && (signum dx == signum ddx || signum ddx == 0)
    && (signum y == signum dy || (signum dy == 0 && signum ddy == 0))
    && (signum dy == signum ddy || signum ddy == 0)
    && (signum z == signum dz || (signum dz == 0 && signum ddz == 0))
    && (signum dz == signum ddz || signum ddz == 0)

dist :: Particle -> Particle -> Int
dist (Particle (V3 x1 y1 z1) _ _) (Particle (V3 x2 y2 z2) _ _) =
  abs (x2 - x1) + abs (y2 - y1) + abs (z2 - z1)

expansionSpeed :: Particle -> Int
expansionSpeed (Particle _ (V3 dx dy dz) _) = abs dx + abs dy + abs dz

makeParticle :: [Int] -> Particle
makeParticle [x, y, z, dx, dy, dz, ddx, ddy, ddz] =
  Particle (V3 x y z) (V3 dx dy dz) (V3 ddx ddy ddz)

part1 :: Bool -> String -> String
part1 _ = show . expand . zip [0 ..] . map makeParticle . numbers

part2 :: Bool -> String -> String
part2 _ = show . collide . map makeParticle . numbers