advent24/src/advent24tape.hs

   1
   2 -- import Debug.Trace
   3
   4
   5 import Data.Bool (bool)
   6 import Data.Distributive (Distributive(..))
   7 import Data.Functor.Rep (Representable(..), distributeRep)
   8 import Data.Functor.Identity (Identity(..))
   9 import Control.Comonad.Representable.Store (Store(..), StoreT(..), store, experiment, runStore)
  10 import Control.Comonad (Comonad(..))
  11
  12 import Data.Maybe
  13 import Data.List
  14 import qualified Data.Set as S
  15 import qualified Data.Map as M
  16
  17 import Control.Concurrent (threadDelay)
  18 import Control.Monad (forM_)
  19
  20 import Control.Comonad
  21 import Control.Comonad.Cofree
  22 import Data.Distributive
  23 import Data.Functor.Rep
  24 import qualified Data.Sequence as Q
  25 import qualified Data.List.NonEmpty as NE
  26
  27
  28 data TPossible a = TPossible
  29   { leftward :: a
  30   , rightward :: a
  31   , above :: a
  32   , below :: a
  33   } deriving (Show, Eq, Functor)
  34
  35 data TChoice = L | R | U | D
  36   deriving (Show, Eq)
  37
  38 instance Distributive TPossible where
  39   distribute :: Functor f => f (TPossible a) -> TPossible (f a)
  40   distribute fga = TPossible (fmap leftward fga) (fmap rightward fga)
  41                              (fmap above fga) (fmap below fga)
  42
  43 instance Representable TPossible where
  44   type Rep TPossible = TChoice
  45
  46   index :: TPossible a -> TChoice -> a
  47   index here L = leftward here
  48   index here R = rightward here
  49   index here U = above here
  50   index here D = below here
  51
  52   tabulate :: (TChoice -> a) -> TPossible a
  53   tabulate describe = TPossible (describe L) (describe R)
  54                                 (describe U) (describe D)
  55
  56 relativePosition :: Q.Seq TChoice -> Int
  57 relativePosition = sum . fmap valOf
  58   where
  59     valOf L = (-1)
  60     valOf R = 1
  61     valOf U = (-10)
  62     valOf D = 10
  63
  64 numberLine :: Cofree TPossible Int
  65 numberLine = tabulate relativePosition
  66
  67 project :: NE.NonEmpty a -> Cofree TPossible a
  68 project l = tabulate describe
  69   where
  70     describe = (l NE.!!) . foldl go 0
  71     maxIndex = length l - 1
  72     minIndex = 0
  73     go n L = max minIndex (n - 1)
  74     go n R = min maxIndex (n + 1)
  75     go n U = max minIndex (n - 1)
  76     go n D = min maxIndex (n + 1)
  77
  78 elems :: NE.NonEmpty String
  79 elems = "one" NE.:| ["two", "three"]
  80
  81 path :: Q.Seq TChoice
  82 path = Q.fromList [R, R, R, R, L]
  83
  84 moveTo :: Q.Seq TChoice -> Cofree TPossible a -> Cofree TPossible a
  85 moveTo ind = extend (\cfr -> index cfr ind)
  86
  87 main :: IO ()
  88 main = print $ index (project elems) path
  89 -- main = print elems