From 65369fae4b21998c5ea9b0f11c24267cb4e0158e Mon Sep 17 00:00:00 2001 From: sgf Date: Wed, 26 Jan 2022 00:09:45 +0300 Subject: [PATCH] Working haskell version for part 1. --- aoc2021.cabal | 13 +++++ day6/Main.hs | 159 ++++++++++++++++++++++++++++++++++++++++++++++++++ day6/main.go | 2 +- 3 files changed, 173 insertions(+), 1 deletion(-) create mode 100644 day6/Main.hs diff --git a/aoc2021.cabal b/aoc2021.cabal index 7d0b531..b4a9088 100644 --- a/aoc2021.cabal +++ b/aoc2021.cabal @@ -30,3 +30,16 @@ executable day1 build-depends: base >=4.7 && <5 default-language: Haskell2010 + +executable day6 + main-is: Main.hs + other-modules: + Paths_aoc2021 + hs-source-dirs: + day6 + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall + build-depends: + base >=4.7 && <5, + comonad, + split + default-language: Haskell2010 diff --git a/day6/Main.hs b/day6/Main.hs new file mode 100644 index 0000000..1160614 --- /dev/null +++ b/day6/Main.hs @@ -0,0 +1,159 @@ + +import Control.Comonad +import Control.Comonad.Traced +import Data.Function +import Data.List.Split + +newtype Traced2 m a = Traced2 (m -> a) + +instance Functor (Traced2 m) where + fmap f (Traced2 g) = Traced2 (f <$> g) + +instance Monoid m => Comonad (Traced2 m) where + extract (Traced2 f) = f mempty + extend q (Traced2 g) = Traced2 (\m -> q (Traced2 (\m' -> g (m <> m')))) + duplicate (Traced2 g) = Traced2 (\m -> Traced2 (\m' -> g (m <> m'))) + +trace2 :: m -> Traced2 m a -> a +trace2 x (Traced2 f) = f x + +traces2 :: Monoid m => (a -> m) -> Traced2 m a -> a +traces2 f w = trace2 (f (extract w)) w + +oneDay :: [Int] -> [Int] +oneDay xs = + let (ys, k) = foldr go ([], 0) xs + in ys ++ take k (repeat 8) + where + go :: Int -> ([Int], Int) -> ([Int], Int) + go x (zs, n) + | x == 0 = (6 : zs, n + 1) + | otherwise = (x - 1 : zs, n) + +-- Primitive version not requiring comonad-s at all. +fish :: Traced [Int] [Int] +fish = traced oneDay + +fishes :: [Int] -> Int -> [Int] +fishes xs 0 = xs +fishes xs n = fishes (trace xs fish) (n - 1) + +-- First, note, that +-- +-- extract $ w =>> trace x +-- +-- assigns second monoid m' to x and first monoid m to [] (see 'extend' +-- definition above). But +-- +-- trace x w +-- +-- assigns /first/ monoid m to x. Understanding this distinction is the key +-- for following explanations. + +-- Version with 'First' monoid. Here +-- +-- trace x $ fishF =>>..... +-- +-- is the same as just +-- +-- trace x fishF +-- +-- because 'First' Monoid will always choose leftmost monoid value, i.e. the +-- one supplied by 'trace'. Thus, it does not matter what follows 'fishF' in +-- the 'extend' chain, only first 'fishF' will be actually executed, when i +-- apply 'trace'. But 'traces' does exactly this: it extracts current result +-- and 'trace'-s it through the same comonad. This is effectively the same as +-- just 'trace'-ing current result through just 'fishF' ignoring the rest of +-- the comonad chain. But tracing current result through 'fishF' is just one +-- step. Then, next 'traces' 'extract'-s this result (which is now one step +-- further) and all repeats. + +oneDayF :: First [Int] -> [Int] +oneDayF (First Nothing) = oneDay [] +oneDayF (First (Just xs)) = oneDay xs + +fishF :: Traced (First [Int]) [Int] +fishF = traced oneDayF + +fishesF :: [Int] -> Int -> [Int] +fishesF ages n + | n > 0 = extract (fix go n) + | otherwise = ages + where + go :: (Int -> Traced (First [Int]) [Int]) -> Int -> Traced (First [Int]) [Int] + go rec x + | x > 1 = rec (x - 1) =>> traces (First . Just) + | otherwise = fishF =>> trace (First (Just ages)) + +-- Version with 'Last' monoid. Here +-- +-- fishL =>> trace x =>> ..... +-- +-- is the same as +-- +-- fishL =>> trace x +-- +-- because extending 'trace' applies last argument and no matter how many +-- times... +-- +-- Here +-- +-- trace (Last . Just $ [3,4,3,1,2]) $ fishL =>> traces (Last . Just) +-- +-- makes two steps, First step is made by 'fishL', when it is 'extract'-ed +-- inside 'traces' (remember, 'extract' applies mempty, so 'Last' does not +-- matter here). Second step is made, when 'traces' applies 'trace' to the +-- same comonad: 'trace' applied by 'traces' effectively provides /last/ +-- argument to monoid sum (see 'extend' definition for 'Traced'), and, thus, +-- 'fishL' makes step from previous result. +-- +-- So, (fishL =>> traces (Last . Just)) makes /two steps/ further. +-- +-- When i add one more 'traces' to the end +-- +-- trace (Last . Just $ [3,4,3,1,2]) $ fishL =>> traces (Last . Just) =>> traces (Last . Just) +-- +-- the last 'traces' applies 'extract' to (fishL =>> traces (Last . Just)), +-- but i know from before, that this comonad does /two steps/. So, +-- 'extract'-ing from this comonad makes two steps further. Then 'traces' +-- applies 'trace' to the same comonad, which also makes /two steps/ furhter, +-- as i know from before. Thus, this chain actually will make /4 steps further/. +-- +-- So, each 'traces' runs previous comonad twice. And, thus, applying one more +-- 'traces' (to the total of 3 'traces' in chain) multiplies /4 steps/ by 2 +-- and i'll move 8 steps further. Etc. +-- +-- So, version with 'Last' calculates fishes at the power of 2 day. The exact +-- power of 2 depends from condition (x > 1) in go function in 'fishesL' +-- below. + +oneDayL :: Last [Int] -> [Int] +oneDayL (Last Nothing) = oneDay [] +oneDayL (Last (Just xs)) = oneDay xs + +fishL :: Traced (Last [Int]) [Int] +fishL = traced oneDayL + +-- Calculates fishes at 2^(n - 1) day. +fishesL :: [Int] -> Int -> [Int] +fishesL ages n + | n > 0 = trace (Last (Just ages)) (fix go n) + | otherwise = ages + where + go :: (Int -> Traced (Last [Int]) [Int]) -> Int -> Traced (Last [Int]) [Int] + go rec x + | x > 1 = rec (x - 1) =>> traces (Last . Just) + | otherwise = fishL + +readInput :: FilePath -> IO [Int] +readInput = fmap (map read . wordsBy (== ',')) . readFile + +runF1 :: FilePath -> IO () +runF1 fp = do + ages <- readInput fp + let ys = fishesF ages 80 + print $ "Answer1: " ++ show (length ys) + +main :: IO () +main = runF1 "day6/input.txt" + diff --git a/day6/main.go b/day6/main.go index 944e968..5f2d5be 100644 --- a/day6/main.go +++ b/day6/main.go @@ -74,7 +74,7 @@ func RunF1(input string) { ages = oneDay(ages) fmt.Printf("Day %v: %v\n", d, ages) }*/ - for d := 0; d < 200; d++ { + for d := 0; d < 80; d++ { ages = oneDay(ages) //fmt.Printf("Day %v: %v\n", d, ages) } -- 2.20.1