Skip to content

Commit

Permalink
Merge pull request #58 from ephemient/hs/day7
Browse files Browse the repository at this point in the history
It's faster in reverse
  • Loading branch information
ephemient authored Dec 7, 2024
2 parents 9f52b10 + cffd7e0 commit dbb38a1
Showing 1 changed file with 18 additions and 6 deletions.
24 changes: 18 additions & 6 deletions hs/src/Day7.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,8 @@ module Day7 (part1, part2) where
import Common (readEntire, readSome)
import Control.Monad (ap)
import Control.Parallel.Strategies (parMap, rseq)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty)
import Data.List.NonEmpty qualified as NE (reverse)
import Data.Text (Text)
import Data.Text qualified as T (lines, stripPrefix)
import Data.Text.Read (Reader)
Expand All @@ -18,19 +19,30 @@ parseLine :: (Integral a) => Reader (a, NonEmpty a)
parseLine line = do
(lhs, line') <- T.decimal line
(rhs, line'') <- maybe (Left "") (readSome T.decimal) $ T.stripPrefix ": " line'
pure ((lhs, rhs), line'')
pure ((lhs, NE.reverse rhs), line'')

parFilter :: (a -> Bool) -> [a] -> [a]
parFilter f = fmap fst . filter snd . (zip `ap` parMap rseq f)

solve :: (Integral a) => (a -> a -> [a]) -> Text -> Either String a
solve op input = sum . map fst . parFilter f <$> mapM (readEntire parseLine) (T.lines input)
where
f (lhs, r0 :| []) = lhs == r0
f (lhs, r0 :| r1 : rhs) = or [r2 <= lhs && f (lhs, r2 :| rhs) | r2 <- r0 `op` r1]
f (x, y :| rest)
| Just rest' <- nonEmpty rest = or [f (z, rest') | z <- x `op` y]
| otherwise = x == y

op1, op2 :: (Integral a) => a -> a -> [a]
op1 x y = [x - y | x >= y] <> case x `divMod` y of (z, 0) -> [z]; _ -> []
op2 x y =
op1 x y
<> [ z
| d <- take 1 $ dropWhile (<= y) $ iterate (* 10) 10,
let (z, r) = x `divMod` d,
z /= 0 && r == y
]

part1 :: Text -> Either String Int
part1 = solve $ \a b -> [a + b, a * b]
part1 = solve op1

part2 :: Text -> Either String Int
part2 = solve $ \a b -> [a + b, a * b, read $ show a ++ show b]
part2 = solve op2

0 comments on commit dbb38a1

Please sign in to comment.