"不可操作"的应用函子示例？

Question

我在应用函子上声明了一个群。从我们通常所说的"动作"来判断，这样的组似乎可以使动作被撤消:

import Control.Applicative
class Alternative f => Undoable f where
undo :: f a -> f a

作为一个群，对于所有x :: Undoable f => f a，满足以下规律:

x <|> undo x ≡ empty
undo x <|> x ≡ empty

一些实例:

import Control.Arrow
import Data.Functor.Compose
import Data.Functor.Product
import Data.Proxy
instance Undoable Proxy where
undo _ = Proxy
instance (Undoable f, Applicative g) => Undoable (Compose f g) where
undo (Compose x) = Compose (undo x)
instance (Undoable f, Undoable g) => Undoable (Product f g) where
undo (Pair x y) = Pair (undo x) (undo y)
instance Undoable m => Undoable (Kleisli m a) where
undo (Kleisli f) = Kleisli (undo . f)

至少对我来说，这些实例不感兴趣。一些非实例包括:

• Maybe:一旦成功，无论其他选择如何，它都是成功的。

• []和ZipList:选项总是增加不确定性，而不是减少不确定性。

  • ReadP和ReadPrec:如上所示。

• IO:从字面上看，这个实例将是一个时间机器。尽管我们可以取现实在时空上的商，但有一个实际的反例:一个新的IORef不能被遗忘。

有没有特别有趣的Undoable实例?

Answer 1

我会考虑这样的事情。不是Prelude.Functor，因为键需要是可排序的(也可以是Hashable或只有Eq，你知道权衡)。

它基本上是一个允许负多重性的多集。反物质元素。

import qualified Data.Map as Map
import qualified Prelude as Hask
import Data.List (sortOn)
import Control.Category.Constrained.Prelude
import Control.Arrow.Constrained
import Control.Applicative.Constrained
data Dirac n k = Dirac { getOccurences :: Map.Map k n }
instance Real n => Functor (Dirac n) (Ord⊢(->)) (->) where
fmap (ConstrainedMorphism f) (Dirac m)
= Dirac . Map.fromAscList
. concatMap (((k,n₀):grp) -> case sum $ n₀ : map snd grp of
0 -> []
μ -> [(k,μ)] )
. groupBy (comparing fst)
. sortOn fst
. map (first f)
$ Map.toList m

instance Num n => Undoable (Dirac n) where
undo (Dirac m) = Dirac $ Map.map negate m

我认为可以在此基础上建立一个符合Applicative/Alternative，但我不完全确定。

Answer 2

任何单oid都可以提升为Alternative:

newtype ViaMonoid m a = ViaMonoid m
instance Monoid m => Applicative (ViaMonoid m) where
pure _ = ViaMonoid mempty
ViaMonoid f <*> ViaMonoid x = ViaMonoid (f <> x)
instance Monoid m => Alternative (ViaMonoid m) where
empty = ViaMonoid mempty
ViaMonoid m <|> ViaMonoid m' = ViaMonoid (m <> m')

任何组都可以提升到Undo:

class Monoid g => Group g where
-- law: g <> inverse g = inverse g <> g = mempty
inverse :: g -> g
instance Group g => Undoable (ViaMonoid g) where
undo (ViaMonoid m) = ViaMonoid (inverse m)

ViaMonoid也以更传统的名称Const而闻名，并且在例如lens和friends中使用效果很好。