VegOwOtenks @ VegOwOtenks @lemmy.world Posts 10Comments 71Joined 11 mo. ago
Haskell
Wasn't there a pathfinding problem just recently?
Edit: Optimization to avoid recalculating paths all the time
Haskell
Part 2 was tricky, I tried executing the algorithm backwards, which worked fine for the example but not with the input program, because it uses one-way functions .-. Then I tried to write an algorithm that would try all valid combinations of powers of 8 and but I failed, I then did it by hand.
Haskell
This one was surprisingly slow to run
Haskell
I solved part two interactively, I'm not very happy about it
They do, if the remainder returned by divmod(...) wasn't zero then it wouldn't be divisble
Haskell
Pen and Paper solved these equations for me.
haskell
import Control.Arrow
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Maybe as Maybe
window6 :: [Int] -> [[Int]]
window6 [] = []
window6 is = List.splitAt 6
>>> second window6
>>> uncurry (:)
$ is
parse :: String -> [[Int]]
parse s = window6 . map read . words . List.filter ((Char.isDigit &&& Char.isSpace) >>> uncurry (||)) $ s
solveEquation (ax:ay:bx:by:tx:ty:[]) transformT
| (aNum `mod` aDenom) /= 0 = Nothing
| (bNum `mod` bDenom) /= 0 = Nothing
| otherwise = Just (abs $ aNum `div` aDenom, abs $ bNum `div` bDenom)
where
tx' = transformT tx
ty' = transformT ty
aNum = (bx*ty') - (by*tx')
aDenom = (ax*by) - (bx*ay)
bNum = (ax*ty') - (ay*tx')
bDenom = (ax*by) - (bx*ay)
part1 = map (flip solveEquation id)
>>> Maybe.catMaybes
>>> map (first (*3))
>>> map (uncurry (+))
>>> sum
part2 = map (flip solveEquation (+ 10000000000000))
>>> Maybe.catMaybes
>>> map (first (*3))
>>> map (uncurry (+))
>>> sum
main = getContents
>>= print
. (part1 &&& part2)
. parse
(Edit: coding style)
I had my code run all the time while I coded up the solution for the second part, needless to say, it wouldn't finish.
Thank you for showing the floodfill-algorithm using explored/open sets, mine was hellish inefficiently, reminds me of A*.
Haskell
Detecting regions is a floodfill. For Part 2, I select all adjacent tiles that are not part of a region and group them by the direction relative to the closest region tile, then group adjacent tiles with the same direction again and count.
Edit:
Takes 0.06s
Thank you for the hint, I wouldn't have recognized it because I haven't yet looked into it, I might try it this afternoon if I find the time, I could probably put both the Cache and the current stone count into the monad state?
Does the IORef go upwards the recursion tree? If you modify the IORef at some depth of 15, does the calling function also receive the update, is there also a Non-IO-Ref?
Haskell
Sometimes I want something mutable, this one takes 0.3s, profiling tells me 30% of my time is spent creating new objects. :/
haskell
import Control.Arrow
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Maybe as Maybe
type StoneCache = Map Int Int
type BlinkCache = Map Int StoneCache
parse :: String -> [Int]
parse = lines >>> head >>> words >>> map read
memoizedCountSplitStones :: BlinkCache -> Int -> Int -> (Int, BlinkCache)
memoizedCountSplitStones m 0 _ = (1, m)
memoizedCountSplitStones m i n
| Maybe.isJust maybeMemoized = (Maybe.fromJust maybeMemoized, m)
| n == 0 = do
let (r, rm) = memoizedCountSplitStones m (pred i) (succ n)
let rm' = cacheWrite rm i n r
(r, rm')
| digitCount `mod` 2 == 0 = do
let (r1, m1) = memoizedCountSplitStones m (pred i) firstSplit
let (r2, m2) = memoizedCountSplitStones m1 (pred i) secondSplit
let m' = cacheWrite m2 i n (r1+r2)
(r1 + r2, m')
| otherwise = do
let (r, m') = memoizedCountSplitStones m (pred i) (n * 2024)
let m'' = cacheWrite m' i n r
(r, m'')
where
secondSplit = n `mod` (10 ^ (digitCount `div` 2))
firstSplit = (n - secondSplit) `div` (10 ^ (digitCount `div` 2))
digitCount = succ . floor . logBase 10 . fromIntegral $ n
maybeMemoized = cacheLookup m i n
foldMemoized :: Int -> (Int, BlinkCache) -> Int -> (Int, BlinkCache)
foldMemoized i (r, m) n = (r + r2, m')
where
(r2, m') = memoizedCountSplitStones m i n
cacheWrite :: BlinkCache -> Int -> Int -> Int -> BlinkCache
cacheWrite bc i n r = Map.adjust (Map.insert n r) i bc
cacheLookup :: BlinkCache -> Int -> Int -> Maybe Int
cacheLookup bc i n = do
sc <- bc Map.!? i
sc Map.!? n
emptyCache :: BlinkCache
emptyCache = Map.fromList [ (i, Map.empty) | i <- [1..75]]
part1 = foldl (foldMemoized 25) (0, emptyCache)
>>> fst
part2 = foldl (foldMemoized 75) (0, emptyCache)
>>> fst
main = getContents
>>= print
. (part1 &&& part2)
. parse
Haskell
Cool task, nothing to optimize
haskell
import Control.Arrow
import Data.Array.Unboxed (UArray)
import Data.Set (Set)
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Set as Set
import qualified Data.Array.Unboxed as UArray
parse :: String -> UArray (Int, Int) Int
parse s = UArray.listArray ((1, 1), (n, m)) . map Char.digitToInt . filter (/= '\n') $ s
where
n = takeWhile (/= '\n') >>> length $ s
m = filter (== '\n') >>> length >>> pred $ s
reachableNeighbors :: (Int, Int) -> UArray (Int, Int) Int -> [(Int, Int)]
reachableNeighbors p@(py, px) a = List.filter (UArray.inRange (UArray.bounds a))
>>> List.filter ((a UArray.!) >>> pred >>> (== (a UArray.! p)))
$ [(py-1, px), (py+1, px), (py, px-1), (py, px+1)]
distinctTrails :: (Int, Int) -> UArray (Int, Int) Int -> Int
distinctTrails p a
| a UArray.! p == 9 = 1
| otherwise = flip reachableNeighbors a
>>> List.map (flip distinctTrails a)
>>> sum
$ p
reachableNines :: (Int, Int) -> UArray (Int, Int) Int -> Set (Int, Int)
reachableNines p a
| a UArray.! p == 9 = Set.singleton p
| otherwise = flip reachableNeighbors a
>>> List.map (flip reachableNines a)
>>> Set.unions
$ p
findZeros = UArray.assocs
>>> filter (snd >>> (== 0))
>>> map fst
part1 a = findZeros
>>> map (flip reachableNines a)
>>> map Set.size
>>> sum
$ a
part2 a = findZeros
>>> map (flip distinctTrails a)
>>> sum
$ a
main = getContents
>>= print
. (part1 &&& part2)
. parse
Maths degree at least explains the choice of language
Thank you for trying, oh well. Maybe we are simply at the limits.
Trees are a poor mans Sets and vice versa .-.
I only now found your edit after I had finished my previous comment. I think splitting into two lists may be good: one List of Files and one of Empty Blocks, I think this may not work with your checksumming so maybe not.
Thank you for the detailed explanation!, it made me realize that our solutions are very similar.
Instead of keeping a Dict[Int, List[Int]] where the value list is ordered I have a Dict[Int, Tree[Int]] which allows for easy (and fast!) lookup due to the nature of trees. (Also lists in haskell are horrible to mutate)
I also apply the your technique of only processing each file once, instead of calculating the checksum afterwards on the entire list of file blocks I calculate it all the time whenever I process a file. Using some maths I managed to reduce the sum to a constant expression.
It will always be a wonder to me how you manage to do so much in so few lines, even your naive solution only takes a few seconds to run. 🤯
So cool, I was very hyped when I managed to squeeze out the last bit of performance, hope you are too. Especially surprised you managed it with python, even without the simple tricks like trees ;)
I wanted to try it myself, can confirm it runs in under 0.1s in performance mode on my laptop, I am amazed though I must admin I don't understand your newest revision. 🙈