Compare commits
No commits in common. "366ad5e80a5f3fe446c5404bbad11eb1745539c2" and "d6739d00f6802ef56e338127629ca1c44e68d21a" have entirely different histories.
366ad5e80a
...
d6739d00f6
10
11/input.txt
10
11/input.txt
|
@ -1,10 +0,0 @@
|
||||||
5421451741
|
|
||||||
3877321568
|
|
||||||
7583273864
|
|
||||||
3451717778
|
|
||||||
2651615156
|
|
||||||
6377167526
|
|
||||||
5182852831
|
|
||||||
4766856676
|
|
||||||
3437187583
|
|
||||||
3633371586
|
|
|
@ -1,93 +0,0 @@
|
||||||
import Data.Char (digitToInt)
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = do
|
|
||||||
input <- getContents
|
|
||||||
let
|
|
||||||
octopodes = (map (map digitToInt) . lines) input
|
|
||||||
(putStrLn . show . solution1) octopodes
|
|
||||||
(putStrLn . show . solution2) octopodes
|
|
||||||
|
|
||||||
solution1 :: [[Int]] -> Int
|
|
||||||
solution1 m = snd (iterate flashSimulate (m, 0) !! 100)
|
|
||||||
|
|
||||||
solution2 :: [[Int]] -> Int
|
|
||||||
solution2 m = countUntil (all (all (==0)) . fst) flashSimulate (m, 0)
|
|
||||||
|
|
||||||
flashSimulate :: ([[Int]], Int) -> ([[Int]], Int)
|
|
||||||
flashSimulate (octopodes, flashes) =
|
|
||||||
(refreshOctopodes exhaustedOctopodes, flashes + countExhaustedOctopodes exhaustedOctopodes)
|
|
||||||
where
|
|
||||||
exhaustedOctopodes = flashStep octopodes
|
|
||||||
countExhaustedOctopodes = foldr (\l a -> length l + a) 0 . map (filter (> 9))
|
|
||||||
refreshOctopodes = map (map (\o -> if o > 9 then 0 else o))
|
|
||||||
|
|
||||||
flashStep :: [[Int]] -> [[Int]]
|
|
||||||
flashStep = propagateFlashes . map (map (+1))
|
|
||||||
where
|
|
||||||
propagateFlashes :: [[Int]] -> [[Int]]
|
|
||||||
propagateFlashes = until allExhausted flashOctopi
|
|
||||||
where
|
|
||||||
allExhausted :: [[Int]] -> Bool
|
|
||||||
allExhausted = all (all (/= 10))
|
|
||||||
flashOctopi :: [[Int]] -> [[Int]]
|
|
||||||
flashOctopi m = map (map (incrementFlashing m))
|
|
||||||
[[(x, y) | y <- [0..length (m !! x) - 1]] | x <- [0..length m - 1]]
|
|
||||||
where
|
|
||||||
incrementFlashing ::[[Int]] -> (Int, Int) -> Int
|
|
||||||
incrementFlashing m' o
|
|
||||||
| charge < 10 && newCharge > 10 = 10 -- Ensure we don't miss an increment
|
|
||||||
| otherwise = charge + numFlashingNeighbors o
|
|
||||||
where
|
|
||||||
newCharge = charge + numFlashingNeighbors o
|
|
||||||
charge = m' !!! o
|
|
||||||
numFlashingNeighbors :: (Int, Int) -> Int
|
|
||||||
numFlashingNeighbors = length . filter (\o -> (m !!! o) == 10) . (flip adjacent m)
|
|
||||||
|
|
||||||
(!!!) :: [[Int]] -> (Int, Int) -> Int
|
|
||||||
(!!!) m index = m !! (fst index) !! (snd index)
|
|
||||||
|
|
||||||
countUntil :: (a -> Bool) -> (a -> a) -> a -> Int
|
|
||||||
countUntil p f = call
|
|
||||||
where
|
|
||||||
call x
|
|
||||||
| p x = 0
|
|
||||||
| otherwise = call (f x) + 1
|
|
||||||
|
|
||||||
adjacent :: (Int, Int) -> [[Int]] -> [(Int, Int)]
|
|
||||||
adjacent (x, y) m = [(x+i, y+j) |
|
|
||||||
i <- [-1..1],
|
|
||||||
j <- [-1..1],
|
|
||||||
-- (i, j) /= (0, 0),
|
|
||||||
x+i >= 0,
|
|
||||||
y+j >= 0,
|
|
||||||
x+i < length m,
|
|
||||||
y+j < length (m !! 0)]
|
|
||||||
|
|
||||||
-- Tests
|
|
||||||
|
|
||||||
testInput1 = [
|
|
||||||
"5483143223",
|
|
||||||
"2745854711",
|
|
||||||
"5264556173",
|
|
||||||
"6141336146",
|
|
||||||
"6357385478",
|
|
||||||
"4167524645",
|
|
||||||
"2176841721",
|
|
||||||
"6882881134",
|
|
||||||
"4846848554",
|
|
||||||
"5283751526"
|
|
||||||
]
|
|
||||||
parsedTestInput1 = map (map digitToInt) testInput1
|
|
||||||
|
|
||||||
testInput2 = [
|
|
||||||
"11111",
|
|
||||||
"19991",
|
|
||||||
"19191",
|
|
||||||
"19991",
|
|
||||||
"11111"
|
|
||||||
]
|
|
||||||
parsedTestInput2 = map (map digitToInt) testInput2
|
|
||||||
|
|
||||||
test1 = solution1 parsedTestInput1
|
|
||||||
test2 = solution2 parsedTestInput1
|
|
|
@ -1,23 +0,0 @@
|
||||||
module Parsing (
|
|
||||||
splitByString
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Data.List (isPrefixOf)
|
|
||||||
|
|
||||||
splitByString :: String -> String -> [String]
|
|
||||||
splitByString _ "" = []
|
|
||||||
splitByString splitter string =
|
|
||||||
let (chunk, rest) = spanNextSplit string
|
|
||||||
in
|
|
||||||
chunk:(splitByString splitter rest)
|
|
||||||
where
|
|
||||||
spanNextSplit :: String -> (String, String)
|
|
||||||
spanNextSplit [] = ([], [])
|
|
||||||
spanNextSplit everything@(char:rest)
|
|
||||||
| splitter `isPrefixOf` rest =
|
|
||||||
([char], (drop ((length splitter) + 1) everything))
|
|
||||||
| otherwise =
|
|
||||||
let
|
|
||||||
(start, end) = spanNextSplit rest
|
|
||||||
in
|
|
||||||
(char:start, end)
|
|
|
@ -1,123 +0,0 @@
|
||||||
import Data.Char (isLower)
|
|
||||||
import qualified Data.Map.Strict as Map
|
|
||||||
import qualified Data.Set as Set
|
|
||||||
import Debug.Trace (traceShow, traceShowId)
|
|
||||||
import Parsing (splitByString)
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = do
|
|
||||||
input <- getContents
|
|
||||||
let
|
|
||||||
caves = parseCaves input
|
|
||||||
(putStrLn . show . solution1) caves
|
|
||||||
(putStrLn . show . solution2) caves
|
|
||||||
|
|
||||||
solution1 :: Map.Map String [String] -> Int
|
|
||||||
solution1 = length . cavePaths
|
|
||||||
|
|
||||||
solution2 :: Map.Map String [String] -> Int
|
|
||||||
solution2 = length . cavePaths2
|
|
||||||
|
|
||||||
parseCaves :: String -> Map.Map String [String]
|
|
||||||
parseCaves = Map.fromListWith (++) . flatmap addReverse . map tupleFromList . map (splitByString "-") . lines
|
|
||||||
where
|
|
||||||
addReverse :: (String, [String]) -> [(String, [String])]
|
|
||||||
addReverse t@(a, b) = [t, (head b, [a])]
|
|
||||||
tupleFromList :: [String] -> (String, [String])
|
|
||||||
tupleFromList [] = undefined
|
|
||||||
tupleFromList (x:xs)
|
|
||||||
-- Since the second part is always expected to be a cave label
|
|
||||||
-- or "end", this should never be > 1
|
|
||||||
| length xs > 1 = undefined
|
|
||||||
| otherwise = (x, xs)
|
|
||||||
|
|
||||||
cavePaths :: Map.Map String [String] -> [[String]]
|
|
||||||
cavePaths caveMap = followSingle caveMap Set.empty "start"
|
|
||||||
|
|
||||||
cavePaths2 :: Map.Map String [String] -> [[String]]
|
|
||||||
cavePaths2 caveMap = followOneRepeat caveMap Set.empty "start"
|
|
||||||
|
|
||||||
followSingle :: Map.Map String [String] -> Set.Set String -> String -> [[String]]
|
|
||||||
followSingle caveMap visited node
|
|
||||||
| node == "end" = [[node]]
|
|
||||||
| otherwise =
|
|
||||||
let
|
|
||||||
v' = Set.insert node visited
|
|
||||||
in
|
|
||||||
map ((:) node) (flatmap (followSingle caveMap v') adjacent)
|
|
||||||
where
|
|
||||||
adjacent :: [String]
|
|
||||||
adjacent = filter (not . visitedSmall) (Map.findWithDefault [] node caveMap)
|
|
||||||
visitedSmall :: String -> Bool
|
|
||||||
visitedSmall n = all isLower n && n `elem` visited
|
|
||||||
|
|
||||||
followOneRepeat :: Map.Map String [String] -> Set.Set String -> String -> [[String]]
|
|
||||||
followOneRepeat caveMap visited node
|
|
||||||
| node == "end" = [[node]]
|
|
||||||
| all isLower node && node `elem` visited =
|
|
||||||
followSingle caveMap visited node
|
|
||||||
| otherwise =
|
|
||||||
let
|
|
||||||
v' = Set.insert node visited
|
|
||||||
in
|
|
||||||
map ((:) node) (flatmap (followOneRepeat caveMap v') adjacent)
|
|
||||||
where
|
|
||||||
adjacent :: [String]
|
|
||||||
adjacent = filter (/= "start") (Map.findWithDefault [] node caveMap)
|
|
||||||
|
|
||||||
flatmap :: (t -> [a]) -> [t] -> [a]
|
|
||||||
flatmap _ [] = []
|
|
||||||
flatmap f (x:xs) = f x ++ flatmap f xs
|
|
||||||
|
|
||||||
-- Tests
|
|
||||||
|
|
||||||
testInput1 = unlines [
|
|
||||||
"start-A",
|
|
||||||
"start-b",
|
|
||||||
"A-c",
|
|
||||||
"A-b",
|
|
||||||
"b-d",
|
|
||||||
"A-end",
|
|
||||||
"b-end"
|
|
||||||
]
|
|
||||||
|
|
||||||
testInput2 = unlines [
|
|
||||||
"dc-end",
|
|
||||||
"HN-start",
|
|
||||||
"start-kj",
|
|
||||||
"dc-start",
|
|
||||||
"dc-HN",
|
|
||||||
"LN-dc",
|
|
||||||
"HN-end",
|
|
||||||
"kj-sa",
|
|
||||||
"kj-HN",
|
|
||||||
"kj-dc"]
|
|
||||||
|
|
||||||
testInput3 = unlines [
|
|
||||||
"fs-end",
|
|
||||||
"he-DX",
|
|
||||||
"fs-he",
|
|
||||||
"start-DX",
|
|
||||||
"pj-DX",
|
|
||||||
"end-zg",
|
|
||||||
"zg-sl",
|
|
||||||
"zg-pj",
|
|
||||||
"pj-he",
|
|
||||||
"RW-he",
|
|
||||||
"fs-DX",
|
|
||||||
"pj-RW",
|
|
||||||
"zg-RW",
|
|
||||||
"start-pj",
|
|
||||||
"he-WI",
|
|
||||||
"zg-he",
|
|
||||||
"pj-fs",
|
|
||||||
"start-RW"]
|
|
||||||
|
|
||||||
parsedTestInput1 = parseCaves testInput1
|
|
||||||
test1 = cavePaths parsedTestInput1
|
|
||||||
test2 = cavePaths2 parsedTestInput1
|
|
||||||
test3 = cavePaths2 (parseCaves testInput2)
|
|
||||||
test4 = cavePaths2 (parseCaves testInput3)
|
|
||||||
|
|
||||||
printPaths :: [[String]] -> IO ()
|
|
||||||
printPaths = putStr . unlines . (map (foldr1 (\c a -> c++"->"++a)))
|
|
24
12/input.txt
24
12/input.txt
|
@ -1,24 +0,0 @@
|
||||||
yb-pi
|
|
||||||
jg-ej
|
|
||||||
yb-KN
|
|
||||||
LD-start
|
|
||||||
end-UF
|
|
||||||
UF-yb
|
|
||||||
yb-xd
|
|
||||||
qx-yb
|
|
||||||
xd-end
|
|
||||||
jg-KN
|
|
||||||
start-qx
|
|
||||||
start-ej
|
|
||||||
qx-LD
|
|
||||||
jg-LD
|
|
||||||
xd-LD
|
|
||||||
ej-qx
|
|
||||||
end-KN
|
|
||||||
DM-xd
|
|
||||||
jg-yb
|
|
||||||
ej-LD
|
|
||||||
qx-UF
|
|
||||||
UF-jg
|
|
||||||
qx-jg
|
|
||||||
xd-UF
|
|
Loading…
Reference in a new issue