2023-22 part 1 in haskell
This commit is contained in:
parent
2a1571c46e
commit
eb1dd20405
3 changed files with 1396 additions and 0 deletions
7
2023/22-Sand_Slabs/example
Normal file
7
2023/22-Sand_Slabs/example
Normal file
|
@ -0,0 +1,7 @@
|
|||
1,0,1~1,2,1
|
||||
0,0,2~2,0,2
|
||||
0,2,3~2,2,3
|
||||
0,0,4~0,2,4
|
||||
2,0,5~2,2,5
|
||||
0,1,6~2,1,6
|
||||
1,1,8~1,1,9
|
109
2023/22-Sand_Slabs/first.hs
Normal file
109
2023/22-Sand_Slabs/first.hs
Normal file
|
@ -0,0 +1,109 @@
|
|||
-- requires cabal install --lib megaparsec parser-combinators heap vector
|
||||
module Main (main) where
|
||||
|
||||
import Control.Applicative.Permutations
|
||||
import Control.Monad (void, when)
|
||||
import qualified Data.Char as C
|
||||
import Data.Either
|
||||
import Data.Functor
|
||||
import qualified Data.Heap as H
|
||||
import qualified Data.List as L
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Vector as V
|
||||
import qualified Data.Vector.Unboxed as VU
|
||||
import Data.Void (Void)
|
||||
import Text.Megaparsec
|
||||
import Text.Megaparsec.Char
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
exampleExpectedOutput = 5
|
||||
|
||||
type Coord = (Int, Int, Int)
|
||||
data Brick = Brick Coord Coord deriving (Eq, Show)
|
||||
instance Ord Brick where
|
||||
(Brick (_, _, z1) (_, _, z2)) `compare` (Brick (_, _, c1) (_, _, c2)) = min z1 z2 `compare` min c1 c2
|
||||
type Input = [Brick]
|
||||
|
||||
type Parser = Parsec Void String
|
||||
|
||||
parseNumber :: Parser Int
|
||||
parseNumber = read <$> some digitChar <* optional (char ',')
|
||||
|
||||
parseCoord :: Parser Coord
|
||||
parseCoord = (,,) <$> parseNumber
|
||||
<*> parseNumber
|
||||
<*> parseNumber
|
||||
|
||||
parseBrick :: Parser Brick
|
||||
parseBrick = Brick <$> parseCoord <* char '~'
|
||||
<*> parseCoord <* eol
|
||||
|
||||
parseInput' :: Parser Input
|
||||
parseInput' = some parseBrick <* eof
|
||||
|
||||
parseInput :: String -> IO Input
|
||||
parseInput filename = do
|
||||
input <- readFile filename
|
||||
case runParser parseInput' filename input of
|
||||
Left bundle -> error $ errorBundlePretty bundle
|
||||
Right input' -> return input'
|
||||
|
||||
type Height = (Int, Maybe Int) -- (Height, BrickId that achieved that height - 1)
|
||||
type HeightMap = V.Vector (V.Vector Height)
|
||||
type SupportMap = M.Map Int [Int] -- BrickId -> [supports brickIds]
|
||||
|
||||
compute :: Input -> Int
|
||||
compute input = L.length $ L.filter (not . isSupportBrick) [0..(length input - 1)]
|
||||
where
|
||||
isSupportBrick :: Int -> Bool
|
||||
isSupportBrick brickId = L.any isSoleSupport $ M.elems supportMap
|
||||
where
|
||||
isSoleSupport :: [Int] -> Bool
|
||||
isSoleSupport [l] = brickId == l
|
||||
isSoleSupport _ = False
|
||||
(_, settledInput, heightMap, supportMap) = L.foldl' settle (0, [], startingHeightMap, M.empty) startingInput
|
||||
where
|
||||
settle :: (Int, Input, HeightMap, SupportMap) -> Brick -> (Int, Input, HeightMap, SupportMap)
|
||||
settle (brickId, acc, hm, sm) (Brick (x1, y1, z1) (x2, y2, z2)) = (brickId+1, (Brick (a1, b1, height) (a2, b2, height-c1+c2)):acc, hm', sm')
|
||||
where
|
||||
(a1, a2, b1, b2, c1, c2) = (min x1 x2, max x1 x2, min y1 y2, max y1 y2, min z1 z2, max z1 z2)
|
||||
(height, supports) = V.foldl' heightLine (0, []) (V.ifilter (\i _ -> i>= b1 && i <= b2) hm)
|
||||
where
|
||||
heightLine :: (Int, [Int]) -> V.Vector Height -> (Int, [Int]) -- height, [support]
|
||||
heightLine acc line = V.foldl' heightElt acc (V.ifilter (\i _ -> i >= a1 && i <= a2) line)
|
||||
where
|
||||
heightElt :: (Int, [Int]) -> Height -> (Int, [Int])
|
||||
heightElt a@(hacc, _) (1, Nothing) | hacc > 1 = a
|
||||
| otherwise = (1, [])
|
||||
heightElt a@(hacc, sacc) (h, Just p) | hacc == h = (hacc, if elem p sacc then sacc else p:sacc)
|
||||
| hacc > h = a
|
||||
| otherwise = (h, [p])
|
||||
hm' = V.imap updateLine hm
|
||||
where
|
||||
updateLine :: Int -> V.Vector Height -> V.Vector Height
|
||||
updateLine y line | y < b1 || y > b2 = line
|
||||
| otherwise = V.imap updateElt line
|
||||
where
|
||||
updateElt :: Int -> Height -> Height
|
||||
updateElt x z | x < a1 || x > a2 = z
|
||||
| otherwise = (height+c2-c1+1, Just brickId)
|
||||
sm' = M.insert brickId supports sm
|
||||
startingHeightMap = V.replicate (ymax+1) (V.replicate (xmax+1) (1, Nothing))
|
||||
where
|
||||
(xmax, ymax) = L.foldl' findBounds (xs, ys) input -- xmin and ymin are 0 for both example and input
|
||||
where
|
||||
Brick (xs, ys, _) _ = head input
|
||||
findBounds :: (Int, Int) -> Brick -> (Int, Int)
|
||||
findBounds (a, b) (Brick (x1, y1, _) (x2, y2, _)) = (maximum [a, x1, x2], maximum [b, y1, y2])
|
||||
startingInput = L.sort input
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
example <- parseInput "example"
|
||||
let exampleOutput = compute example
|
||||
when (exampleOutput /= exampleExpectedOutput) (error $ "example failed: got " ++ show exampleOutput ++ " instead of " ++ show exampleExpectedOutput)
|
||||
input <- parseInput "input"
|
||||
print $ compute input
|
1280
2023/22-Sand_Slabs/input
Normal file
1280
2023/22-Sand_Slabs/input
Normal file
File diff suppressed because it is too large
Load diff
Loading…
Add table
Reference in a new issue