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

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

У меня есть эта работа, и своего рода разумно абстрагированы в StateTмонадный трансформатор:

{-# LANGUAGE DoRec, GeneralizedNewtypeDeriving #-}

import qualified Control.Monad.State as S

data Knot s = Knot { past :: s, future :: s }

newtype RecStateT s m a = RecStateT (S.StateT (Knot s) m a) deriving
  ( Alternative
  , Applicative
  , Functor
  , Monad
  , MonadCont
  , MonadError e
  , MonadFix
  , MonadIO
  , MonadPlus
  , MonadReader r
  , MonadTrans
  , MonadWriter w )

runRecStateT :: RecStateT s m a -> Knot s -> m (a, Knot s)
runRecStateT (RecStateT st) = S.runStateT st

tie :: MonadFix m => RecStateT s m a -> s -> m (a, s)
tie m s = do
  rec (a, Knot s' _) <- runRecStateT m (Knot s s')
  return (a, s')

get :: Monad m => RecStateT s m (Knot s)
get = RecStateT S.get

put :: Monad m => s -> RecStateT s m ()
put s = RecStateT $ S.modify $ \ ~(Knot _ s') -> Knot s s'

tie функция, где происходит волшебство: вызов runRecStateT производит значение и состояние, которое я кормлю как свое собственное будущее. Обратите внимание, что get позволяет читать как из прошлого и будущего состояния, но put только позволяет изменить "настоящее".

Вопрос 1. Похоже ли это на приличный способ реализовать эту модель связывания узлов в целом? Или, что еще лучше, кто-то реализовал общее решение, которое я упустил из виду, когда просматривал Hackage? Я ударился головой о Cont какое-то время монада, поскольку она казалась, возможно, более элегантной (см. аналогичный пост от Дэна Бертона), но я просто не мог разобраться.

Абсолютно субъективный вопрос 2: я не в восторге от того, как мой код вызова выглядит так:

do
  Knot past future <- get
  let {- ... -} = past
      {- ... -} = future
      node = {- ... -}
  put $ {- ... -}
  return node

Детали реализации здесь опущены, очевидно, важным моментом является то, что я должен получить past а также future состояние, сопоставьте их в привязке let (или явно сделайте предыдущий шаблон ленивым), чтобы извлечь все, что мне нужно, затем построить мой узел, обновить мое состояние и, наконец, вернуть узел. Кажется ненужным многословным, и мне особенно не нравится, как легко случайно сделать шаблон, который извлекает past а также future говорится строгое. Итак, кто-нибудь может придумать более приятный интерфейс?

Источник

5 ответов

Решение

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

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

Источник

Что касается реализации, я бы сделал из нее монаду Reader (для будущего) и монаду State (для прошлого / настоящего). Причина в том, что вы устанавливаете свое будущее только один раз (в 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

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

Источник

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

Источник

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

  • Загрузите данные в структуру, которая ссылается на другие узлы только по какому-то идентификатору. В примере это 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 ls@((Node n1 _) : _)) -> (n1, length ls)) tied
Источник

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

Мое общее решение для завязывания узла:

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

Тот example Решение в вашем блоге, где вы пишете что-н. как это:

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
Источник
Другие вопросы по тегам