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
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.
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
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.
I mean the Voyager 1 probe which is currently the human-made object the farthest away from earth. The space program people operating the mission seem to have great control options, they even "moved software from one chip to another" (link) Apart from the probably gigantic and expensive installation needed to receive and/or send messages from/to that far away from home (23 hours of delay?), are there any safety measures to prevent a potentially malicous actor from sending commands to the probe?
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
Haskell
Wasn't there a pathfinding problem just recently?
Edit: Optimization to avoid recalculating paths all the time
Haskell with lambdas
import Control.Arrow
import Control.Monad
import Data.Bifunctor hiding (first, second)
import Data.Set (Set)
import Data.Map (Map)
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 :: String -> [(Int, Int)]
parse = map (join bimap read) . map (break (== ',') >>> second (drop 1)) . filter (/= "") . lines
lowerBounds = (0, 0)
exitPosition = (70, 70)
initialBytes = 1024
adjacent (py, px) = Set.fromDistinctAscList [(py-1, px), (py, px-1), (py, px+1), (py+1, px)]
data Cost = Wall | Explored Int
deriving (Show, Eq)
inBounds (py, px)
| py < 0 = False
| px < 0 = False
| py > fst exitPosition = False
| px > snd exitPosition = False
| otherwise = True
dijkstra :: Map Int (Set (Int, Int)) -> Map (Int, Int) Cost -> (Int, (Int, Int), Map (Int, Int) Cost)
dijkstra queue walls
| Map.null queue = (-1, (-1, -1), Map.empty)
| minPos == exitPosition = (minKey, minPos, walls)
| Maybe.isJust (walls Map.!? minPos) = dijkstra remainingQueue' walls
| not . inBounds $ minPos = dijkstra remainingQueue' walls
| otherwise = dijkstra neighborQueue updatedWalls
where
((minKey, posSet), remainingQueue) = Maybe.fromJust . Map.minViewWithKey $ queue
(minPos, remainingPosSet) = Maybe.fromJust . Set.minView $ posSet
remainingQueue' = if not . Set.null $ remainingPosSet then Map.insert minKey remainingPosSet remainingQueue else remainingQueue
neighborQueue = List.foldl (\ m n -> Map.insertWith (Set.union) neighborKey (Set.singleton n) m) remainingQueue' neighbors
updatedWalls = Map.insert minPos (Explored minKey) walls
neighborKey = minKey + 1
neighbors = adjacent minPos
isExplored :: Cost -> Bool
isExplored Wall = False
isExplored (Explored _) = True
findPath :: Int -> (Int, Int) -> Map (Int, Int) Cost -> [(Int, Int)]
findPath n p ts
| p == lowerBounds = [lowerBounds]
| n == 0 = error "Out of steps when tracing backwards"
| List.null neighbors = error "No matching neighbors when tracing backwards"
| otherwise = p : findPath (pred n) (fst . head $ neighbors) ts
where
neighbors = List.filter ((== Explored (pred n)) . snd) . List.filter (isExplored . snd) . List.map (join (,) >>> second (ts Map.!)) . List.filter inBounds . Set.toList . adjacent $ p
runDijkstra = flip zip (repeat Wall)
>>> Map.fromList
>>> dijkstra (Map.singleton 0 (Set.singleton lowerBounds))
fst3 :: (a, b, c) -> a
fst3 (a, _, _) = a
thrd :: (a, b, c) -> c
thrd (_, _, c) = c
part1 = take initialBytes
>>> runDijkstra
>>> \ (n, _, _) -> n
firstFailing :: [(Int, Int)] -> [[(Int, Int)]] -> (Int, Int)
firstFailing path (bs:bss)
| List.last bs `List.notElem` path = firstFailing path bss
| c == (-1) = List.last bs
| otherwise = firstFailing (findPath c p ts) bss
where
(c, p, ts) = runDijkstra bs
part2 bs = repeat
>>> zip [initialBytes..length bs]
>>> map (uncurry take)
>>> firstFailing path
$ bs
where
(n, p, ts) = runDijkstra . take 1024 $ bs
path = findPath n p ts
main = getContents
>>= print
. (part1 &&& part2)
. parse
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.
Solution Codeblock
import Control.Arrow
import Data.Bits
import qualified Data.Char as Char
import qualified Data.List as List
replace c r c' = if c' == c then r else c'
parse :: String -> ([Integer], [Int])
parse = map (replace ',' ' ')
>>> filter ((Char.isDigit &&& Char.isSpace) >>> uncurry (||))
>>> words
>>> splitAt 3
>>> (map read *** map read)
type InstructionPointer = Int
adv = 0
bxl = 1
bst = 2
jnz = 3
bxc = 4
out = 5
bdv = 6
cdv = 7
lookupCombo _ 0 = 0
lookupCombo _ 1 = 1
lookupCombo _ 2 = 2
lookupCombo _ 3 = 3
lookupCombo regs 4 = regs !! 0
lookupCombo regs 5 = regs !! 1
lookupCombo regs 6 = regs !! 2
lookupCombo regs 7 = error "Invalid operand"
execute :: InstructionPointer -> [Integer] -> [Int] -> [Int]
execute ip regs@(regA:regB:regC:[]) ops
| ip >= length ops = []
| instruction == adv = execute (ip + 2) [regA `div` (2 ^ comboValue), regB, regC] ops
| instruction == bxl = execute (ip + 2) [regA, xor regB (toInteger operand), regC] ops
| instruction == bst = execute (ip + 2) [regA, comboValue `mod` 8, regC] ops
| instruction == jnz && regA == 0 = execute (ip + 2) regs ops
| instruction == jnz && regA /= 0 = execute operand regs ops
| instruction == bxc = execute (ip + 2) [regA, xor regB regC, regC] ops
| instruction == out = (fromIntegral comboValue) `mod` 8 : execute (ip + 2) regs ops
| instruction == bdv = execute (ip + 2) [regA, regA `div` (2 ^ comboValue), regC] ops
| instruction == cdv = execute (ip + 2) [regA, regB, regA `div` (2 ^ comboValue)] ops
where
(instruction, operand) = (ops !! ip, ops !! (succ ip))
comboValue = lookupCombo regs operand
part1 = uncurry (execute 0)
>>> List.map show
>>> List.intercalate ","
valid i t n = ((n `div` (8^i)) `mod` 8) `xor` 7 `xor` (n `div` (4*(8^i))) == t
part2 = const 247839653009594
main = getContents
>>= print
. (part1 &&& part2)
. parse
```haskell
Haskell
This one was surprisingly slow to run
Big codeblock
import Control.Arrow
import Data.Map (Map)
import Data.Set (Set)
import Data.Array.ST (STArray)
import Data.Array (Array)
import Control.Monad.ST (ST, runST)
import qualified Data.Char as Char
import qualified Data.List as List
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Array.ST as MutableArray
import qualified Data.Array as Array
import qualified Data.Maybe as Maybe
data Direction = East | West | South | North
deriving (Show, Eq, Ord)
data MazeTile = Start | End | Wall | Unknown | Explored (Map Direction ExplorationScore)
deriving Eq
-- instance Show MazeTile where
-- show Wall = "#"
-- show Start = "S"
-- show End = "E"
-- show Unknown = "."
-- show (Explored (East, _)) = ">"
-- show (Explored (South, _)) = "v"
-- show (Explored (West, _)) = "<"
-- show (Explored (North, _)) = "^"
type Position = (Int, Int)
type ExplorationScore = Int
translate '#' = Wall
translate '.' = Unknown
translate 'S' = Start
translate 'E' = End
parse :: String -> Array (Int, Int) MazeTile
parse s = Array.listArray ((1, 1), (height - 1, width)) . map translate . filter (/= '\n') $ s
where
width = length . takeWhile (/= '\n') $ s
height = length . filter (== '\n') $ s
(a1, b1) .+. (a2, b2) = (a1+a2, b1+b2)
(a1, b1) .-. (a2, b2) = (a1-a2, b1-b2)
directions = [East, West, South, North]
directionVector East = (0, 1)
directionVector West = (0, -1)
directionVector North = (-1, 0)
directionVector South = ( 1, 0)
turnRight East = South
turnRight South = West
turnRight West = North
turnRight North = East
walkableNeighbors a p = do
let neighbors = List.map ((.+. p) . directionVector) directions
tiles <- mapM (MutableArray.readArray a) neighbors
let neighborPosition = List.map fst . List.filter ((/= Wall). snd) . zip neighbors $ tiles
return $ neighborPosition
findDeadEnds a = Array.assocs
>>> List.filter (snd >>> (== Unknown))
>>> List.map (fst)
>>> List.filter (isDeadEnd a)
$ a
isDeadEnd a p = List.map directionVector
>>> List.map (.+. p)
>>> List.map (a Array.!)
>>> List.filter (/= Wall)
>>> List.length
>>> (== 1)
$ directions
fillDeadEnds :: Array (Int, Int) MazeTile -> ST s (Array (Int, Int) MazeTile)
fillDeadEnds a = do
ma <- MutableArray.thaw a
let deadEnds = findDeadEnds a
mapM_ (fillDeadEnd ma) deadEnds
MutableArray.freeze ma
fillDeadEnd :: STArray s (Int, Int) MazeTile -> Position -> ST s ()
fillDeadEnd a p = do
MutableArray.writeArray a p Wall
p' <- walkableNeighbors a p >>= return . head
t <- MutableArray.readArray a p'
n <- walkableNeighbors a p' >>= return . List.length
if n == 1 && t == Unknown then fillDeadEnd a p' else return ()
thawArray :: Array (Int, Int) MazeTile -> ST s (STArray s (Int, Int) MazeTile)
thawArray a = do
a' <- MutableArray.thaw a
return a'
solveMaze a = do
a' <- fillDeadEnds a
a'' <- thawArray a'
let s = Array.assocs
>>> List.filter ((== Start) . snd)
>>> Maybe.listToMaybe
>>> Maybe.maybe (error "Start not in map") fst
$ a
let e = Array.assocs
>>> List.filter ((== End) . snd)
>>> Maybe.listToMaybe
>>> Maybe.maybe (error "End not in map") fst
$ a
MutableArray.writeArray a'' s $ Explored (Map.singleton East 0)
MutableArray.writeArray a'' e $ Unknown
solveMaze' (s, East) a''
fa <- MutableArray.freeze a''
t <- MutableArray.readArray a'' e
case t of
Wall -> error "Unreachable code"
Start -> error "Unreachable code"
End -> error "Unreachable code"
Unknown -> error "End was not explored yet"
Explored m -> return (List.minimum . List.map snd . Map.toList $ m, countTiles fa s e)
countTiles a s p = Set.size . countTiles' a s p $ South
countTiles' :: Array (Int, Int) MazeTile -> Position -> Position -> Direction -> Set Position
countTiles' a s p d
| p == s = Set.singleton p
| otherwise = Set.unions
. List.map (Set.insert p)
. List.map (uncurry (countTiles' a s))
$ (zip minCostNeighbors minCostDirections)
where
minCostNeighbors = List.map ((p .-.) . directionVector) minCostDirections
minCostDirections = List.map fst . List.filter ((== minCost) . snd) . Map.toList $ visits
visits = case a Array.! p of
Explored m -> Map.adjust (+ (-1000)) d m
minCost = List.minimum . List.map snd . Map.toList $ visits
maybeExplore c p d a = do
t <- MutableArray.readArray a p
case t of
Wall -> return ()
Start -> error "Unreachable code"
End -> error "Unreachable code"
Unknown -> do
MutableArray.writeArray a p $ Explored (Map.singleton d c)
solveMaze' (p, d) a
Explored m -> do
let c' = Maybe.maybe c id (m Map.!? d)
if c <= c' then do
let m' = Map.insert d c m
MutableArray.writeArray a p (Explored m')
solveMaze' (p, d) a
else
return ()
solveMaze' :: (Position, Direction) -> STArray s (Int, Int) MazeTile -> ST s ()
solveMaze' s@(p, d) a = do
t <- MutableArray.readArray a p
case t of
Wall -> return ()
Start -> error "Unreachable code"
End -> error "Unreachable code"
Unknown -> error "Starting on unexplored field"
Explored m -> do
let c = m Map.! d
maybeExplore (c+1) (p .+. directionVector d) d a
let d' = turnRight d
maybeExplore (c+1001) (p .+. directionVector d') d' a
let d'' = turnRight d'
maybeExplore (c+1001) (p .+. directionVector d'') d'' a
let d''' = turnRight d''
maybeExplore (c+1001) (p .+. directionVector d''') d''' a
part1 a = runST (solveMaze a)
main = getContents
>>= print
. part1
. parse
Haskell
I solved part two interactively, I'm not very happy about it
Reveal Code
import Control.Arrow
import Data.Bifunctor hiding (first, second)
import Control.Monad
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 :: String -> [((Int, Int), (Int, Int))]
parse = map (break (== ' ') >>> second (drop 1) >>> join bimap (drop 2) >>> join bimap (break (== ',')) >>> join bimap (second (drop 1)) >>> join bimap (join bimap read)) . filter (/= "") . lines
moveRobot ((px, py), (vx, vy)) t = (px + t * vx, py + t * vy)
constrainCoordinates (mx, my) (px, py) = (px `mod` mx, py `mod` my)
coordinateConstraints = (101, 103)
robotQuadrant (mx, my) (px, py)
| px > middleX && py < middleY = Just 1 -- upper right
| px > middleX && py > middleY = Just 2 -- lower right
| px < middleX && py > middleY = Just 3 -- lower left
| px < middleX && py < middleY = Just 4 -- upper left
| otherwise = Nothing
where
middleX = (mx `div` 2)
middleY = (my `div` 2)
countQuadrants (q1, q2, q3, q4) 1 = (succ q1, q2, q3, q4)
countQuadrants (q1, q2, q3, q4) 2 = (q1, succ q2, q3, q4)
countQuadrants (q1, q2, q3, q4) 3 = (q1, q2, succ q3, q4)
countQuadrants (q1, q2, q3, q4) 4 = (q1, q2, q3, succ q4)
part1 = map (flip moveRobot 100 >>> constrainCoordinates coordinateConstraints)
>>> map (robotQuadrant coordinateConstraints)
>>> Maybe.catMaybes
>>> foldl (countQuadrants) (0, 0, 0, 0)
>>> \ (a, b, c, d) -> a * b * c * d
showMaybe (Just i) = head . show $ i
showMaybe Nothing = ' '
buildRobotString robotMap = [ [ showMaybe (robotMap Map.!? (x, y)) | x <- [0..fst coordinateConstraints] ] | y <- [0..snd coordinateConstraints]]
part2 rs t = map (flip moveRobot t >>> constrainCoordinates coordinateConstraints)
>>> flip zip (repeat 1)
>>> Map.fromListWith (+)
>>> buildRobotString
$ rs
showConstellation (i, s) = do
putStrLn (replicate 49 '#' ++ show i ++ replicate 49 '#')
putStrLn $ s
main = do
f <- getContents
let i = parse f
print $ part1 i
let constellations = map (id &&& (part2 i >>> List.intercalate "\n")) . filter ((== 86) . (`mod` 103)) $ [0..1000000]
mapM_ showConstellation constellations
print 7502
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.
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.
Up until now I simply used Element, it just works and it doesn't look too bad. Unfortunately, I now have two Matrix accounts, my personal account and the account my university automatically created on their own matrix instance. I need to communicate using both my accounts now, but Element couldn't handle two accounts at the same time, so I went on to install a second client, Fractal, which also supports multiple accounts. However, I am somewhat unhappy with Fractal because I cannot select text in messages.
Please share your experiences and recommendations with or on matrix clients.