X-Git-Url: https://git.njae.me.uk/?p=advent-of-code-18.git;a=blobdiff_plain;f=src%2Fadvent23%2Fadvent23.hs;fp=src%2Fadvent23%2Fadvent23.hs;h=9812cd4f17ad4093516ceb2be10fba36b0b6c34a;hp=0000000000000000000000000000000000000000;hb=230cb62ae502719fff9a31ff858abc354ef42b4e;hpb=942e1bb64b12468703e7f1b5341d6701f101ae7f diff --git a/src/advent23/advent23.hs b/src/advent23/advent23.hs new file mode 100644 index 0000000..9812cd4 --- /dev/null +++ b/src/advent23/advent23.hs @@ -0,0 +1,238 @@ +{-# LANGUAGE NegativeLiterals #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE BangPatterns #-} + +-- Box division approach taken from fizbin: +-- https://www.reddit.com/r/adventofcode/comments/a8s17l/2018_day_23_solutions/ecfmpy0/ + +import Debug.Trace + +-- import Prelude hiding ((++)) +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO + +import Data.Void (Void) +import Text.Megaparsec hiding (State) +import Text.Megaparsec.Char +import qualified Text.Megaparsec.Char.Lexer as L +import qualified Control.Applicative as CA + +import qualified Data.Map.Strict as M +import Data.Map.Strict ((!)) + +import Data.List + +import Linear (V3(..), (^-^)) + +import qualified Data.PQueue.Max as P + + +type Coord = V3 Integer -- x, y, z +type BotSwarm = M.Map Coord Integer +-- type VertexCounts = M.Map Coord Integer +type Box = (Coord, Coord) +data LabelledBox = LabelledBox { _box :: Box + , _intersectCount :: Int + } deriving (Eq, Show) +-- instance Ord LabelledBox where +-- lb1 `compare` lb2 = if (_intersectCount lb1) /= (_intersectCount lb2) +-- then (_intersectCount lb1) `compare` (_intersectCount lb2) +-- else if (boxSize lb1) /= (boxSize lb2) +-- then (boxSize lb1) `compare` (boxSize lb2) +-- else (distanceFromOrigin lb1) `compare` (distanceFromOrigin lb2) +-- where boxSize lb = manhattan (fst $ _box lb) (snd $ _box lb) +-- distanceFromOrigin lb = min (distance $ fst $ _box lb) (distance $ snd $ _box lb) +instance Ord LabelledBox where + lb1 `compare` lb2 = if (_intersectCount lb1) /= (_intersectCount lb2) + then (_intersectCount lb1) `compare` (_intersectCount lb2) + else if (boxSize lb1) /= (boxSize lb2) + then (boxSize lb1) `compare` (boxSize lb2) + else (distanceFromOrigin $ _box lb1) `compare` (distanceFromOrigin $ _box lb2) + +boxSize lb = manhattan (fst $ _box lb) (snd $ _box lb) +distanceFromOrigin lb = boxDistanceFromPoint lb origin + +type BoxQueue = P.MaxQueue LabelledBox + + +origin :: Coord +origin = V3 0 0 0 + + +main :: IO () +main = do + text <- TIO.readFile "data/advent23.txt" + let bots = successfulParse text + let swarm = enSwarm bots + print $ part1 swarm + print $ part2 swarm + -- print (ip, instrs) + -- print $ zip [0..] instrs + -- print $ part1 ip instrs + -- print $ part2 ip instrs + + +part1 :: BotSwarm -> Int +part1 swarm = M.size inRangeBots + where centre = strongest swarm + range = swarm!centre + botInRange loc _ = (manhattan loc centre) <= range + inRangeBots = M.filterWithKey botInRange swarm + + +-- part2 swarm = ((distance $ snd best), best) +-- where vcs = vertexCounts vs swarm +-- vs = verticesOfSwarm swarm +-- best = targetVertex vcs + + + + +manhattan :: Coord -> Coord -> Integer +-- manhattan $ (V3 0 0 0) ^-^ (V3 1 3 1) +manhattan (V3 x y z) (V3 x' y' z') = (abs (x - x')) + (abs (y - y')) + (abs (z - z')) + +distance :: Coord -> Integer +distance = manhattan origin + +enSwarm :: [(Coord, Integer)] -> BotSwarm +enSwarm = foldl' (\s (c, r) -> M.insert c r s) M.empty + + +strongest :: BotSwarm -> Coord +strongest swarm = fst $ M.foldlWithKey' findStrongest pair0 swarm + where findStrongest (currentCoord, currentMax) coord range = + if range > currentMax + then (coord, range) + else (currentCoord, currentMax) + pair0 = M.findMin swarm + + +boxIntersectionCount :: Box -> BotSwarm -> Int +boxIntersectionCount box swarm = M.size $ M.filterWithKey (\b _ -> intersects box b swarm) swarm + +intersects :: Box -> Coord -> BotSwarm -> Bool +intersects box bot swarm = + d <= range + where d = boxDistanceFromPoint box bot + range = swarm!bot + + +boxDistanceFromPoint :: Box -> Coord -> Integer +boxDistanceFromPoint ((V3 l f t), (V3 r b u)) (V3 x y z) = d + + -- # returns whether box intersects bot + -- d = 0 + -- for i in (0, 1, 2): + -- boxlow, boxhigh = box[0][i], box[1][i] - 1 + -- d += abs(bot[i] - boxlow) + abs(bot[i] - boxhigh) + -- d -= boxhigh - boxlow + -- d //= 2 + -- return d <= bot[3] + + -- dmin = 0; + -- for( i = 0; i < 3; i++ ) { + -- if( C[i] < Bmin[i] ) dmin += SQR( C[i] - Bmin[i] ); else + -- if( C[i] > Bmax[i] ) dmin += SQR( C[i] - Bmax[i] ); + -- } + -- if( dmin <= r2 ) return TRUE; + + + where d = sum [ dist boxLow boxHigh coord + | (boxLow, boxHigh, coord) + <- [(l, r, x), (f, b, y), (t, u, z)] + ] + dist bl bh v = (if v <= bl then abs (v - bl) else 0) + + + (if v >= bh then abs (v - bh) else 0) + + +subBoxes :: Box -> [Box] +subBoxes ((V3 l f t), (V3 r b u)) = + [ ((V3 l f t ) , (V3 r' b' u')) + , ((V3 l f t'), (V3 r' b' u )) + , ((V3 l f' t ), (V3 r' b u')) + , ((V3 l f' t'), (V3 r' b u )) + , ((V3 l' f t ) , (V3 r b' u')) + , ((V3 l' f t'), (V3 r b' u )) + , ((V3 l' f' t ), (V3 r b u')) + , ((V3 l' f' t'), (V3 r b u )) + ] + where w = (r - l) `div` 2 + r' = l + w + b' = f + w + u' = t + w + l' = r' + 1 + f' = b' + 1 + t' = u' + 1 + + +unitBox :: Box -> Bool +unitBox ((V3 l f t), (V3 r b u)) = l == r && f == b && t == u + + +boundingBox swarm = ((V3 minX minY minZ), (V3 maxX maxY maxZ)) + where minX = minimum $ [ _x bot | bot <- M.keys swarm ] + minY = minimum $ [ _y bot | bot <- M.keys swarm ] + minZ = minimum $ [ _z bot | bot <- M.keys swarm ] + maxX = maximum $ [ _x bot | bot <- M.keys swarm ] + maxY = maximum $ [ _y bot | bot <- M.keys swarm ] + maxZ = maximum $ [ _z bot | bot <- M.keys swarm ] + _x (V3 x _ _) = x + _y (V3 _ y _) = y + _z (V3 _ _ z) = z + + +part2 = distanceFromOrigin . bestUnitBox + +bestUnitBox :: BotSwarm -> Box +bestUnitBox swarm = findBestBox swarm initialQueue + where initialBox = boundingBox swarm + initialQueue = P.singleton $ enLabel swarm initialBox + +findBestBox :: BotSwarm -> BoxQueue -> Box +findBestBox swarm queue + | unitBox currentBox = currentBox + | otherwise = findBestBox swarm newQueue + where (currentLBox, queue') = P.deleteFindMax queue + currentBox = _box currentLBox + nextBoxes = subBoxes currentBox + nextLBoxes = map (enLabel swarm) nextBoxes + newQueue = foldl' (\ q b -> P.insert b q) queue' nextLBoxes + +enLabel :: BotSwarm -> Box -> LabelledBox +enLabel swarm box = LabelledBox { _box = box, _intersectCount = boxIntersectionCount box swarm} + + +type Parser = Parsec Void Text + +sc :: Parser () +sc = L.space (skipSome spaceChar) CA.empty CA.empty + +lexeme = L.lexeme sc +integer = lexeme L.decimal +signedInteger = L.signed sc integer +symb = L.symbol sc +comma = symb "," +posOpenP = symb "pos=<" +posCloseP = symb ">" +radiusStartP = symb "r=" + +swarmP = many nanobotP +nanobotP = (,) <$> posP <* comma <*> radiusP + +posP = posify <$> (posOpenP `between` posCloseP) coordP + where posify (a, b, c) = V3 a b c +coordP = (,,) <$> signedInteger <* comma <*> signedInteger <* comma <*> signedInteger +radiusP = radiusStartP *> signedInteger + + +successfulParse :: Text -> [(Coord, Integer)] +-- successfulParse _ = [] +successfulParse input = + case parse swarmP "input" input of + Left _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err + Right swarm -> swarm