kamov/advent-of-code
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

haskell: 2023 24 b

Browse source
This commit is contained in:
Maciej Jur 2023-12-28 22:39:17 +01:00
parent 77c8739c13
commit ddb9bbf4fc
Signed by: kamov
GPG key ID: 191CBFF5F72ECAFD
2 changed files with 30 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
2023/haskell/app/Main.hs
View file

@ -48,4 +48,4 @@ main = do
--run 11 Day11.parse Day11.solveA Day11.solveB --run 11 Day11.parse Day11.solveA Day11.solveB
--run 12 Day12.parse Day12.solveA Day12.solveB --run 12 Day12.parse Day12.solveA Day12.solveB
--run 15 Day15.parse Day15.solveA Day15.solveB --run 15 Day15.parse Day15.solveA Day15.solveB
run 24 Day24.parse Day24.solveA Day24.solveA run 24 Day24.parse Day24.solveA Day24.solveB

48
2023/haskell/solutions/Day24.hs
View file

@ -3,28 +3,20 @@ module Day24 (parse, solveA, solveB) where
import Data.Void (Void) import Data.Void (Void)
import Data.Text (Text) import Data.Text (Text)
import Data.Maybe (mapMaybe)
import Data.Bifunctor (first, bimap)
import Text.Megaparsec (Parsec, errorBundlePretty, runParser, eof, many, sepBy) import Text.Megaparsec (Parsec, errorBundlePretty, runParser, eof, many, sepBy)
import Data.Bifunctor (first, Bifunctor (bimap))
import Text.Megaparsec.Char (char, space) import Text.Megaparsec.Char (char, space)
import Text.Megaparsec.Char.Lexer (signed, decimal) import Text.Megaparsec.Char.Lexer (signed, decimal)
import Numeric.LinearAlgebra (Matrix, R, (|>), (><), linearSolve, asColumn, fromColumns, flatten, toList) import Numeric.LinearAlgebra (R, (|>), linearSolve, asColumn, fromColumns, flatten, toList, fromLists, col)
import Misc (paired) import Misc (paired)
import Data.Maybe (mapMaybe)
type Ray = ([R], [R]) type Ray = ([R], [R])
input :: Text
input =
"19, 13, 30 @ -2, 1, -2\n\
\18, 19, 22 @ -1, -1, -2\n\
\20, 25, 34 @ -2, -2, -4\n\
\12, 31, 28 @ -1, -2, -1\n\
\20, 19, 15 @ 1, -5, -3\n"
type Parser = Parsec Void Text type Parser = Parsec Void Text
parse :: Text -> Either String [Ray] parse :: Text -> Either String [Ray]
parse = first errorBundlePretty . runParser rays "" parse = first errorBundlePretty . runParser rays ""
where where
@ -69,11 +61,29 @@ solveAFor s e = length . filter isBoth . mapMaybe (uncurry intersect2D) . paired
solveA :: [Ray] -> Int solveA :: [Ray] -> Int
solveA = solveAFor 200000000000000 400000000000000 solveA = solveAFor 200000000000000 400000000000000
-- >>> head . paired <$> parse input findThrow :: [Ray] -> Maybe [Int]
-- Right (([19.0,13.0,30.0],[-2.0,1.0,-2.0]),([18.0,19.0,22.0],[-1.0,-1.0,-2.0])) findThrow rays =
let
-- >>> solveA <$> parse input ([sx1, sy1, sz1], [vx1, vy1, vz1]) = rays !! 0
-- Right 2 ([sx2, sy2, sz2], [vx2, vy2, vz2]) = rays !! 1
([sx3, sy3, sz3], [vx3, vy3, vz3]) = rays !! 2
solveB = const 1 consts = fromLists
[ [0, vz2 - vz1, vy1 - vy2, 0, sz1 - sz2, sy2 - sy1]
, [0, vz3 - vz1, vy1 - vy3, 0, sz1 - sz3, sy3 - sy1]
, [vz1 - vz2, 0, vx2 - vx1, sz2 - sz1, 0, sx1 - sx2]
, [vz1 - vz3, 0, vx3 - vx1, sz3 - sz1, 0, sx1 - sx3]
, [vy2 - vy1, vx1 - vx2, 0, sy1 - sy2, sx2 - sx1, 0]
, [vy3 - vy1, vx1 - vx3, 0, sy1 - sy3, sx3 - sx1, 0]
]
coeffs = col
[ vy1 * sz1 - sy1 * vz1 + sy2 * vz2 - vy2 * sz2
, vy1 * sz1 - sy1 * vz1 + sy3 * vz3 - vy3 * sz3
, sx1 * vz1 - vx1 * sz1 + vx2 * sz2 - sx2 * vz2
, sx1 * vz1 - vx1 * sz1 + vx3 * sz3 - sx3 * vz3
, vx1 * sy1 - sx1 * vy1 + sx2 * vy2 - vx2 * sy2
, vx1 * sy1 - sx1 * vy1 + sx3 * vy3 - vx3 * sy3
]
in map round . toList . flatten <$> linearSolve consts coeffs
solveB :: [Ray] -> Int
solveB = maybe 0 (sum . take 3) . findThrow