- MonoLocalBinds
- MultiParamTypeClasses
- MultiWayIf
+- NamedFieldPuns
- NegativeLiterals
- NumDecimals
# - OverloadedLists
- adjunctions
- distributive
- advent24map:
- main: advent24map.hs
+ advent24b:
+ main: advent24b.hs
source-dirs: src
dependencies:
- base >= 2 && < 6
- - finite-typelits
- containers
- - mtl
- - comonad
- - adjunctions
- - distributive
- # advent24zip:
- # main: advent24zip.hs
+ # advent24map:
+ # main: advent24map.hs
# source-dirs: src
# dependencies:
# - base >= 2 && < 6
# - adjunctions
# - distributive
- advent24v:
- main: advent24v.hs
- source-dirs: src
- dependencies:
- - base >= 2 && < 6
- - finite-typelits
- - mtl
- - vector
- - comonad
- - adjunctions
- - distributive
\ No newline at end of file
+ # advent24tape:
+ # main: advent24tape.hs
+ # source-dirs: src
+ # dependencies:
+ # - base >= 2 && < 6
+ # - finite-typelits
+ # - containers
+ # - mtl
+ # - comonad
+ # - adjunctions
+ # - distributive
+ # - free
+
+ # advent24v:
+ # main: advent24v.hs
+ # source-dirs: src
+ # dependencies:
+ # - base >= 2 && < 6
+ # - finite-typelits
+ # - mtl
+ # - vector
+ # - comonad
+ # - adjunctions
+ # - distributive
\ No newline at end of file
--- /dev/null
+import Debug.Trace
+
+import qualified Data.Set as S
+
+data Cell = Cell { level :: Int
+ , row :: Int
+ , column :: Int
+ } deriving (Show, Eq, Ord)
+type Grid = S.Set Cell
+
+
+gridSize = 5
+
+main :: IO ()
+main =
+ do grid0 <- readGrid
+ print grid0
+ let finalGrid = head $ drop 200 $ iterate update grid0
+ print $ S.size finalGrid
+
+
+readGrid =
+ do gs <- readFile "data/advent24.txt"
+ let grid = lines gs
+ let isBug r c = (grid!!(r - 1))!!(c - 1) == '#'
+ let level = 0
+ return $ S.fromList [Cell {..} | row <- [1..gridSize], column <- [1..gridSize], isBug row column]
+
+neighbourSpaces :: Cell -> Grid
+neighbourSpaces cell =
+ ( (neighbourSpacesLeft cell)
+ <> (neighbourSpacesRight cell)
+ <> (neighbourSpacesAbove cell)
+ <> (neighbourSpacesBelow cell)
+ )
+
+neighbourSpacesLeft :: Cell -> Grid
+neighbourSpacesLeft (Cell {..})
+ | column == 4 && row == 3 = S.fromList [ Cell { level = (level + 1), row = r, column = 5} | r <- [1..gridSize] ]
+ | column == 1 = S.singleton ( Cell { level = (level - 1), row = 3, column = 2})
+ | otherwise = S.singleton ( Cell { level, row, column = (column - 1)})
+
+neighbourSpacesRight :: Cell -> Grid
+neighbourSpacesRight (Cell {..})
+ | column == 2 && row == 3 = S.fromList [ Cell { level = (level + 1), row = r, column = 1} | r <- [1..gridSize] ]
+ | column == 5 = S.singleton ( Cell { level = (level - 1), row = 3, column = 4})
+ | otherwise = S.singleton ( Cell { level, row, column = (column + 1)})
+
+neighbourSpacesAbove :: Cell -> Grid
+neighbourSpacesAbove (Cell {..})
+ | row == 4 && column == 3 = S.fromList [ Cell { level = (level + 1), row = 5, column = c} | c <- [1..gridSize] ]
+ | row == 1 = S.singleton ( Cell { level = (level - 1), row = 2, column = 3})
+ | otherwise = S.singleton ( Cell { level, row = (row - 1), column})
+
+neighbourSpacesBelow :: Cell -> Grid
+neighbourSpacesBelow (Cell {..})
+ | row == 2 && column == 3 = S.fromList [ Cell { level = (level + 1), row = 1, column = c} | c <- [1..gridSize] ]
+ | row == 5 = S.singleton ( Cell { level = (level - 1), row = 4, column = 3})
+ | otherwise = S.singleton ( Cell { level, row = (row + 1), column})
+
+
+countOccupiedNeighbours :: Cell -> Grid -> Int
+countOccupiedNeighbours cell grid = S.size $ S.intersection grid $ neighbourSpaces cell
+
+bugSurvives :: Grid -> Cell -> Bool
+bugSurvives grid cell = alive && oneNeighbour
+ where alive = cell `S.member` grid
+ oneNeighbour = (countOccupiedNeighbours cell grid) == 1
+
+bugBorn :: Grid -> Cell -> Bool
+bugBorn grid cell = dead && (nNbrs == 1 || nNbrs == 2)
+ where dead = cell `S.notMember` grid
+ nNbrs = countOccupiedNeighbours cell grid
+
+update :: Grid -> Grid
+update grid = S.union (S.filter (bugSurvives grid) bugs) (S.filter (bugBorn grid) empties)
+ where bugs = grid
+ empties = (S.foldr mergeEmpties S.empty grid) `S.difference` bugs
+ mergeEmpties cell acc = S.union acc $ neighbourSpaces cell
+
unGrid :: StoredGrid -> Grid Bool
-- unGrid (StoreT (Identity g) _) = g
unGrid grid = Grid False $ M.fromList gridList
- where (sgf, _sgl) = runStore grid
+ where (sgf, _sgl) = runStore grid -- return pair is function for extracting elements, and current focus
gridList = [((Ongrid r c), sgf (Ongrid r c)) | c <- [1..gridSize], r <- [1..gridSize]]
--- /dev/null
+
+-- import Debug.Trace
+
+
+import Data.Bool (bool)
+import Data.Distributive (Distributive(..))
+import Data.Functor.Rep (Representable(..), distributeRep)
+import Data.Functor.Identity (Identity(..))
+import Control.Comonad.Representable.Store (Store(..), StoreT(..), store, experiment, runStore)
+import Control.Comonad (Comonad(..))
+
+import Data.Maybe
+import Data.List
+import qualified Data.Set as S
+import qualified Data.Map as M
+
+import Control.Concurrent (threadDelay)
+import Control.Monad (forM_)
+
+import Control.Comonad
+import Control.Comonad.Cofree
+import Data.Distributive
+import Data.Functor.Rep
+import qualified Data.Sequence as Q
+import qualified Data.List.NonEmpty as NE
+
+
+data TPossible a = TPossible
+ { leftward :: a
+ , rightward :: a
+ , above :: a
+ , below :: a
+ } deriving (Show, Eq, Functor)
+
+data TChoice = L | R | U | D
+ deriving (Show, Eq)
+
+instance Distributive TPossible where
+ distribute :: Functor f => f (TPossible a) -> TPossible (f a)
+ distribute fga = TPossible (fmap leftward fga) (fmap rightward fga)
+ (fmap above fga) (fmap below fga)
+
+instance Representable TPossible where
+ type Rep TPossible = TChoice
+
+ index :: TPossible a -> TChoice -> a
+ index here L = leftward here
+ index here R = rightward here
+ index here U = above here
+ index here D = below here
+
+ tabulate :: (TChoice -> a) -> TPossible a
+ tabulate describe = TPossible (describe L) (describe R)
+ (describe U) (describe D)
+
+relativePosition :: Q.Seq TChoice -> Int
+relativePosition = sum . fmap valOf
+ where
+ valOf L = (-1)
+ valOf R = 1
+ valOf U = (-10)
+ valOf D = 10
+
+numberLine :: Cofree TPossible Int
+numberLine = tabulate relativePosition
+
+project :: NE.NonEmpty a -> Cofree TPossible a
+project l = tabulate describe
+ where
+ describe = (l NE.!!) . foldl go 0
+ maxIndex = length l - 1
+ minIndex = 0
+ go n L = max minIndex (n - 1)
+ go n R = min maxIndex (n + 1)
+ go n U = max minIndex (n - 1)
+ go n D = min maxIndex (n + 1)
+
+elems :: NE.NonEmpty String
+elems = "one" NE.:| ["two", "three"]
+
+path :: Q.Seq TChoice
+path = Q.fromList [R, R, R, R, L]
+
+moveTo :: Q.Seq TChoice -> Cofree TPossible a -> Cofree TPossible a
+moveTo ind = extend (\cfr -> index cfr ind)
+
+main :: IO ()
+main = print $ index (project elems) path
+-- main = print elems
projects / advent-of-code-19.git / commitdiff