Add argument to parser for disambiguating real data versus examples

This breaks less code than adding it to the solution functions, and is more elegant in a way.
This commit is contained in:
George Thomas 2025-12-08 22:42:29 +00:00
parent 43918c70fa
commit d0488726a0
10 changed files with 14 additions and 16 deletions

View File

@ -35,7 +35,7 @@ main =
pt = show number
parseFile fp =
either (fail . ("parse failure: " <>) . errorBundlePretty) pure
. runParser (parser <* eof) fp
. runParser (parser isRealData <* eof) fp
=<< T.readFile fp
in
withResource (parseFile $ "../inputs/" <> t <> "/" <> pt) mempty \input ->

View File

@ -82,7 +82,7 @@ import Text.Megaparsec.Char.Lexer (decimal)
data Puzzle = forall input. Puzzle
{ number :: Word
, parser :: Parsec Void Text input
, parser :: Bool -> Parsec Void Text input
, parts :: [input -> TL.Text]
, extraTests :: Bool -> FilePath -> IO input -> [TestTree]
}

View File

@ -8,7 +8,7 @@ puzzle :: Puzzle
puzzle =
Puzzle
{ number = 1
, parser = flip sepEndBy newline $ (,) <$> ((char 'L' $> L) <|> (char 'R' $> R)) <*> (Inc <$> decimal)
, parser = const $ flip sepEndBy newline $ (,) <$> ((char 'L' $> L) <|> (char 'R' $> R)) <*> (Inc <$> decimal)
, parts =
[ TL.show
. sum

View File

@ -9,7 +9,7 @@ puzzle :: Puzzle
puzzle =
Puzzle
{ number = 2
, parser = (<* newline) $ flip sepBy (char ',') $ (,) <$> (decimal <* char '-') <*> decimal
, parser = const $ (<* newline) $ flip sepBy (char ',') $ (,) <$> (decimal <* char '-') <*> decimal
, parts =
[ TL.show
. sum

View File

@ -9,7 +9,7 @@ puzzle :: Puzzle
puzzle =
Puzzle
{ number = 3
, parser = flip sepEndBy newline $ Bank . fmap (fromIntegral . digitToInt) <$> some1 digitChar
, parser = const $ flip sepEndBy newline $ Bank . fmap (fromIntegral . digitToInt) <$> some1 digitChar
, parts =
[ TL.show
. sum

View File

@ -12,7 +12,7 @@ puzzle :: Puzzle
puzzle =
Puzzle
{ number = 4
, parser = flip sepEndBy newline $ some $ asum $ enumerate <&> \t -> char (inToChar t) $> t
, parser = const $ flip sepEndBy newline $ some $ asum $ enumerate <&> \t -> char (inToChar t) $> t
, parts =
[ TL.show
. (\g -> countRolls g - countRolls (removeAccessibleRolls $ findAccessible g))

View File

@ -8,7 +8,7 @@ puzzle :: Puzzle
puzzle =
Puzzle
{ number = 5
, parser = do
, parser = const do
ranges <- flip sepEndBy newline $ Range <$> decimal <* single '-' <*> decimal
void newline
vals <- sepEndBy decimal newline

View File

@ -8,7 +8,7 @@ puzzle :: Puzzle
puzzle =
Puzzle
{ number = 6
, parser = do
, parser = const do
ints <- (hspace *> (decimal `sepBy1` hspace1)) `sepEndBy1` newline
ops <- ((single '*' $> Multiply) <|> (single '+' $> Add)) `sepEndBy` hspace1
void newline

View File

@ -10,7 +10,7 @@ puzzle :: Puzzle
puzzle =
Puzzle
{ number = 7
, parser = do
, parser = const do
line1 <- some $ (single '.' $> False) <|> (single 'S' $> True)
start <- maybe (fail "start not found") (pure . fst) $ find snd $ zip [0 ..] line1
void newline

View File

@ -11,20 +11,18 @@ puzzle :: Puzzle
puzzle =
Puzzle
{ number = 8
, parser = (V3 <$> decimal <* single ',' <*> decimal <* single ',' <*> decimal) `sepEndBy` newline
, parser = \isRealData -> (if isRealData then 1000 else 10,) <$> (V3 <$> decimal <* single ',' <*> decimal <* single ',' <*> decimal) `sepEndBy` newline
, parts =
[ TL.show
[ uncurry \n -> TL.show
. product
. take 3
. sortOn Down
. map length
. DS.toLists
. snd
. \boxes ->
-- TODO more principled way of distinguishing example and real
(!! ((if length boxes == 20 then 10 else if length boxes == 1000 then 1000 else undefined))) $
connectBoxes boxes
, TL.show
. (!! n)
. connectBoxes
, uncurry . const $ TL.show
. maybe (error "sets never unified") (\((V3 x1 _ _, V3 x2 _ _), _) -> x1 * x2)
. lastMay
. takeWhile ((> 1) . DS.sets . snd)