haskell - rae - Atravesando con un Biapplicativo.

atravesar o atravezar rae

Question

Estaba pensando en descomprimir las operaciones y me di cuenta de que una forma de expresarlas es atravesar un funtor Biapplicative .

import Data.Biapplicative
class Traversable2 t where
traverse2 :: Biapplicative p
=> (a -> p b c) -> t a -> p (t b) (t c)
-- Note: sequence2 :: [(a,b)] -> ([a], [b])
sequence2 :: (Traversable2 t, Biapplicative p)
=> t (p b c) -> p (t b) (t c)
sequence2 = traverse2 id
instance Traversable2 [] where
traverse2 _ [] = bipure [] []
traverse2 f (x : xs) = bimap (:) (:) (f x) <<*>> traverse2 f xs

Me huele como si cada instancia de Traversable se pudiera transformar mecánicamente en una instancia de Traversable2 . Pero todavía no he encontrado una manera de implementar realmente traverse2 usando traverse , a menos que se convierta en listas y se pueda jugar o quizás unsafeCoerce jugando trucos muy sucios con unsafeCoerce . ¿Hay una buena manera de hacer esto?

Otra evidencia de que todo lo Traversable es Traversable2 :

class (Functor t, Foldable t) => Traversable2 t where
traverse2 :: Biapplicative p
=> (a -> p b c) -> t a -> p (t b) (t c)
default traverse2 ::
(Biapplicative p, Generic1 t, GTraversable2 (Rep1 t))
=> (a -> p b c) -> t a -> p (t b) (t c)
traverse2 f xs = bimap to1 to1 $ gtraverse2 f (from1 xs)
class GTraversable2 r where
gtraverse2 :: Biapplicative p
=> (a -> p b c) -> r a -> p (r b) (r c)
instance GTraversable2 V1 where
gtraverse2 _ x = bipure (case x of) (case x of)
instance GTraversable2 U1 where
gtraverse2 _ _ = bipure U1 U1
instance GTraversable2 t => GTraversable2 (M1 i c t) where
gtraverse2 f (M1 t) = bimap M1 M1 $ gtraverse2 f t
instance (GTraversable2 t, GTraversable2 u) => GTraversable2 (t :*: u) where
gtraverse2 f (t :*: u) = bimap (:*:) (:*:) (gtraverse2 f t) <<*>> gtraverse2 f u
instance (GTraversable2 t, GTraversable2 u) => GTraversable2 (t :+: u) where
gtraverse2 f (L1 t) = bimap L1 L1 (gtraverse2 f t)
gtraverse2 f (R1 t) = bimap R1 R1 (gtraverse2 f t)
instance GTraversable2 (K1 i c) where
gtraverse2 f (K1 x) = bipure (K1 x) (K1 x)
instance (Traversable2 f, GTraversable2 g) => GTraversable2 (f :.: g) where
gtraverse2 f (Comp1 x) = bimap Comp1 Comp1 $ traverse2 (gtraverse2 f) x
instance Traversable2 t => GTraversable2 (Rec1 t) where
gtraverse2 f (Rec1 xs) = bimap Rec1 Rec1 $ traverse2 f xs
instance GTraversable2 Par1 where
gtraverse2 f (Par1 p) = bimap Par1 Par1 (f p)

Answer 1

Creo que podría tener algo que se ajuste a su factura. (Edición: no, vea los comentarios). Puede definir newtypes sobre p () c y pb () y hacer que sean instancias de Functor .

Implementación

Aquí está tu clase otra vez con definiciones por defecto. Seguí la ruta de implementación de sequence2 en términos de sequenceA porque parecía más simple.

