Last active
December 14, 2022 10:12
-
-
Save mhitza/b0801918a5d9fca66483f74e9668599c to your computer and use it in GitHub Desktop.
Day 14 advent of code broken code
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE BlockArguments, Strict, LambdaCase, NoMonomorphismRestriction, MultiWayIf #-} | |
import Control.Monad.State.Strict | |
import Data.List | |
import Data.Char | |
import Data.Ord hiding (Down) | |
import Data.Bifunctor | |
import Data.Function | |
import Data.Functor.Identity | |
import Debug.Trace | |
alterF = modify . first | |
alterS = modify . second | |
focusMap x y f g = modifyAt y (modifyAt x f) g where | |
modifyAt n f = map (snd . mapAt n f) . zipWith (,) [0..] | |
where mapAt n f (i,v) | n == i = (i,f v) | |
| otherwise = (i,v) | |
getInput = readFile "/tmp/inputtest.txt" >>= pure . map (unfoldr breakApart) . lines where | |
breakApart [] = Nothing | |
breakApart line = | |
let (captured, remainder) = break (=='-') line | |
in case captured of | |
[] -> undefined | |
_ -> let (x,y) = bimap (filter (`notElem` ", >")) (filter (`notElem` ", >")) $ break (==',') captured | |
in Just ((read @Int x, read @Int y), if null remainder then [] else tail remainder) | |
makeGrid :: [[(Int,Int)]] -> (Int,[[Int]]) | |
makeGrid input = (smallestX,) . fst . snd $ fillInRocks | |
where | |
(smallestX,_) = minimumBy (comparing fst) $ concat input | |
(maxX,maxY) = bimap maximum maximum . unzip $ concat input | |
grid = replicate (maxY + 1) (map (const 0) [1..(maxX - smallestX + 1)]) | |
forEach xs state' f = foldM (\st x -> runState (f x) st) state' xs | |
fillInRocks = forEach input (grid,Nothing) compute | |
makeRange a b | a > b = [b..a] | |
| otherwise = [a..b] | |
compute :: [(Int,Int)] -> State ([[Int]],Maybe (Int,Int)) () | |
compute [] = alterS (const Nothing) >> pure () | |
compute ((x,y):xys) = gets snd >>= \case | |
Nothing -> do let x' = x - smallestX | |
alterF (focusMap x' y (const 1)) | |
alterS (const (Just (x',y))) | |
compute xys | |
Just (x',y') -> do let xrange = makeRange x' (x - smallestX ) | |
let yrange = makeRange y' y | |
forM_ xrange \xpos -> | |
forM_ yrange \ypos -> | |
alterF (focusMap xpos ypos (const 1)) | |
alterS (const (Just (x - smallestX,y))) | |
compute xys | |
gridZipper grid beginAt f fstate = runState (move beginAt) (((0,0),[[]],grid),fstate) where | |
tailOrEmpty [] = [] | |
tailOrEmpty t = tail t | |
move (nx,ny) = gets fst >>= \((x,y),backwards,forwards) -> if | |
| ny > y -> alterF (const ((x,y + 1),([] : (head backwards ++ head forwards) : tailOrEmpty backwards),(tail forwards))) >> move (nx,ny) | |
| ny < y -> alterF (const ((x,y - 1),(tailOrEmpty backwards),([] : (head backwards ++ head forwards) : tailOrEmpty forwards))) >> move (nx,ny) | |
| otherwise -> if | |
| nx > x -> alterF (const ((nx,y),((head backwards ++ take (nx - x) (head forwards)) : tailOrEmpty backwards),(drop (nx - x) (head forwards) : tailOrEmpty forwards))) >> move (nx,ny) | |
| nx < x -> alterF (const ((nx,y),(drop (nx - x) (head backwards) : tailOrEmpty backwards),(take (nx - x) (head backwards) : tailOrEmpty forwards))) >> move (nx,ny) | |
| otherwise -> if | |
| null (head forwards) -> gets snd >>= \fstate -> f fstate Nothing (x,y) (alterS . const) move | |
| otherwise -> gets snd >>= \fstate -> f fstate (Just (head (head forwards))) (x,y) (alterS . const) move | |
data Attempted = Down | LeftDown | RightDown deriving (Eq,Show) | |
type Position = (Int,Int) | |
type SolutionState = (Int,[Position],Attempted) | |
type PartialGrid = [[Int]] | |
solve beginAt grid = _a $ gridZipper grid beginAt sandify (0,[],Down) where | |
---sandify :: SolutionState | |
--- -> Maybe Int | |
--- -> Position | |
--- -> SolutionState | |
--- -> StateT ((Position, PartialGrid, PartialGrid), SolutionState) Data.Functor.Identity.Identity Int | |
--- -> w | |
--- -> Int | |
sandify :: (Integer, [(Int,Int)], Attempted) | |
-> Maybe Int | |
-> (Int, Int) | |
-> ((Integer, [(Int,Int)], Attempted) -> StateT (((Int, Int), [[(Int, Int)]], [[(Int, Int)]]), (Integer, [(Int, Int)], Attempted)) Identity ()) | |
-> ((Int, Int) | |
-> StateT | |
(((Int, Int), [[(Int,Int)]], [[(Int,Int)]]), (Integer, [(Int,Int)], Attempted)) | |
Identity | |
Integer) | |
-> StateT | |
(((Int, Int), [[(Int,Int)]], [[(Int,Int)]]), (Integer, [(Int,Int)], Attempted)) | |
Identity | |
Integer | |
sandify (count,_,_) Nothing _ _ _ = pure count | |
sandify (count,hist,at) current (x,y) swap move | |
| current == Just 1 || current == Just 2 = if | |
| at == Down -> do swap (count, tail hist, LeftDown) | |
move (bimap (-1) (+1) $ head $ tail hist) | |
| at == LeftDown -> do swap (count, tail hist, RightDown) | |
move (bimap (+1) (+1) $ head $ tail hist) | |
| at == RightDown -> do swap (count + 1, tail (tail hist), Down) | |
alterF (\(pos,b,f) -> (pos,focusMap 1 1 (const 2) b, f)) | |
move (head (tail hist)) | |
| otherwise = swap (count, ((x,y) : hist), at) >> move (x,y + 1) | |
prettyGrid = putStrLn . unlines . (map unwords) . map (map (\c -> if c == 1 then "#" else ".")) | |
main = do | |
(smallestX,grid) <- makeGrid <$> getInput :: IO (Int, [[Int]]) | |
print $ (solve (500 - smallestX,0) grid :: Integer) | |
pure () |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Main.hs:80:55: error: | |
• Couldn't match type ‘(Int, Int)’ with ‘Int’ | |
Expected: (Integer, [(Int, Int)], Attempted) | |
-> Maybe Int | |
-> (Int, Int) | |
-> ((Integer, [(Int, Int)], Attempted) | |
-> StateT | |
(((Int, Int), [[(Int, Int)]], [[(Int, Int)]]), | |
(Integer, [(Int, Int)], Attempted)) | |
Identity | |
()) | |
-> ((Int, Int) | |
-> StateT | |
(((Int, Int), [[Int]], [[Int]]), | |
(Integer, [(Int, Int)], Attempted)) | |
Identity | |
Integer) | |
-> StateT | |
(((Int, Int), [[Int]], [[Int]]), | |
(Integer, [(Int, Int)], Attempted)) | |
Identity | |
Integer | |
Actual: (Integer, [(Int, Int)], Attempted) | |
-> Maybe Int | |
-> (Int, Int) | |
-> ((Integer, [(Int, Int)], Attempted) | |
-> StateT | |
(((Int, Int), [[(Int, Int)]], [[(Int, Int)]]), | |
(Integer, [(Int, Int)], Attempted)) | |
Identity | |
()) | |
-> ((Int, Int) | |
-> StateT | |
(((Int, Int), [[(Int, Int)]], [[(Int, Int)]]), | |
(Integer, [(Int, Int)], Attempted)) | |
Identity | |
Integer) | |
-> StateT | |
(((Int, Int), [[(Int, Int)]], [[(Int, Int)]]), | |
(Integer, [(Int, Int)], Attempted)) | |
Identity | |
Integer | |
• In the third argument of ‘gridZipper’, namely ‘sandify’ | |
In the second argument of ‘($)’, namely | |
‘gridZipper grid beginAt sandify (0, [], Down)’ | |
In the expression: | |
_a $ gridZipper grid beginAt sandify (0, [], Down) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment