Связывание узла с государственной монадой

Ответ 1

Я играл с вещами, и я думаю, что придумал что-то... интересное. Я называю это монадой "Провидца", и она обеспечивает (помимо операций Монады) две примитивные операции:

see  :: Monoid s => Seer s s
send :: Monoid s => s -> Seer s ()

и операции запуска:

runSeer :: Monoid s => Seer s a -> a

Способ, которым работает эта монада, заключается в том, что see позволяет провидцу видеть все, а send позволяет провидцу "отправлять" информацию всем остальным наблюдателям, чтобы они могли видеть. Всякий раз, когда любой провидец выполняет операцию see, они могут видеть всю отправленную информацию и всю информацию, которая будет отправлена. Другими словами, в течение данного прогона see всегда будет давать тот же результат независимо от того, где и когда вы его вызываете. Другой способ сказать, что see - это то, как вы получаете рабочую ссылку на "связанный" узел.

На самом деле это очень похоже на использование fix, за исключением того, что все части добавляются постепенно и неявно, а не явно. Очевидно, что провидцы не будут работать правильно в присутствии парадокса, и требуется достаточная лень. Например, see >>= send может вызвать взрыв информации, задерживая вас в цикле времени.

Немой пример:

import Control.Seer
import qualified Data.Map as M
import Data.Map (Map, (!))

bar :: Seer (Map Int Char) String
bar = do
  m <- see
  send (M.singleton 1 $ succ (m ! 2))
  send (M.singleton 2 'c')
  return [m ! 1, m ! 2]

Как я уже сказал, я только что обошел вокруг, поэтому я понятия не имею, если это лучше, чем то, что у вас есть, или если это вообще-то хорошо! Но это изящно и актуально, и если ваше состояние "узла" - это Monoid, тогда это может быть полезно для вас. Яркое предупреждение: я построил Seer с помощью Tardis.

https://github.com/DanBurton/tardis/blob/master/Control/Seer.hs

Ответ 2

Я написал статью по этой теме под названием Ассамблея: круговое программирование с рекурсивной do где я описываю два метода построения ассемблера, использующего привязку узлов. Как и ваша проблема, ассемблер должен иметь возможность разрешать адрес меток, который может появиться позже в файле.

Ответ 3

Что касается реализации, я бы сделал ее состав монады читателя (для будущего) и государственной монады (для прошлого/настоящего). Причина в том, что вы устанавливаете свое будущее только один раз (в tie), а затем не меняете его.

