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!

I alwqys assumed you were Cameron Wu, who is?

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

Thank you for showing this trick, I knew Haskell was lazy but this one blew my mind again.

Haskell

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

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.

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 (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.

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

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

There probably are multiple ways to partition the graph. I haven't applied any optimizations and my program checks members of already detected groups again, would that yield all possible partitions because I choose all the possible starting points for a k-clique?

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

Thanks a lot for the recommendation, I did enjoy the read!

Some others have answered already, but yes, there was a well-hidden line in the problem description about the map having only a single path from start to end..

I was wondering about encryption (is this what you're talking about?) because these algorithms change so frequently I'd be surprised if they had anything back then considered 'secure' by now.

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