class Functor t => Traversable2 t where
{-# MINIMAL traverse2 | sequence2 #-}
traverse2 :: Biapplicative p => (a -> p b c) -> t a -> p (t b) (t c)
traverse2 f = sequence2 . fmap f
sequence2 :: Biapplicative p => t (p b c) -> p (t b) (t c)
sequence2 = traverse2 id

Ahora, la "parte derecha" del Biapplicative es

newtype R p c = R { runR :: p () c }
instance Bifunctor p => Functor (R p) where
fmap f (R x) = R $ bimap id f x
instance Biapplicative p => Applicative (R p) where
pure x = R (bipure () x)
R f <*> R x =
let f'' = biliftA2 const (flip const) (bipure id ()) f
in R $ f'' <<*>> x
mkR :: Biapplicative p => p b c -> R p c
mkR = R . biliftA2 const (flip const) (bipure () ())
sequenceR :: (Traversable t, Biapplicative p) => t (p b c) -> p () (t c)
sequenceR = runR . sequenceA . fmap mkR

con la "parte izquierda" de la misma manera. El código completo está en esta esencia .

Ahora podemos hacer p (tb) () y p () (tc) y reensamblarlos en p (tb) (tc) .

instance (Functor t, Traversable t) => Traversable2 t where
sequence2 x = biliftA2 const (flip const) (sequenceL x) (sequenceR x)

Necesitaba activar FlexibleInstances y UndecidableInstances para esa declaración de instancia. Además, de alguna manera, ghc quería un Functor constaint.

Pruebas

Verifiqué con su instancia para [] que da los mismos resultados:

main :: IO ()
main = do
let xs = [(x, ord x - 97) | x <- [''a''..''g'']]
print xs
print (sequence2 xs)
print (sequence2'' xs)
traverse2'' :: Biapplicative p => (a -> p b c) -> [a] -> p [b] [c]
traverse2'' _ [] = bipure [] []
traverse2'' f (x : xs) = bimap (:) (:) (f x) <<*>> traverse2 f xs
sequence2'' :: Biapplicative p => [p b c] -> p [b] [c]
sequence2'' = traverse2'' id

salidas

[(''a'',0),(''b'',1),(''c'',2),(''d'',3),(''e'',4),(''f'',5),(''g'',6)]
("abcdefg",[0,1,2,3,4,5,6])
("abcdefg",[0,1,2,3,4,5,6])

¡Este fue un ejercicio divertido!

Answer 2

Lo siguiente parece hacer el truco, explotando "solo" undefined . Posiblemente las leyes aplicables garanticen que esto está bien, pero no he intentado probarlo.

{-# LANGUAGE GADTs, KindSignatures, TupleSections #-}
import Data.Biapplicative
import Data.Traversable
data Bimock :: (* -> * -> *) -> * -> * where
Bimock :: p a b -> Bimock p (a,b)
Bimfmap :: ((a,b) -> c) -> p a b -> Bimock p c
Bimpure :: a -> Bimock p a
Bimapp :: Bimock p ((a,b) -> c) -> p a b -> Bimock p c
instance Functor (Bimock p) where
fmap f (Bimock p) = Bimfmap f p
fmap f (Bimfmap g p) = Bimfmap (f . g) p
fmap f (Bimpure x) = Bimpure (f x)
fmap f (Bimapp gs xs) = Bimapp (fmap (f .) gs) xs
instance Biapplicative p => Applicative (Bimock p) where
pure = Bimpure
Bimpure f<*>xs = fmap f xs
fs<*>Bimpure x = fmap ($x) fs
fs<*>Bimock p = Bimapp fs p
Bimfmap g h<*>Bimfmap i xs = Bimfmap (/(~(a₁,a₂),~(b₁,b₂)) -> g (a₁,b₁) $ i (a₂, b₂))
$ bimap (,) (,) h<<*>>xs
Bimapp g h<*>xs = fmap uncurry g <*> ((,)<$>Bimock h<*>xs)
runBimock :: Biapplicative p => Bimock p (a,b) -> p a b
runBimock (Bimock p) = p
runBimock (Bimfmap f p) = bimap (fst . f . (,undefined)) (snd . f . (undefined,)) p
runBimock (Bimpure (a,b)) = bipure a b
runBimock (Bimapp (Bimpure f) xs) = runBimock . fmap f $ Bimock xs
runBimock (Bimapp (Bimfmap h g) xs)
= runBimock . fmap (/(~(a₂,a₁),~(b₂,b₁)) -> h (a₂,b₂) (a₁,b₁))
. Bimock $ bimap (,) (,) g<<*>>xs
runBimock (Bimapp (Bimapp h g) xs)
= runBimock . (fmap (/θ (~(a₂,a₁),~(b₂,b₁)) -> θ (a₂,b₂) (a₁,b₁)) h<*>)
. Bimock $ bimap (,) (,) g<<*>>xs
traverse2 :: (Biapplicative p, Traversable t) => (a -> p b c) -> t a -> p (t b) (t c)
traverse2 f s = runBimock . fmap (/bcs->(fmap fst bcs, fmap snd bcs)) $ traverse (Bimock . f) s
sequence2 :: (Traversable t, Biapplicative p)
=> t (p b c) -> p (t b) (t c)
sequence2 = traverse2 id

E incluso si esto es seguro, no me sorprendería si diera un rendimiento horrible, ¿qué pasa con los patrones irrefutables y la acumulación de árboles de tupla en forma cuadrática (o incluso exponencial)?

Answer 3

Una forma leve de hacer esto es usar algo como Magma from lens . Esto parece considerablemente más simple que la solución de la izquierda, aunque tampoco es hermosa.

data Mag a b t where
Pure :: t -> Mag a b t
Map :: (x -> t) -> Mag a b x -> Mag a b t
Ap :: Mag a b (t -> u) -> Mag a b t -> Mag a b u
One :: a -> Mag a b b
instance Functor (Mag a b) where
fmap = Map
instance Applicative (Mag a b) where
pure = Pure
(<*>) = Ap
traverse2 :: forall t a b c f. (Traversable t, Biapplicative f)
=> (a -> f b c) -> t a -> f (t b) (t c)
traverse2 f0 xs0 = go m m
where
m :: Mag a x (t x)
m = traverse One xs0
go :: forall x y. Mag a b x -> Mag a c y -> f x y
go (Pure t) (Pure u) = bipure t u
go (Map f x) (Map g y) = bimap f g (go x y)
go (Ap fs xs) (Ap gs ys) = go fs gs <<*>> go xs ys
go (One x) (One y) = f0 x
go _ _ = error "Impossible"

Answer 4

Unas pocas observaciones, menos que una respuesta completa y original.

Si tiene un Biapplicative Biapplicativo, lo que puede hacer con él es aplicarlo a algo y separarlo en un par de bifuntores isomorfos a sus dos componentes.

data Helper w a b = Helper {
left :: w a (),
right :: w () b
}
runHelper :: forall p a b. Biapplicative p => Helper p a b -> p a b
runHelper x = biliftA2 const (flip const) (left x) (right x)
makeHelper :: (Biapplicative p)
=> p a b -> Helper p a b
makeHelper w = Helper (bimap id (const ()) w)
(bimap (const ()) id w)
type Separated w a b = (w a (), w () b)

Sería posible combinar los enfoques de @nnnmmm y @leftroundabout aplicando fmap (makeHelper . f) a la estructura s , eliminando la necesidad de undefined , pero luego necesitaría que Helper o su reemplazo sean una instance de algún tipo de clase. Las operaciones útiles que te permiten resolver el problema.

Si tiene una estructura de Traversable , lo que puede hacer es la sequenceA Applicative funtores Applicative (en cuyo caso, su solución se verá como traverse2 f = fromHelper . sequenceA . fmap (makeHelper . f) , donde su instancia del Applicative construye un par de estructuras t ) o traverse usando un Functor (en cuyo caso, la solución se verá como traverse2 f = fromHelper . traverse (g . makeHelper . f) where ...). De cualquier manera, necesita definir una instancia de Functor , ya que Applicative hereda de Functor . Puede intentar construir su Functor partir de <<*>> e bipure id id , o bimap , o puede trabajar en ambas variables separadas en el mismo paso.

Desafortunadamente, para hacer que los tipos funcionen para la instancia de Functor , debe paramaterizar :: pbc a un tipo al que llamaríamos informalmente :: w (b,c) donde un parámetro es el producto cartesiano de los dos parámetros de p . El sistema de tipos de Haskell no parece permitir esto sin extensiones no estándar, pero @leftroundabout lo logra con la clase Bimock . usando undefined para forzar a ambos functores separados a tener el mismo tipo.

Para el rendimiento, lo que desea hacer es no hacer más de un recorrido, lo que produce un objeto isomórfico a p (tb) (tc) que luego puede convertir (similar a la ley de Naturalidad). Por lo tanto, desea implementar traverse2 lugar de sequence2 y definir sequence2 como traverse2 id , para evitar el desplazamiento doble. Si se separan las variables y se produce algo isomorfo en (p (tb) (), p () (tc)) , puede combinarlas como lo hace @mmmnnn.

En el uso práctico, sospecho que desearía imponer alguna estructura adicional al problema. Su pregunta mantuvo completamente libres los componentes b del Bifunctor , pero en la práctica generalmente serán funtores covariantes o contravariantes que pueden secuenciarse con biliftA2 o atravesarse juntos en un Bitraversable lugar de Traversable t , o tal vez incluso tener un Semigroup . Instancia Applicative o Monad .

Una optimización particularmente eficiente sería si su p es isomorfo a un Monoid cuya operación <> produce una estructura de datos isomorfa a su t . (Esto funciona para listas y árboles binarios; Data.ByteString.Builder es un tipo algebraico que tiene esta propiedad). En este caso, la asociatividad de la operación le permite transformar la estructura en un pliegue izquierdo estricto o un pliegue derecho perezoso.

Esta fue una excelente pregunta, y aunque no tengo mejor código que @leftroundabout para el caso general, aprendí mucho de trabajar en ello.