diff --git a/11/solution b/11/solution new file mode 100755 index 0000000..41facb5 Binary files /dev/null and b/11/solution differ diff --git a/11/solution.hi b/11/solution.hi new file mode 100644 index 0000000..9ae7f20 Binary files /dev/null and b/11/solution.hi differ diff --git a/11/solution.hs b/11/solution.hs index edde06f..4d3de05 100644 --- a/11/solution.hs +++ b/11/solution.hs @@ -22,8 +22,8 @@ splitInput = map read . split [' '] . head . split ['\n'] solve1 :: [Int] -> Int solve1 = length . foldl (.) id (take 25 $ repeat (concat . map stoneStep)) -solve2 :: [Int] -> Int -solve2 xs = sum $ ((map ((memoize2 stoneCount) 75) xs) `using` parList rseq) +solve2 :: [Int] -> Integer +solve2 xs = sum $ map (memocount 40000) xs -- ((map ((memoize2 stoneCount) 40000) xs) `using` parList rseq) stoneStep :: Int -> [Int] stoneStep 0 = [1] @@ -35,14 +35,21 @@ splitAtIndex :: Int -> [a] -> [[a]] splitAtIndex 0 xs = [[], xs] splitAtIndex a (x:xs) = addFirst (splitAtIndex (a-1) xs) x -stoneCount :: Int -> Int -> Int -stoneCount 0 = (\x -> 1) -stoneCount n = sum . map (((memoize2 stoneCount)) (n-1)) . stoneStep +stoneCount :: Int -> Int -> Integer +stoneCount 0 _ = 1 +stoneCount n x + | x == 0 = memocount (n-1) 1 + | (floor $ logBase 10 $ fromIntegral x) `rem` 2 == 1 = let d = ((\x -> x `div` 2) $ (+1) $ floor $ logBase 10 $ fromIntegral x) in (memocount (n-1) (x `rem` 10^d)) + (memocount (n-1) (x `div` 10^d)) + | otherwise = memocount (n-1) (x*2024) +-- sum . map (((memoize2 stoneCount)) (n-1)) . stoneStep + +memocount = memoize2 stoneCount main :: IO() main = do - fileinp <- readFile "input.txt" - let parsed = splitInput fileinp + --fileinp <- readFile "input.txt" + --let parsed = splitInput fileinp + let parsed = [1] let solved1 = solve1 parsed let solved2 = solve2 parsed print solved1 diff --git a/11/solution.o b/11/solution.o new file mode 100644 index 0000000..bad8bc2 Binary files /dev/null and b/11/solution.o differ diff --git a/12/example.txt b/12/example.txt new file mode 100644 index 0000000..85b768f --- /dev/null +++ b/12/example.txt @@ -0,0 +1,10 @@ +RRRRIICCFF +RRRRIICCCF +VVRRRCCFFF +VVRCCCJFFF +VVVVCJJCFE +VVIVCCJJEE +VVIIICJJEE +MIIIIIJJEE +MIIISIJEEE +MMMISSJEEE diff --git a/12/solution.hs b/12/solution.hs new file mode 100644 index 0000000..20c82f4 --- /dev/null +++ b/12/solution.hs @@ -0,0 +1,111 @@ +import Data.List +import Data.Graph +import Data.Maybe +import Data.Array +import Debug.Trace + +traceOut :: Show a => a -> a +traceOut x = (traceShow x x) + +addFirst :: [[a]] -> a -> [[a]] +addFirst [] x = [[x]] +addFirst (y:ys) x = ([x] ++ y) : ys + +split :: [Char] -> String -> [String] +split _ [] = [] +split delims (x:xs) + | elem x delims = [[]] ++ split delims xs + | otherwise = addFirst (split delims xs) x + +splitInput :: String -> [[Char]] +splitInput = split ['\n'] + +makeGraph :: [[Char]] -> (Graph, (Vertex -> (Char, (Int, Int), [(Int, Int)])), ((Int, Int) -> Maybe Vertex)) +makeGraph grid = graphFromEdgeList grid . concat . map (\(x, _) -> x) . concat . flipSecond . map (map (\(x, row) -> foldl' (combine x) ([], (-1, '#')) row)) . map (indexed . map indexed) . (\x -> [x, transpose x]) $ grid + +graphFromEdgeList :: [[Char]] -> [((Int, Int), (Int, Int))] -> (Graph, (Vertex -> (Char, (Int, Int), [(Int, Int)])), ((Int, Int) -> Maybe Vertex)) +graphFromEdgeList grid edgePairs = + graphFromEdges [(value, (x, y), [b | (a, b) <- edgePairs, a == (x, y)]) | (x, row) <- indexed grid, (y, value) <- indexed row] + +combine :: Int -> ([((Int, Int), (Int, Int))], (Int, Char)) -> (Int, Char) -> ([((Int, Int), (Int, Int))], (Int, Char)) +combine x (edges, (prevy, prevv)) (nexty, nextv) + | nextv == prevv = ((((x, prevy), (x, nexty)):((x, nexty), (x, prevy)):edges), (nexty, nextv)) + | otherwise = (edges, (nexty, nextv)) + +indexed :: [a] -> [(Int, a)] +indexed xs = zip [0..] xs + +flipSecond :: [[([((Int, Int), (Int, Int))], (Int, Char))]] -> [[([((Int, Int), (Int, Int))], (Int, Char))]] +flipSecond [a, xs] = [a, map (\(x, y) -> ((map (\((a, b), (c, d)) -> ((b, a), (d, c))) x), y)) xs] + +solve1 :: Graph -> (Vertex -> (Char, (Int, Int), [(Int, Int)])) -> ((Int, Int) -> Maybe Vertex) -> (Array Vertex Int) -> Int +solve1 graph gfunc gfunc2 outdegrees = sum $ concat $ map (map (\x -> (4 - outdegrees!x))) $ map (reachable graph) $ vertices graph + +solve2 :: [[Char]] -> Graph -> ((Int, Int) -> Maybe Vertex) -> Int +solve2 grid graph gfunc2 = (sum $ map (checkWindow graph gfunc2) $ squareWindows grid) + (sum $ map (checkEdge graph gfunc2) $ getEdges grid) + (sum $ map (area graph gfunc2) [(0, 0), (0,(length grid)-1), ((length grid)-1, 0), ((length grid)-1, (length grid)-1)]) + +getEdges :: [[Char]] -> [(Char, Char, (Int, Int, Int, Int))] +getEdges grid = let d = ((length grid)-1) in concat $ map (\x -> [ + (grid!!0!!x, grid!!0!!(x+1), (0, x, 0, x+1)), + (grid!!d!!x, grid!!d!!(x+1), (d, x, d, x+1)), + (grid!!x!!0, grid!!(x+1)!!0, (x, 0, x+1, 0)), + (grid!!x!!d, grid!!(x+1)!!d, (x, d, x+1, d)) + ]) [0..(d-1)] + +checkEdge :: Graph -> ((Int, Int) -> Maybe Vertex) -> (Char, Char, (Int, Int, Int, Int)) -> Int +checkEdge graph gfunc2 (a, b, (x, y, z, w)) + | a==b = 0 + | a/=b = (area graph gfunc2 (x, y)) + (area graph gfunc2 (z, w)) + +checkWindow :: Graph -> ((Int, Int) -> Maybe Vertex) -> (Char, Char, Char, Char, (Int, Int)) -> Int +checkWindow graph gfunc2 (a, b, c, d, (x, y)) + -- AA AB + -- BB AB + | (a==b) && (c==d) = 0 + | (a==c) && (b==d) = 0 + -- AA AB AA BA + -- AB AA BA AA + | (a==b) && (a==d) = (area graph gfunc2 (x, y)) + (area graph gfunc2 (x, y+1)) + | (a==b) && (a==c) = (area graph gfunc2 (x, y)) + (area graph gfunc2 (x+1, y+1)) + | (a==d) && (a==c) = (area graph gfunc2 (x, y)) + (area graph gfunc2 (x+1, y)) + | (b==d) && (b==c) = (area graph gfunc2 (x, y)) + (area graph gfunc2 (x+1, y)) + -- AB AC CC CA + -- CC BC AB CB + | (a==b) = (area graph gfunc2 (x, y+1)) + (area graph gfunc2 (x+1, y+1)) + | (c==d) = (area graph gfunc2 (x, y)) + (area graph gfunc2 (x+1, y)) + | (a==c) = (area graph gfunc2 (x+1, y)) + (area graph gfunc2 (x+1, y+1)) + | (b==d) = (area graph gfunc2 (x, y)) + (area graph gfunc2 (x, y+1)) + -- AB + -- CD + | otherwise = (area graph gfunc2 (x, y)) + (area graph gfunc2 (x, y+1)) + (area graph gfunc2 (x+1, y)) + (area graph gfunc2 (x+1, y+1)) + +area :: Graph -> ((Int, Int) -> Maybe Vertex) -> (Int, Int) -> Int +area graph gfunc2 coords = length $ reachable graph $ fromJust $ gfunc2 coords + +--a : x, y +--b : x+1, y +--c : x, y+1 +--d : x+1, y+1 +-- ac +-- bd + +squareWindows :: [[Char]] -> [(Char, Char, Char, Char, (Int, Int))] +squareWindows grid = [ + (grid!!x!!y, + grid!!(x+1)!!y, + grid!!x!!(y+1), + grid!!(x+1)!!(y+1), + (x, y) + ) | x <- [0..((length grid)-2)], + y <- [0..((length grid)-2)]] + +main :: IO() +main = do + fileinp <- readFile "input.txt" + let parsed = splitInput fileinp + let (graph, gfunc, gfunc2) = makeGraph parsed + let outdegrees = outdegree graph + let solved1 = solve1 graph gfunc gfunc2 outdegrees + let solved2 = solve2 parsed graph gfunc2 + print solved1 + print solved2