haskell - Atar el nudo con una mónada de estado

tying-the-knot monadfix

Question

Estoy trabajando en un proyecto de Haskell que implica atar un nudo grande: estoy analizando una representación serializada de un gráfico, donde cada nodo está en cierta desviación en el archivo, y puede hacer referencia a otro nodo por su desplazamiento. Así que tengo que crear un mapa de desplazamientos a nodos durante el análisis, que puedo retroalimentarme a mí mismo en un bloque do rec .

Tengo esto funcionando, y algo así como razonablemente abstraído en un transformador de mónada State StateT State:

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

La función de tie es donde ocurre la magia: la llamada a runRecStateT produce un valor y un estado, que alimentarlo como su propio futuro. Tenga en cuenta que get permite leer tanto del estado pasado como del futuro, pero put solo le permite modificar el "presente".

Pregunta 1 : ¿Esto parece una forma decente de implementar este patrón de nudo en general? O mejor aún, ¿alguien ha implementado una solución general a esto, que pasé por alto al husmear a través de Hackage? Me golpeé la cabeza contra la mónada Cont por un tiempo, ya que parecía posiblemente más elegante (ver publicación similar de Dan Burton), pero no pude resolverlo.

Totalmente subjetiva Pregunta 2 : No estoy muy entusiasmado con la forma en que mi código de llamada termina buscando:

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

Detalles de implementación aquí omitidos, obviamente, el punto importante es que tengo que obtener el estado past y future , alinearlos en un enlace de let (o hacer explícitamente que el patrón anterior sea flojo) para extraer todo lo que me importa, luego construir mi nodo , actualiza mi estado y finalmente devuelve el nodo. Parece innecesariamente detallado, y particularmente me desagrada lo fácil que es hacer accidentalmente el patrón que extrae los estados past y future . Entonces, ¿alguien puede pensar en una interfaz más agradable?

Answer 1

Con respecto a la implementación, la convertiría en una composición de una mónada Reader (para el futuro) y una mónada estatal (para pasado / presente). La razón es que configuras tu futuro solo una vez (en tie ) y luego no lo cambias.

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

Con respecto a su segunda pregunta, sería útil conocer su flujo de datos (es decir, tener un ejemplo mínimo de su código). No es cierto que los patrones estrictos siempre conducen a bucles. Es cierto que debe tener cuidado para no crear un ciclo que no produzca, pero las restricciones exactas dependen de qué y cómo esté creando.

Answer 2

Escribí un artículo sobre este tema en la Asamblea titulada : Programación Circular con Recursivo, donde describo dos métodos para construir un ensamblador utilizando nudos. Al igual que su problema, un ensamblador tiene que poder resolver la dirección de las etiquetas que pueden aparecer más adelante en el archivo.

Answer 3

Estoy un poco abrumado por la cantidad de uso de Monad. Puede que no entienda las cosas pasadas / futuras, pero supongo que solo estás tratando de expresar el enlace perezoso + punto fijo. (Corrígeme si estoy equivocado). El uso de RWS Monad con R = W es algo divertido, pero no necesitas el State y el loop , cuando puedes hacer lo mismo con fmap . No tiene sentido usar las Mónadas si no facilitan las cosas. (De todos modos, solo unas pocas mónadas representan el orden cronológico).

Mi solución general para atar el nudo:

1. Analizo todo en una lista de nodos,
2. convertir esa lista a un Data.Vector para O (1) acceder a valores encasillados (= flojos),
3. enlazar ese resultado a un nombre usando let o la función fix o mfix ,
4. y acceder a ese Vector llamado dentro del analizador . ( ver 1.)

Esa solución de example en tu blog , donde escribes algo. Me gusta esto:

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)

Yo habría escrito de esta manera:

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

o más corto:

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

He estado jugando con cosas, y creo que he encontrado algo ... interesante. Lo llamo la mónada "Vidente" y proporciona (aparte de las operaciones de Mónada) dos operaciones primitivas:

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

y una operación de ejecución:

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

La forma en que funciona esta mónada es que see permite que un vidente vea todo , y send permite a un vidente "enviar" información a todos los demás videntes para que la vean. Cada vez que un vidente realiza la operación de see , puede ver toda la información que se ha enviado y toda la información que se enviará. En otras palabras, en una ejecución determinada, see siempre producirá el mismo resultado, sin importar dónde o cuándo lo llame. Otra forma de decirlo es que see cómo obtiene una referencia de trabajo para el nudo "atado".

En realidad, esto es muy similar a usar fix , excepto que todas las subpartes se agregan incremental e implícitamente, en lugar de explícitamente. Obviamente, los videntes no funcionarán correctamente en presencia de una paradoja, y se requiere suficiente pereza. Por ejemplo, see >>= send puede causar una explosión de información, atrapándote en un ciclo de tiempo.

Un tonto ejemplo:

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]

Como dije, solo he estado jugando, así que no tengo idea si esto es mejor que lo que tienes, o si es bueno en absoluto. Pero es ingenioso y relevante, y si su estado de "nudo" es un Monoid , entonces podría serle útil. Advertencia justa: construí Seer usando un Tardis .

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

Answer 5

Recientemente tuve un problema similar, pero elegí un enfoque diferente. Una estructura de datos recursiva se puede representar como un punto fijo de tipo en un funtor de tipo de datos. La carga de datos se puede dividir en dos partes:

• Cargue los datos en una estructura que haga referencia a otros nodos solo mediante algún tipo de identificador. En el ejemplo, es Loader Int (NodeF Int) , que construye un mapa de valores de tipo NodeF Int Int .
• Haga un nudo creando una estructura recursiva de datos reemplazando los identificadores con datos reales. En el ejemplo, las estructuras de datos resultantes tienen el tipo Fix (NodeF Int) , y luego se convierten a Node Int para su comodidad.

Falta un manejo adecuado de errores, etc., pero la idea debe quedar clara a partir de eso.

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