src/advent23/advent23.hs

   1 {-# LANGUAGE NegativeLiterals #-}
   2 {-# LANGUAGE FlexibleContexts #-}
   3 {-# LANGUAGE OverloadedStrings #-}
   4 {-# LANGUAGE TypeFamilies #-}
   5 {-# LANGUAGE BangPatterns #-}
   6
   7 -- Box division approach taken from fizbin:
   8 -- https://www.reddit.com/r/adventofcode/comments/a8s17l/2018_day_23_solutions/ecfmpy0/
   9
  10 import Debug.Trace
  11
  12 -- import Prelude hiding ((++))
  13 import Data.Text (Text)
  14 import qualified Data.Text as T
  15 import qualified Data.Text.IO as TIO
  16
  17 import Data.Void (Void)
  18 import Text.Megaparsec hiding (State)
  19 import Text.Megaparsec.Char
  20 import qualified Text.Megaparsec.Char.Lexer as L
  21 import qualified Control.Applicative as CA
  22
  23 import qualified Data.Map.Strict as M
  24 import Data.Map.Strict ((!))
  25
  26 import Data.List
  27
  28 import Linear (V3(..), (^-^))
  29
  30 import qualified Data.PQueue.Max as P
  31
  32
  33 type Coord = V3 Integer -- x, y, z
  34 type BotSwarm = M.Map Coord Integer
  35 -- type VertexCounts = M.Map Coord Integer
  36 type Box = (Coord, Coord)
  37 data LabelledBox = LabelledBox { _box :: Box
  38                                , _intersectCount :: Int
  39                                } deriving (Eq, Show)
  40 -- instance Ord LabelledBox where
  41 --     lb1 `compare` lb2 = if (_intersectCount lb1) /= (_intersectCount lb2)
  42 --                         then (_intersectCount lb1) `compare` (_intersectCount lb2)
  43 --                         else if (boxSize lb1) /= (boxSize lb2)
  44 --                              then (boxSize lb1) `compare` (boxSize lb2)
  45 --                              else (distanceFromOrigin lb1) `compare` (distanceFromOrigin lb2)
  46 --     where boxSize lb = manhattan (fst $ _box lb) (snd $ _box lb)
  47 --           distanceFromOrigin lb = min (distance $ fst $ _box lb) (distance $ snd $ _box lb)
  48 instance Ord LabelledBox where
  49     lb1 `compare` lb2 = if (_intersectCount lb1) /= (_intersectCount lb2)
  50                         then (_intersectCount lb1) `compare` (_intersectCount lb2)
  51                         else if (boxSize lb1) /= (boxSize lb2)
  52                              then (boxSize lb1) `compare` (boxSize lb2)
  53                              else (distanceFromOrigin $ _box lb1) `compare` (distanceFromOrigin $ _box lb2)
  54
  55 boxSize lb = manhattan (fst $ _box lb) (snd $ _box lb)
  56 distanceFromOrigin lb = boxDistanceFromPoint lb origin
  57
  58 type BoxQueue = P.MaxQueue LabelledBox
  59
  60
  61 origin :: Coord
  62 origin = V3 0 0 0
  63
  64
  65 main :: IO ()
  66 main = do
  67         text <- TIO.readFile "data/advent23.txt"
  68         let bots = successfulParse text
  69         let swarm = enSwarm bots
  70         print $ part1 swarm
  71         print $ part2 swarm
  72         -- print (ip, instrs)
  73         -- print $ zip [0..] instrs
  74         -- print $ part1 ip instrs
  75         -- print $ part2 ip instrs
  76
  77
  78 part1 :: BotSwarm -> Int
  79 part1 swarm = M.size inRangeBots
  80     where centre = strongest swarm
  81           range = swarm!centre
  82           botInRange loc _ = (manhattan loc centre) <= range
  83           inRangeBots = M.filterWithKey botInRange swarm
  84
  85
  86 -- part2 swarm = ((distance $ snd best), best)
  87 --     where vcs = vertexCounts vs swarm
  88 --           vs = verticesOfSwarm swarm
  89 --           best = targetVertex vcs
  90
  91
  92
  93
  94 manhattan :: Coord -> Coord -> Integer
  95 -- manhattan $ (V3 0 0 0) ^-^ (V3 1 3 1)
  96 manhattan (V3 x y z) (V3 x' y' z') = (abs (x - x')) + (abs (y - y')) + (abs (z - z'))
  97
  98 distance :: Coord -> Integer
  99 distance = manhattan origin
 100
 101 enSwarm :: [(Coord, Integer)] -> BotSwarm
 102 enSwarm = foldl' (\s (c, r) -> M.insert c r s) M.empty
 103
 104
 105 strongest :: BotSwarm -> Coord
 106 strongest swarm = fst $ M.foldlWithKey' findStrongest pair0 swarm
 107     where findStrongest (currentCoord, currentMax) coord range =
 108                 if range > currentMax
 109                 then (coord, range)
 110                 else (currentCoord, currentMax)
 111           pair0 = M.findMin swarm
 112
 113
 114 boxIntersectionCount :: Box -> BotSwarm -> Int
 115 boxIntersectionCount box swarm = M.size $ M.filterWithKey (\b _ -> intersects box b swarm) swarm
 116
 117 intersects :: Box -> Coord -> BotSwarm -> Bool
 118 intersects box bot swarm =
 119     d <= range
 120     where d = boxDistanceFromPoint box bot
 121           range = swarm!bot
 122
 123
 124 boxDistanceFromPoint :: Box -> Coord -> Integer
 125 boxDistanceFromPoint ((V3 l f t), (V3 r b u)) (V3 x y z) = d
 126
 127     -- # returns whether box intersects bot
 128     -- d = 0
 129     -- for i in (0, 1, 2):
 130     --     boxlow, boxhigh = box[0][i], box[1][i] - 1
 131     --     d += abs(bot[i] - boxlow) + abs(bot[i] - boxhigh)
 132     --     d -= boxhigh - boxlow
 133     -- d //= 2
 134     -- return d <= bot[3]
 135
 136     -- dmin = 0;
 137     --     for( i = 0; i < 3; i++ ) {
 138     --         if( C[i] < Bmin[i] ) dmin += SQR( C[i] - Bmin[i] ); else
 139     --         if( C[i] > Bmax[i] ) dmin += SQR( C[i] - Bmax[i] );
 140     --         }
 141     --     if( dmin <= r2 ) return TRUE;
 142
 143
 144     where d = sum [ dist boxLow boxHigh coord
 145                   | (boxLow, boxHigh, coord)
 146                   <- [(l, r, x), (f, b, y), (t, u, z)]
 147                   ]
 148           dist bl bh v = (if v <= bl then abs (v - bl) else 0)
 149                          +
 150                          (if v >= bh then abs (v - bh) else 0)
 151
 152
 153 subBoxes :: Box -> [Box]
 154 subBoxes ((V3 l f t), (V3 r b u)) =
 155     [ ((V3 l  f  t ) , (V3 r' b' u'))
 156     , ((V3 l  f  t'),  (V3 r' b' u ))
 157     , ((V3 l  f' t ),  (V3 r' b  u'))
 158     , ((V3 l  f' t'),  (V3 r' b  u ))
 159     , ((V3 l' f  t ) , (V3 r  b' u'))
 160     , ((V3 l' f  t'),  (V3 r  b' u ))
 161     , ((V3 l' f' t ),  (V3 r  b  u'))
 162     , ((V3 l' f' t'),  (V3 r  b  u ))
 163     ]
 164     where w = (r - l) `div` 2
 165           r' = l + w
 166           b' = f + w
 167           u' = t + w
 168           l' = r' + 1
 169           f' = b' + 1
 170           t' = u' + 1
 171
 172
 173 unitBox :: Box -> Bool
 174 unitBox ((V3 l f t), (V3 r b u)) = l == r && f == b && t == u
 175
 176
 177 boundingBox swarm = ((V3 minX minY minZ), (V3 maxX maxY maxZ))
 178     where minX = minimum $ [ _x bot | bot <- M.keys swarm ]
 179           minY = minimum $ [ _y bot | bot <- M.keys swarm ]
 180           minZ = minimum $ [ _z bot | bot <- M.keys swarm ]
 181           maxX = maximum $ [ _x bot | bot <- M.keys swarm ]
 182           maxY = maximum $ [ _y bot | bot <- M.keys swarm ]
 183           maxZ = maximum $ [ _z bot | bot <- M.keys swarm ]
 184           _x (V3 x _ _) = x
 185           _y (V3 _ y _) = y
 186           _z (V3 _ _ z) = z
 187
 188
 189 part2 = distanceFromOrigin . bestUnitBox
 190
 191 bestUnitBox :: BotSwarm -> Box
 192 bestUnitBox swarm = findBestBox swarm initialQueue
 193     where initialBox = boundingBox swarm
 194           initialQueue = P.singleton $ enLabel swarm initialBox
 195
 196 findBestBox :: BotSwarm -> BoxQueue -> Box
 197 findBestBox swarm queue
 198     | unitBox currentBox = currentBox
 199     | otherwise = findBestBox swarm newQueue
 200     where (currentLBox, queue') = P.deleteFindMax queue
 201           currentBox = _box currentLBox
 202           nextBoxes = subBoxes currentBox
 203           nextLBoxes = map (enLabel swarm) nextBoxes
 204           newQueue = foldl' (\ q b -> P.insert b q) queue' nextLBoxes
 205
 206 enLabel :: BotSwarm -> Box -> LabelledBox
 207 enLabel swarm box = LabelledBox { _box = box, _intersectCount = boxIntersectionCount box swarm}
 208
 209
 210 type Parser = Parsec Void Text
 211
 212 sc :: Parser ()
 213 sc = L.space (skipSome spaceChar) CA.empty CA.empty
 214
 215 lexeme  = L.lexeme sc
 216 integer = lexeme L.decimal
 217 signedInteger = L.signed sc integer
 218 symb = L.symbol sc
 219 comma = symb ","
 220 posOpenP = symb "pos=<"
 221 posCloseP = symb ">"
 222 radiusStartP = symb "r="
 223
 224 swarmP = many nanobotP
 225 nanobotP = (,) <$> posP <* comma <*> radiusP
 226
 227 posP = posify <$> (posOpenP `between` posCloseP) coordP
 228     where posify (a, b, c) = V3 a b c
 229 coordP = (,,) <$> signedInteger <* comma <*> signedInteger <* comma <*> signedInteger
 230 radiusP = radiusStartP *> signedInteger
 231
 232
 233 successfulParse :: Text -> [(Coord, Integer)]
 234 -- successfulParse _ = []
 235 successfulParse input =
 236         case parse swarmP "input" input of
 237                 Left  _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
 238                 Right swarm  -> swarm