• 10 Posts
  • 73 Comments
Joined 1 year ago
cake
Cake day: May 9th, 2024

help-circle









  • Not the first year I participate but the first year I finished, 2021 was my all-time high so far with 42 stars when I was just starting oit and learning python. Knowing that there were more people in the same boat and that there was a competition kept me going, although the competiton also induced a lot of stress, not sure whether I want to keep the competitive attitude.

    Thanks to everyone for uploding solutions, Ideas and program stats, this kept me optimizing away, which was a lot of fun!



  • Haskell

    Have a nice christmas if you’re still celebrating today, otherwise hope you had a nice evening yesterday.

    import Control.Arrow
    import Control.Monad (join)
    import Data.Bifunctor (bimap)
    import qualified Data.List as List
    
    heights = List.transpose
            >>> List.map (pred . List.length . List.takeWhile (== '#'))
    
    parse = lines
            >>> init
            >>> List.groupBy (curry (snd >>> (/= "")))
            >>> List.map (List.filter (/= ""))
            >>> List.partition ((== "#####") . head)
            >>> second (List.map List.reverse)
            >>> join bimap (List.map heights)
    
    cartesianProduct xs ys = [(x, y) | x <- xs, y <- ys]
    
    part1 = uncurry cartesianProduct
            >>> List.map (uncurry (List.zipWith (+)))
            >>> List.filter (List.all (<6))
            >>> List.length
    part2 = const 0
    
    main = getContents
            >>= print
            . (part1 &&& part2)
            . parse
    


  • Haskell

    Part 1 was trivial, just apply the operations and delay certain ones until you have all the inputs you need.

    Code
    import Control.Arrow
    import Data.Bits
    import Numeric
    
    import qualified Data.Char as Char
    import qualified Data.List as List
    import qualified Data.Map as Map
    
    parse s = (Map.fromList inputs, equations)
            where
                    ls = lines s
                    inputs = map (take 3 &&& (== "1") . drop 5) . takeWhile (/= "") $ ls
                    equations = map words . filter (/= "") . tail . dropWhile (/= "") $ ls
    
    operations = Map.fromList
            [ ("AND", (&&))
            , ("XOR", xor)
            , ("OR", (||))
            ]
    
    solveEquations is []     = is
    solveEquations is (e:es)
            | is Map.!? input1 == Nothing = solveEquations is (es ++ [e])
            | is Map.!? input2 == Nothing = solveEquations is (es ++ [e])
            | otherwise      = solveEquations (Map.insert output (opfunc value1 value2) is) es
            where
                    value1 = is Map.! input1
                    value2 = is Map.! input2
                    opfunc = operations Map.! operation
                    (input1:operation:input2:_:output:[]) = e
    
    wireNumber prefix = List.filter ((prefix `List.isPrefixOf`) . fst)
            >>> flip zip [0..]
            >>> List.filter (snd . fst)
            >>> List.map ((2 ^ ). snd)
            >>> sum
    
    part1 = uncurry solveEquations
            >>> Map.toList
            >>> wireNumber "z"
    
    part2 (is, es) = List.intercalate "," . List.sort . words $ "z08 ffj dwp kfm z22 gjh jdr z31"
    
    main = getContents
            >>= print
            . (part1 &&& part2)
            . parse
    

    For part 2 I tried symbolic solving to detect discrepancies but I wouldn’t achieve anything with it.

    SymbolicEquation
    data SymbolicEquation = Single { eqName :: String }
            | Combine
            { eqName :: String
            , eqOperation :: String
            , eqLeft :: SymbolicEquation
            , eqRight :: SymbolicEquation
            }
            deriving (Eq)
    
    instance Show SymbolicEquation where
            show (Single name) = name
            show (Combine name op l r) = "(" ++ name ++ "= " ++ show l ++ " " ++ op ++ " " ++ show r ++ ")"
    
    symbolicSolve is [] = is
    symbolicSolve is (e:es)
            | is Map.!? input1 == Nothing = symbolicSolve is (es ++ [e])
            | is Map.!? input2 == Nothing = symbolicSolve is (es ++ [e])
            | otherwise = symbolicSolve (Map.insert output (Combine output operation value1 value2) is) es
            where
                    value1 = is Map.! input1
                    value2 = is Map.! input2
                    (input1:operation:input2:_:output:[]) = e
    

    My solution was to use the dotEngine-function to translate the operations into a digraph in graphviz-style which I simply plotted and searched through using a python script.

    dotEngine
    dotEngine (input1:operation:input2:_:output:[]) = [
              input1 ++ " -> " ++ output ++ " [ label=" ++ operation ++ "];"
            , input2 ++ " -> " ++ output ++ " [ label=" ++ operation ++ "];"
            ]
    

    I took a loook at the initial graph which was a vertical line with a few exception which I figured would be the misordered wires. I did try some hardware-simulations in the far past to build bit-adders which helped me recognize patterns like carry calculation. First I replaced all occurences of x__ XOR y__ -> w with x__ XOR y__ -> xor__ to recognize them more easily. The same with AND of xs and ys. Using the following script I would then use some Regex to search for the rules that corresponded to carry calculations or structures I knew. The script would break exactly four times and I would then figure out what to switch by hand through looking at the updated graphViz.

    Please excuse the bad coding style in the script, I had written it on the ipython-REPL.

    python script
    r = open("input").read()
    for i in range(2, 45):
        prevI = str(i - 1).zfill(2)
        I = str(i).zfill(2)
        forward = f"xor{I} AND carry{prevI} -> (\\w+)"
        backward = f"carry{prevI} AND xor{I} -> (\\w+)"
        m1 = re.search(forward, r)
        m2 = re.search(backward, r)
        if m1 is None and m2 is None:
            print(forward, backward)
            break
        m = m1 or m2
        r = r.replace(m.group(1), f"combinedCarry{I}")
        forward = f"and{I} OR combinedCarry{I} -> (\\w+)"
        backward = f"combinedCarry{I} OR and{I} -> (\\w+)"
        m1 = re.search(forward, r)
        m2 = re.search(backward, r)
        if m1 is None and m2 is None:
            print(forward, backward)
            break
        m = m1 or m2
        r = r.replace(m.group(1), f"carry{I}")
    open("input", "w").write()
    

    When solving such a swapped wire problem I would then use my haskell function to plot it out again and stare at it for a few minutes until I understood wich parts belonged where.

    The last one looked like this
    GraphViz of the last set of problem wires

    In this one I needed to switch jdr and carry31 to make it work.



  • Haskell

    The solution for part two could now be used for part one as well but then I would have to rewrite part 1 .-.

    import Control.Arrow
    
    import Data.Ord (comparing)
    
    import qualified Data.List as List
    import qualified Data.Map as Map
    import qualified Data.Set as Set
    
    parse = Map.fromListWith Set.union . List.map (second Set.singleton) . uncurry (++) . (id &&& List.map (uncurry (flip (,)))) . map (break (== '-') >>> second (drop 1)) . takeWhile (/= "") . lines
    
    depthSearch connections ps
            | length ps == 4 && head ps == last ps = [ps]
            | length ps == 4 = []
            | otherwise  = head
                    >>> (connections Map.!)
                    >>> Set.toList
                    >>> List.map (:ps)
                    >>> List.concatMap (depthSearch connections)
                    $ ps
    
    interconnections (computer, connections) = depthSearch connections [computer]
    
    part1 = (Map.assocs &&& repeat)
            >>> first (List.map (uncurry Set.insert))
            >>> first (Set.toList . Set.unions)
            >>> uncurry zip
            >>> List.concatMap interconnections
            >>> List.map (Set.fromList . take 3)
            >>> List.filter (Set.fold (List.head >>> (== 't') >>> (||)) False)
            >>> Set.fromList
            >>> Set.size
    
    getLANParty computer connections = (connections Map.!)
            >>> findLanPartyComponent connections [computer]
            $ computer
    
    filterCandidates connections participants candidates = List.map (connections Map.!)
            >>> List.foldl Set.intersection candidates
            >>> Set.filter ((connections Map.!) >>> \ s -> List.all (flip Set.member s) participants)
            $ participants
    
    findLanPartyComponent connections participants candidates
            | Set.null validParticipants = participants
            | otherwise = findLanPartyComponent connections (nextParticipant : participants) (Set.delete nextParticipant candidates)
            where
                    nextParticipant = Set.findMin validParticipants
                    validParticipants = filterCandidates connections participants candidates
    
    part2 = (Map.keys &&& repeat)
            >>> uncurry zip
            >>> List.map ((uncurry getLANParty) >>> List.sort)
            >>> List.nub
            >>> List.maximumBy (comparing List.length)
            >>> List.intercalate ","
    
    main = getContents
            >>= print
            . (part1 &&& part2)
            . parse
    

  • Haskell

    I have no Idea how to optimize this and am looking forward to the other solutions that probably run in sub-single-second times. I like my solution because it was simple to write which I hadn’t managed in the previous days, runs in 17 seconds with no less than 100MB of RAM.

    import Control.Arrow
    import Data.Bits (xor)
    import Data.Ord (comparing)
    
    import qualified Data.List as List
    import qualified Data.Map as Map
    
    parse :: String -> [Int]
    parse = map read . filter (/= "") . lines
    
    mix = xor 
    prune = flip mod 16777216
    priceof = flip mod 10
    
    nextSecret step0 = do
            let step1 = prune . mix step0 $ step0 * 64
            let step2 = prune . mix step1 $ step1 `div` 32
            let step3 = prune . mix step2 $ step2 * 2048
            step3
    
    part1 = sum . map (head . drop 2000 . iterate nextSecret)
    part2 = map (iterate nextSecret
                    >>> take 2001
                    >>> map priceof
                    >>> (id &&& tail)
                    >>> uncurry (zipWith (curry (uncurry (flip (-)) &&& snd)))
                    >>> map (take 4) . List.tails
                    >>> filter ((==4) . length)
                    >>> map (List.map fst &&& snd . List.last)
                    >>> List.foldl (\ m (s, p) -> Map.insertWith (flip const) s p m) Map.empty
                    )
            >>> Map.unionsWith (+)
            >>> Map.assocs
            >>> List.maximumBy (comparing snd)
    
    main = getContents
            >>= print
            . (part1 &&& part2)
            . parse
    





  • Haskell

    First parse and floodfill from start, each position then holds the distance from the start

    For part 1, I check all neighbor tiles of neighbor tiles that are walls and calculate the distance that would’ve been in-between.

    In part 2 I check all tiles within a manhattan distance <= 20 and calculate the distance in-between on the path. Then filter out all cheats <100 and count

    Takes 1.4s sadly, I believe there is still potential for optimization.

    Edit: coding style

    import Control.Arrow
    
    import qualified Data.List as List
    import qualified Data.Set as Set
    import qualified Data.Map as Map
    import qualified Data.Maybe as Maybe
    
    parse s = Map.fromList [ ((y, x), c) | (l, y) <- zip ls [0..], (c, x) <- zip l [0..]]
            where
            ls = lines s
    
    floodFill m = floodFill' m startPosition (Map.singleton startPosition 0)
            where
                    startPosition = Map.assocs
                            >>> filter ((== 'S') . snd)
                            >>> head
                            >>> fst
                            $ m
    
    neighbors (p1, p2) = [(p1-1, p2), (p1, p2-1), (p1, p2+1), (p1+1, p2)]
    
    floodFill' m p f
            | m Map.! p == 'E' = f
            | otherwise = floodFill' m n f'
            where
                    seconds = f Map.! p
                    ns = neighbors p
                    n = List.filter ((m Map.!) >>> (`Set.member` (Set.fromList ".E")))
                            >>> List.filter ((f Map.!?) >>> Maybe.isNothing)
                            >>> head
                            $ ns
                    f' = Map.insert n (succ seconds) f
    
    taxiCabDistance (a1, a2) (b1, b2) = abs (a1 - b1) + abs (a2 - b2)
    
    calculateCheatAdvantage f (p1, p2) = c2 - c1 - taxiCabDistance p1 p2
            where
                    c1 = f Map.! p1
                    c2 = f Map.! p2
    
    cheatDeltas :: Int -> Int -> [(Int, Int)]
    cheatDeltas l h = [(y, x) | x <- [-h..h], y <- [-h..h], let d = abs x + abs y, d <= h, d >= l]
    
    (a1, a2) .+. (b1, b2) = (a1 + b1, a2 + b2)
    
    solve l h (f, ps) = Set.toList
            >>> List.map ( repeat
                    >>> zip (cheatDeltas l h)
                    >>> List.map (snd &&& uncurry (.+.))
                    >>> List.filter (snd >>> (`Set.member` ps))
                    >>> List.map (calculateCheatAdvantage f)
                    >>> List.filter (>= 100)
                    >>> List.length
                    )
            >>> List.sum
            $ ps
    part1 = solve 2 2
    part2 = solve 1 20
    
    main = getContents
            >>= print
            . (part1 &&& part2)
            . (id &&& Map.keysSet)
            . floodFill
            . parse
    

  • Haskell

    I had several strategy switches from brute-force to pathfinding (when doing part1 input instead of example) because It simply wouldn’t finish. My solution only found the first path to the design, which is why I rewrote to only count how many towels there are for each prefix I have already built. Do that until there is either only one entry with the total combinations count or no entry and it’s impossible to build the design.

    I like the final solution, its small (unlike my other solutions) and runs fast.

    🚀
    import Control.Arrow
    
    import Data.Map (Map)
    
    import qualified Data.List as List
    import qualified Data.Map as Map
    
    parse :: String -> ([String], [String])
    parse = lines . init
            >>> (map (takeWhile (/= ',')) . words . head &&& drop 2)
    
    countDesignPaths :: [String] -> String -> Map Int Int -> Int
    countDesignPaths ts d es
            | Map.null es    = 0
            | ml == length d = mc
            | otherwise = countDesignPaths ts d es''
            where
                    ((ml, mc), es') = Map.deleteFindMin es
                    ns = List.filter (flip List.isPrefixOf (List.drop ml d))
                            >>> List.map length
                            >>> List.map (ml +)
                            $ ts
                    es'' = List.foldl (\ m l' -> Map.insertWith (+) l' mc m) es'
                            $ ns
    solve (ts, ds) = List.map (flip (countDesignPaths ts) (Map.singleton 0 1))
            >>> (List.length . List.filter (/= 0) &&& List.sum)
            $ ds
    
    main = getContents
            >>= print
            . solve
            . parse