aboutsummaryrefslogtreecommitdiff
path: root/2021/day22/22a.hs
blob: bcf826f1a86aa4a3a91d83dacb8226a4f24c49db (plain)
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
module Main where

import Text.Parsec
import Data.Set (Set)
import qualified Data.Set as S
import Debug.Trace (trace)

type Coord = (Int, Int, Int)
data Cuboid = Cuboid Coord Coord deriving (Show, Eq)
data Command = Command Bool Cuboid deriving (Show, Eq)

onOff = toBool <$> (try (string "on") <|> string "off")
  where toBool "on" = True
        toBool _ = False

number = do
  sign <- (option '0' (char '-'))
  num <- many1 digit
  return $ read (sign : num)

range = do
  start <- number
  string ".."
  end <- number

  return $ (start, end)

parseLine = do
  val <- onOff
  string " x="
  (sx, ex) <- range
  string ",y="
  (sy, ey) <- range
  string ",z="
  (sz, ez) <- range

  let c = Cuboid (sx, sy, sz) (ex, ey, ez)
  return $ Command val c
parseFile = endBy parseLine (char '\n')

intersects1D :: (Int, Int) -> (Int, Int) -> Bool
intersects1D (a1, a2) (b1, b2) = a2 > b1 && b2 > a1

zipCoords :: Coord -> Coord -> [(Int, Int)]
zipCoords (x, y, z) (x', y', z') = [(x, x'), (y, y'), (z, z')]

intersects :: Cuboid -> Cuboid -> Bool
intersects (Cuboid s e) (Cuboid s' e') = any (uncurry intersects1D) (zip (zipCoords s e) (zipCoords s' e'))

cEmpty :: Cuboid -> Bool
cEmpty (Cuboid (sx, sy, sz) (ex, ey, ez)) = sx > ex || sy > ey || sz > ez

cVolume :: Cuboid -> Int
cVolume (Cuboid (sx, sy, sz) (ex, ey, ez)) = vx * vy * vz
  where vx = abs (sx - (ex + 1))
        vy = abs (sy - (ey + 1))
        vz = abs (sz - (ez + 1))

ccVolume :: ChargedCuboid -> Int
ccVolume c | charge c = cVolume (cuboid c)
           | otherwise = -(cVolume (cuboid c))

cIntersection :: Cuboid -> Cuboid -> Cuboid
cIntersection c1@(Cuboid s1 e1) c2@(Cuboid s2 e2) | not  $ intersects c1 c2 = nullCuboid
                                                  | otherwise = (Cuboid s' e')
                                                    where s' = map3 (uncurry max) (zip3t s1 s2)
                                                          e' = map3 (uncurry min) (zip3t e1 e2)

data ChargedCuboid = ChargedCuboid { charge :: Bool
                                    ,cuboid :: Cuboid
                                    } deriving (Show, Eq)

performCommand :: [ChargedCuboid] -> Command -> [ChargedCuboid]
performCommand cs (Command val c) | val = (ChargedCuboid val c) : (cs ++ overlaps)
                                  | otherwise = cs ++ overlaps
  where overlaps = filter (not . cEmpty . cuboid) $ map invertedIntersection cs
        invertedIntersection cc = ChargedCuboid (not (charge cc)) ((cuboid cc) `cIntersection` c)

threshold = 50

interestedCuboid :: Cuboid
interestedCuboid = Cuboid ((-threshold), (-threshold), (-threshold)) (threshold, threshold, threshold)

nullCuboid :: Cuboid
nullCuboid = Cuboid (0, 0, 0) ((-1), (-1), (-1))

map3 :: (a -> b) -> (a, a, a) -> (b, b, b)
map3 f (a, b, c) = (f a, f b, f c)

zip3t :: (a, a, a) -> (b, b, b) -> ((a, b), (a, b), (a, b))
zip3t (x, y, z) (x', y', z') = ((x, x'), (y, y'), (z, z'))

cClamp :: Cuboid -> Cuboid
cClamp (Cuboid ss es) = Cuboid (sx', sy', sz') (ex', ey', ez')
  where (sx', sy', sz') = map3 (max (-threshold)) ss
        (ex', ey', ez') = map3 (min threshold) es

minifyCommand :: Command -> Command
minifyCommand (Command v cb) | cEmpty clamped = Command False nullCuboid
                             | otherwise       = Command v (cClamp cb)
  where clamped = cClamp cb

main = do
  input <- readFile "./input"
  let (Right parsed) = parse parseFile "input" input
  let cmds = map minifyCommand parsed

  let cs = foldl performCommand [] cmds
  let vol = foldr (+) 0 $ map ccVolume cs
  print vol