Faire le noeud avec une monade d'état

Question

Je suis en train de travailler sur un Haskell projet qui consiste à attacher un grand noeud: je suis de l'analyse d'une représentation sérialisée d'un graphe où chaque nœud est à un certain décalage dans le fichier, et peut faire référence à un autre nœud par son décalage. J'ai donc besoin de construire une carte à partir de compensation des nœuds lors de l'analyse, qui, je peux nourrir à moi-même dans un do rec bloc.

J'ai ce travail, et un peu-sorta-raisonnablement abstrait dans un StateT-esque monade transformateur:

{-# 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'

L' tie fonction est où la magie se produit: l'appel à l' runRecStateT produit une valeur et un état, qui je le nourrir que de son propre avenir. Notez que get vous permet de lire à la fois le passé et l'avenir des états, mais put seulement permet de modifier le "présent".

Question 1: est-ce à sembler comme une manière décente pour mettre en œuvre ce nouage modèle en général? Ou mieux encore, quelqu'un a mis en œuvre une solution générale à ce que j'ai négligé lors de l'espionnage à travers Hackage? J'ai battu ma tête contre l' Cont monade pour un certain temps, car il semblait peut-être plus élégant (voir poste similaire de Dan Burton), mais je ne pouvais tout simplement pas travailler.

Totalement subjective de la Question 2: je ne suis pas totalement heureux avec la façon dont mon code d'appel se termine à la recherche:

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

Détails de mise en œuvre ici omis, évidemment, le point important étant que je dois obtenir l' past et future état, modèle correspondre à l'intérieur d'une liaison let (ou explicitement, l'ancien patron de paresseux) pour en extraire ce que je me soucie, puis construire mon nœud, mise à jour de mon état, et enfin retourner le nœud. Semble inutilement verbeux, et j'ai surtout l'aversion combien il est facile de faire accidentellement le motif que des extraits de l' past et future états stricte. Donc, quelqu'un peut-il penser à une interface plus conviviale?

Answer 1

J'ai écrit un article sur ce sujet à la rubrique Assemblage: Programmation circulaire avec méthode récursive où je décris deux méthodes pour construire un assembleur en nouant. Comme votre problème, un assembleur doit être capable de résoudre l'adresse des étiquettes pouvant apparaître ultérieurement dans le fichier.

Answer 2

Concernant la mise en œuvre, je voudrais faire une composition d'un Lecteur de monade (pour l'avenir) et un État de monade (passé/présent). La raison en est que vous définissez votre avenir qu'une seule fois (en tie), puis de ne pas le modifier.

{-# 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

Concernant votre deuxième question, il faudrait les aider à connaître votre flux de données (c'est à dire d'avoir un exemple minimal de votre code). Ce n'est pas vrai que le strict modèles conduisent toujours à des boucles. Il est vrai que vous avez besoin d'être prudent afin de ne pas créer une non-production de la boucle, mais l'exacte restrictions dépendent de ce que et comment vous êtes en train de construire.

Answer 3

J'ai été jouer avec des trucs, et je pense que je suis venu avec quelque chose... d'intéressant. Je l'appelle le "Prophète" monade, et il fournit (en dehors de Monade opérations) deux opérations primitives:

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

et une opération d'exécution:

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

La façon dont cette monade œuvres, c'est qu' see permet un devin pour voir tout, et send permet à un voyant pour "envoyer" de l'information à tous les autres voyants pour eux de voir. Chaque fois qu'un voyant effectue l' see d'exploitation, ils sont en mesure de voir toutes les informations qui vous a été envoyé, et tous les renseignements qui seront envoyés. En d'autres termes, à l'intérieur d'un terme, see produira toujours le même résultat, peu importe où et quand vous l'appelez. Une autre façon de le dire est qu' see est de savoir comment vous obtenez un travail de référence pour le "lié" le noeud.

C'est en fait très similaire à seulement à l'aide de fix, sauf que toutes les sous-parties sont ajoutés progressivement et de manière implicite plutôt qu'explicite. Évidemment, les voyants ne fonctionnent pas correctement en présence d'un paradoxe, et suffisamment de paresse est nécessaire. Par exemple, see >>= send peut provoquer une explosion de l'information, de piégeage, de vous dans une boucle temporelle.

Un muet exemple:

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]

Comme je l'ai dit, j'ai juste pensé autour, donc je n'ai aucune idée si c'est mieux que ce que vous avez, ou si c'est tout bon à tous! Mais c'est chouette, et pertinentes, et si votre "noeud" de l'état est un Monoid, alors il pourrait être utile pour vous. Fair warning: j'ai construit Seer à l'aide d'un Tardis.

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

Answer 4

Je suis un peu débordé par la quantité de l'utilisation de la Monade. Je ne pourrais pas comprendre le passé/avenir les choses, mais je suppose que vous essayez juste pour exprimer le paresseux+fixpoint de liaison. (Corrigez-moi si je me trompe.) L' RWS Monade utilisation avec R=W est une sorte de drôle, mais vous n'avez pas besoin de l' State et de la loop, lorsque vous pouvez faire de même avec fmap. Il n'y a pas de point à l'aide de Monades si elles ne rendent pas les choses plus faciles. (Très peu de Monades représentent l'ordre chronologique, de toute façon.)

Ma solution générale d'attacher le noeud:

1. Je parse tout à une Liste de nœuds,
2. convertir une liste en Data.Vector pour O(1) accès à la boîte (=paresseux) des valeurs,
3. lier ce résultat à un nom à l'aide d' let ou fix ou mfix de la fonction,
4. d'accès et le nom de Vecteur à l'intérieur de l' analyseur. (voir 1.)

---

Qu' example solution dans votre blog, où vous écrire qqch. comme ceci:

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)

J'aurais écrit de cette manière:

{-# 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)

ou moins:

{-# 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

Answer 5

J'ai eu un problème similaire récemment, mais j'ai choisi une approche différente. Une structure de données récursive peut être représenté comme un type de point fixe sur un type de données foncteur. Le chargement des données peut alors être divisé en deux parties:

• Charger les données dans une structure qui fait référence à d'autres nœuds seulement par une sorte d'identifiant. Dans l'exemple c'est Loader Int (NodeF Int), qui construit une carte des valeurs de type NodeF Int Int.
• Attacher le noeud par la création d'une structure de données récursive en remplaçant les identificateurs de données réelles. Dans l'exemple de la résultante des structures de données de type Fix (NodeF Int), et ils sont par la suite convertis à l' Node Int pour des raisons de commodité.

Il en manque une bonne gestion des erreurs, etc., mais l'idée devrait être clair de cette.

-- 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