{-# LANGUAGE DoRec, GeneralizedNewtypeDeriving #-}

import Control.Monad.State
import Control.Monad.Reader
import Control.Applicative

newtype RecStateT s m a = RecStateT (StateT s (ReaderT s m) a) deriving
  ( Alternative
  , Applicative
  , Functor
  , Monad
  , MonadPlus
  )

tie :: MonadFix m => RecStateT s m a -> s -> m (a, s)
tie (RecStateT m) s = do
  rec (a, s') <- flip runReaderT s' $ flip runStateT s m
  return (a, s')

getPast :: Monad m => RecStateT s m s
getPast = RecStateT get

getFuture :: Monad m => RecStateT s m s
getFuture = RecStateT ask

putPresent :: Monad m => s -> RecStateT s m ()
putPresent = RecStateT . put

Что касается вашего второго вопроса, это поможет узнать ваш поток данных (т.е. иметь минимальный пример вашего кода). Неверно, что строгие шаблоны всегда приводят к циклам. Это правда, что вам нужно быть осторожным, чтобы не создавать цикл создания, но точные ограничения зависят от того, что и как вы строите.

Ответ 4

Я немного ошеломлен количеством использования Монады. Я мог бы не понимать прошлое/будущие вещи, но я думаю, вы просто пытаетесь выразить привязку ленивых + fixpoint. (Поправьте меня если я ошибаюсь.) Использование RWS Monad с R = W довольно забавно, но вам не нужны State и loop, когда вы можете сделать то же самое с fmap. Нет смысла использовать Monads, если они не облегчат ситуацию. (Только очень немногие монады представляют хронологический порядок, так или иначе.)

Мое общее решение связать узел:

• Я разбираю все в список узлов,
• преобразовать этот список в Data.Vector для O (1) доступа к значениям в коробке (= lazy),
• привяжите этот результат к имени с помощью let или fix или mfix,
• и получить доступ к названию Vector внутри парсера. (см. 1.)

Это example решение в вашем блоге, где вы пишете sth. например:

data Node = Node {
  value :: Int,
  next  :: Node
} deriving Show
…
tie = …
parse = …
data ParserState = …
…
example :: Node
example =
  let (_, _, m) = tie parse $ ParserState 0 [(0, 1), (1, 2), (2, 0)]
  in (m Map.! 0)

Я бы написал так:

{-# LANGUAGE ViewPatterns, NamedFieldPuns #-}
import Data.Vector as Vector

example :: Node
example =
   let node :: Int -> Node
       node = (Vector.!) $ Vector.fromList $
                   [ Node{value,next}
                   | (value,node->next) <- [(0, 1), (1, 2), (2, 0)]
                   ]
   in (node 0)

или короче:

{-# LANGUAGE ViewPatterns, NamedFieldPuns #-}
import Data.Vector as Vector

example :: Node
example = (\node->(Vector.fromList[ Node{value,next}
                                  | (value,node->next) <- [(0, 1), (1, 2), (2, 0)]
                                  ] Vector.!)) `fix` 0

Ответ 5

В последнее время у меня была аналогичная проблема, но я выбрал другой подход. Рекурсивная структура данных может быть представлена ​​как фиксированная точка типа для функтора типа данных. Загрузка данных может быть разделена на две части:

• Загрузите данные в структуру, которая ссылается на другие узлы только на какой-то идентификатор. В примере это Loader Int (NodeF Int), который строит карту значений типа NodeF Int Int.
• Свяжите узел, создав рекурсивную структуру данных, заменив идентификаторы на фактические данные. В этом примере результирующие структуры данных имеют тип Fix (NodeF Int), и для удобства они впоследствии преобразуются в Node Int.

В нем отсутствует правильная обработка ошибок и т.д., но идея должна быть понятна из этого.

-- Public Domain

import Control.Monad
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Maybe (fromJust)

-- Fixed point operator on types and catamohism/anamorphism methods
-- for constructing/deconstructing them:

newtype Fix f = Fix { unfix :: f (Fix f) }

catam :: Functor f => (f a -> a) -> (Fix f -> a)
catam f = f . fmap (catam f) . unfix

anam :: Functor f => (a -> f a) -> (a -> Fix f)
anam f = Fix . fmap (anam f) . f

anam' :: Functor f => (a -> f a) -> (f a -> Fix f)
anam' f = Fix . fmap (anam f)

-- The loader itself

-- A representation of a loader. Type parameter 'k' represents the keys by
-- which the nodes are represented. Type parameter 'v' represents a functor
-- data type representing the values.
data Loader k v = Loader (Map k (v k))

-- | Creates an empty loader.
empty :: Loader k v
empty = Loader $ Map.empty

-- | Adds a new node into a loader.
update :: (Ord k) => k -> v k -> Loader k v -> Loader k v
update k v = update' k (const v)

-- | Modifies a node in a loader.
update' :: (Ord k) => k -> (Maybe (v k) -> (v k)) -> Loader k v -> Loader k v
update' k f (Loader m) = Loader $ Map.insertWith (const (f . Just)) k (f Nothing) $ m

-- | Does the actual knot-tying. Creates a new data structure
-- where the references to nodes are replaced by the actual data.
tie :: (Ord k, Functor v) => Loader k v -> Map k (Fix v)
tie (Loader m) = Map.map (anam' $ \k -> fromJust (Map.lookup k m)) m


-- -----------------------------------------------------------------
-- Usage example:

data NodeF n t = NodeF n [t]
instance Functor (NodeF n) where
    fmap f (NodeF n xs) = NodeF n (map f xs)

-- A data structure isomorphic to Fix (NodeF n), but easier to work with.
data Node n = Node n [Node n]
  deriving Show
-- The isomorphism that does the conversion.
nodeunfix :: Fix (NodeF n) -> Node n
nodeunfix = catam (\(NodeF n ts) -> Node n ts)

main :: IO ()
main = do
    -- Each node description consist of an integer ID and a list of other nodes
    -- it references.
    let lss = 
            [ (1, [4])
            , (2, [1])
            , (3, [2, 1])
            , (4, [3, 2, 1])
            , (5, [5])
            ]
    print lss
    -- Fill a new loader with the data:
    let
        loader = foldr f empty lss
        f (label, dependsOn) = update label (NodeF label dependsOn)
    -- Tie the knot:
    let tied' = tie loader
    -- And convert Fix (NodeF n) into Node n:
    let tied = Map.map nodeunfix tied'

    -- For each node print the label of the first node it references
    -- and the count of all referenced nodes.
    print $ Map.map (\(Node n [email protected]((Node n1 _) : _)) -> (n1, length ls)) tied