diff --git a/16-a.hs b/16-a.hs new file mode 100644 index 0000000..0748a62 --- /dev/null +++ b/16-a.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE TupleSections #-} + +import Common +import AStar +import Data.List.Split (splitOn) +import Data.Maybe (catMaybes) +import Data.List (find, maximumBy) +import GHC.Data.Maybe (fromJust) +import GHC.Utils.Misc (sndOf3) + +data Valve = Valve { + valveName :: String, + valveFlowRate :: Int, + valveLeadsTo :: [String], + valveOpen :: Bool +} + deriving (Show, Eq) + +-- disgusting, but works +parse :: String -> Valve +parse s = Valve name flowRate leadsTo False + where + leadsTo = map trim $ splitOn "," $ unwords $ drop 9 w + name = w !! 1 + flowRate = read $ init $ (!! 1) $ splitOn "=" $ w !! 4 + w = words s + +startLocation = "AA" +totalMinutes = 30 + +findValve :: [Valve] -> String -> Valve +findValve valves s = fromJust $ find ((== s) . valveName) valves + +calculateValvesBuildup :: [Valve] -> Int +calculateValvesBuildup = sum . map valveFlowRate . filter valveOpen + +openValve :: [Valve] -> String -> [Valve] +openValve valves name = map (\v -> if valveName v == name then Valve (valveName v) (valveFlowRate v) (valveLeadsTo v) True else v) valves + +pathfindValve :: [Valve] -> String -> String -> (Int, [String]) +pathfindValve valves a b = fromJust $ astarSearch a (== b) (map (, 1000) . valveLeadsTo . findValve valves) (const 0) + +getValveScore :: [Valve] -> String -> Int -> Valve -> (Valve, Int, [String]) +getValveScore valves pos minutes valve = (valve, (totalMinutes - approxMinutes) * flowRate, path) + where + flowRate = valveFlowRate valve + approxMinutes = minutes + length path + path = snd $ pathfindValve valves pos (valveName valve) + +go :: [Valve] -> Int -> String -> Int -> Int +go valves minutes pos pressure + | minutes > 30 = pressure + | null valveScores = go valves (minutes + 1) pos (pressure + calculateValvesBuildup valves) + | otherwise = maximum $ trace (map sndOf3 valveScores) $ map goTo maxValves + where + goTo :: (Valve, Int, [String]) -> Int + goTo (valve, _, path) = go newValves (minutes + 1) newPosition (pressure + calculateValvesBuildup valves) + where + newPosition = if name == pos then pos else path !! 1 + newValves = if name == pos then openValve valves name else valves + name = valveName valve + + maxValves = filter (\(_, score, _) -> score == maxScore) valveScores + (_, maxScore, _) = maximumBy (\a b -> sndOf3 a `compare` sndOf3 b) valveScores + valveScores = map (getValveScore valves pos minutes) $ filter (\v -> valveFlowRate v > 0 && not (valveOpen v)) valves + +main = interact $ + show + . (\valves -> go valves 0 startLocation 0) + . map parse + . lines diff --git a/17-a.hs b/17-a.hs new file mode 100644 index 0000000..2a0cf2a --- /dev/null +++ b/17-a.hs @@ -0,0 +1,46 @@ +{-# LANGUAGE ScopedTypeVariables #-} + +import Data.Int +import Data.Word +import Data.Bits + +type Line = Int8 +type TetrisBoard = [Line] + +po2 :: forall a. (Bits a, Num a) => Int -> a +po2 = shiftL (1 :: a) +po2b :: forall a. (Bits a, Num a) => Bool -> Int -> a +po2b b = if b then po2 else const 0 + +fromRow :: Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Word8 +fromRow a b c d e f g = foldl1 (.|.) $ zipWith po2b [a, b, c, d, e, f, g] [0..] + +fromRowList :: [Bool] -> Word8 +fromRowList [a, b, c, d, e, f, g] = fromRow a b c d e f g +fromRowList _ = undefined + +minos = [ + [ + "####" + ], + [ + ".#.", + "###", + ".#." + ], + [ + "..#", + "..#", + "###" + ], + [ + "#", + "#", + "#", + "#" + ], + [ + "##", + "##" + ]] + diff --git a/18-a.hs b/18-a.hs new file mode 100644 index 0000000..9f38ee9 --- /dev/null +++ b/18-a.hs @@ -0,0 +1,18 @@ +import Common +import Data.List.Split (splitOn) + +parse :: String -> [Pos3] +parse = map ((\[x, y, z] -> (x, y, z)) . map read . splitOn ",") . lines + +getAdjacentPos3 :: Pos3 -> [Pos3] +getAdjacentPos3 pos = map (add3 pos) pos3Permutations +pos3Permutations :: [Pos3] +pos3Permutations = [(1, 0, 0), (0, 1, 0), (0, 0, 1), (-1, 0, 0), (0, -1, 0), (0, 0, -1)] + +surfaceArea :: [Pos3] -> Pos3 -> Int +surfaceArea positions pos = (6 -) $ count (`elem` positions) $ getAdjacentPos3 pos + +main = interact $ + show + . (\cubes -> sum $ map (surfaceArea cubes) cubes) + . parse \ No newline at end of file diff --git a/18-b.hs b/18-b.hs new file mode 100644 index 0000000..64049fe --- /dev/null +++ b/18-b.hs @@ -0,0 +1,37 @@ +import Common +import Data.List.Split (splitOn) +import GHC.Utils.Misc (fstOf3, thdOf3, sndOf3) + +parse :: String -> [Pos3] +parse = map ((\[x, y, z] -> (x, y, z)) . map read . splitOn ",") . lines + +getAdjacentPos3 :: Pos3 -> [Pos3] +getAdjacentPos3 pos = map (add3 pos) pos3Permutations +pos3Permutations :: [Pos3] +pos3Permutations = [(1, 0, 0), (0, 1, 0), (0, 0, 1), (-1, 0, 0), (0, -1, 0), (0, 0, -1)] + +surfaceArea :: [Pos3] -> [Pos3] -> Pos3 -> Int +surfaceArea positions air pos = count (\pos -> (pos `elem` air) && notElem pos positions) $ getAdjacentPos3 pos + +getAirCells :: [Pos3] -> [Pos3] +getAirCells positions = getAirCells' [] (minX - 1, minY - 1, minZ - 1) + where + minX = minimum $ map fstOf3 positions + maxX = maximum $ map fstOf3 positions + minY = minimum $ map sndOf3 positions + maxY = maximum $ map sndOf3 positions + minZ = minimum $ map thdOf3 positions + maxZ = maximum $ map thdOf3 positions + + inBounds (x, y, z) = x >= (minX - 1) && y >= (minY - 1) && z >= (minZ - 1) && x <= (maxX + 1) && y <= (maxY + 1) && z <= (maxZ + 1) + + getAirCells' :: [Pos3] -> Pos3 -> [Pos3] + getAirCells' visited pos = (foldl getAirCells' (pos : (visited ++ adjacent)) adjacent) + where + validPos pos = inBounds pos && notElem pos visited && notElem pos positions + adjacent = filter validPos $ getAdjacentPos3 pos + +main = interact $ + show + . (\cubes -> sum $ map (surfaceArea cubes (getAirCells cubes)) cubes) + . parse \ No newline at end of file diff --git a/Common.hs b/Common.hs index a8e822a..0a2710a 100644 --- a/Common.hs +++ b/Common.hs @@ -4,8 +4,27 @@ module Common where import Data.List (findIndex, elemIndex) import GHC.IO (unsafePerformIO) import Control.DeepSeq (deepseq) +import Data.Char (isSpace) type Pos = (Int, Int) + +addPos :: Pos -> Pos -> Pos +addPos (x1, y1) (x2, y2) = (x1 + x2, y1 + y2) + +subPos :: Pos -> Pos -> Pos +subPos (x1, y1) (x2, y2) = (x1 - x2, y1 - y2) + +taxicabDist :: Pos -> Pos -> Int +taxicabDist (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2) + +taxicabDist3 :: Pos3 -> Pos3 -> Int +taxicabDist3 (x1, y1, z1) (x2, y2, z2) = abs (x1 - x2) + abs (y1 - y2) + abs (z1 - z2) + +type Pos3 = (Int, Int, Int) + +add3 :: Pos3 -> Pos3 -> Pos3 +add3 (x1, y1, z1) (x2, y2, z2) = (x1 + x2, y1 + y2, z1 + z2) + type Grid a = [[a]] (!!!) :: Grid a -> Pos -> a @@ -25,15 +44,6 @@ gridWidth = length . head gridHeight :: Grid a -> Int gridHeight = length -taxicabDist :: Pos -> Pos -> Int -taxicabDist (x1, y1) (x2, y2) = abs (x1 - x2) + abs (y1 - y2) - -addPos :: Pos -> Pos -> Pos -addPos (x1, y1) (x2, y2) = (x1 + x2, y1 + y2) - -subPos :: Pos -> Pos -> Pos -subPos (x1, y1) (x2, y2) = (x1 - x2, y1 - y2) - {-# NOINLINE debug #-} debug :: Show a => a -> () debug = unsafePerformIO . print @@ -42,4 +52,7 @@ trace :: Show b => b -> a -> a trace s = deepseq (debug s) count :: (a -> Bool) -> [a] -> Int -count f = length . filter f \ No newline at end of file +count f = length . filter f + +trim :: String -> String +trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace \ No newline at end of file