haskell - 使用 GHC.Generics 派生默认实例

Question

我有一个类型类 Cyclic我希望能够提供通用实例。

class Cyclic g where
    gen :: g
    rot :: g -> g
    ord :: g -> Int

给定一个 sum 类型的 nullary 构造函数，

data T3 = A | B | C deriving (Generic, Show)

我想生成一个与此等效的实例:

instance Cyclic T3 where
    gen   = A
    rot A = B
    rot B = C
    rot C = A
    ord _ = 3

我试图找出所需的 Generic像这样的机械

{-# LANGUAGE DefaultSignatures, FlexibleContexts, ScopedTypeVariables, TypeOperators #-}

import GHC.Generics

class GCyclic f where
    ggen :: f a
    grot :: f a -> f a
    gord :: f a -> Int

instance GCyclic U1 where
    ggen   = U1
    grot _ = U1
    gord _ = 1

instance Cyclic c => GCyclic (K1 i c) where
    ggen = K1 gen
    grot (K1 a) = K1 (rot a)
    gord (K1 a) = ord a

instance GCyclic f => GCyclic (M1 i c f) where
    ggen = M1 ggen
    grot (M1 a) = M1 (grot a)
    gord (M1 a) = gord a    

instance (GCyclic f, GCyclic g) => GCyclic (f :*: g) where
    ggen = ggen :*: ggen
    grot (a :*: b) = grot a :*: grot b
    gord (a :*: b) = gord a `lcm` gord b

instance (GCyclic f, GCyclic g) => GCyclic (f :+: g) where
    ggen = L1 ggen
    -- grot is incorrect
    grot (L1 a) = L1 (grot a) 
    grot (R1 b) = R1 (grot b)
    gord _ = gord (undefined :: f a)
           + gord (undefined :: g b)

现在我可以为 Cyclic 提供默认实现使用 GCyclic :

class Cyclic g where
    gen :: g
    rot :: g -> g
    ord :: g -> Int

    default gen :: (Generic g, GCyclic (Rep g)) => g
    gen = to ggen

    default rot :: (Generic g, GCyclic (Rep g)) => g -> g
    rot = to . grot . from

    default ord :: (Generic g, GCyclic (Rep g)) => g -> Int
    ord = gord . from

但我的 GCyclic实例不正确。使用 T3从上面

λ. map rot [A, B, C] -- == [B, C, A]
[A, B, C]

很清楚为什么 rot相当于 id这里。 grot向下递归 (:+:) T3的结构直到达到基本情况 grot U1 = U1 .

建议于 #haskell使用 M1 中的构造函数信息所以 grot可以选择下一个构造函数进行递归，但我不知道该怎么做。

是否可以生成所需的 Cyclic 实例？使用 GHC.Generics或其他形式的废品你的样板？

编辑:我可以写 Cyclic使用 Bounded和 Enum

class Cyclic g where
    gen :: g
    rot :: g -> g
    ord :: g -> Int

    default gen :: Bounded g => g
    gen = minBound

    default rot :: (Bounded g, Enum g, Eq g) => g -> g
    rot g | g == maxBound = minBound
          | otherwise     = succ g

    default ord :: (Bounded g, Enum g) => g -> Int
    ord g = 1 + fromEnum (maxBound `asTypeOf` g)

但是(原样)这并不令人满意，因为它需要所有 Bounded , Enum和 Eq .此外， Enum在某些情况下，GHC 无法自动导出，而更强大的 Generic能够。

Answer 1

重读后编辑ord应该意味着，再次尝试解决product of two cycles problem

如果你能知道里面的东西已经在最后一个构造函数中，你就可以知道什么时候去构造函数总和的另一边，这就是新的end。和 gend功能做。我无法想象我们无法定义的循环群end .

你可以实现gord求和，甚至不检查值； ScopedTypeVariables扩展有助于这一点。我已将签名更改为使用代理，因为您现在正在混合 undefined并尝试解构代码中的值。

import Data.Proxy

这是 Cyclic end 的类(class)、默认值和 Integral n (而不是假设 Int )对于 ord

class Cyclic g where
    gen :: g
    rot :: g -> g
    end :: g -> Bool
    ord :: Integral n => Proxy g -> n

    default gen :: (Generic g, GCyclic (Rep g)) => g
    gen = to ggen

    default rot :: (Generic g, GCyclic (Rep g)) => g -> g
    rot = to . grot . from

    default end :: (Generic g, GCyclic (Rep g)) => g -> Bool
    end = gend . from

    default ord :: (Generic g, GCyclic (Rep g), Integral n) => Proxy g -> n
    ord = gord . fmap from

和 GCyclic类及其实现:

class GCyclic f where
    ggen :: f a
    gend :: f a -> Bool
    grot :: f a -> f a
    gord :: Integral n => Proxy (f ()) -> n

instance GCyclic U1 where
    ggen   = U1
    grot _ = U1
    gend _ = True
    gord _ = 1

instance Cyclic c => GCyclic (K1 i c) where
    ggen        = K1 gen
    grot (K1 a) = K1 (rot a)
    gend (K1 a) = end a
    gord  _     = ord (Proxy :: Proxy c)

instance GCyclic f => GCyclic (M1 i c f) where
    ggen        = M1    ggen
    grot (M1 a) = M1   (grot a)
    gend (M1 a) = gend  a
    gord  _     = gord (Proxy :: Proxy (f ()))

我不能过分强调以下内容是对两个循环乘积的多个循环子组进行等价类。由于需要检测总和的结束，以及 lcm 的计算结果。和 gcm不是懒惰，我们不能再做一些有趣的事情，比如为 [a] 派生一个循环实例。 .

-- The product of two cyclic groups is a cyclic group iff their orders are coprime, so this shouldn't really work
instance (GCyclic f, GCyclic g) => GCyclic (f :*: g) where
    ggen           = ggen                          :*:  ggen
    grot (a :*: b) = grot  a                       :*:  grot  b
    gend (a :*: b) = gend  a                       &&   (any gend . take (gord (Proxy :: Proxy (f ())) `gcd` gord (Proxy :: Proxy (g ()))) . iterate grot) b
    gord  _        = gord (Proxy :: Proxy (f ())) `lcm` gord (Proxy :: Proxy (g ()))

instance (GCyclic f, GCyclic g) => GCyclic (f :+: g) where
    ggen        = L1 ggen
    grot (L1 a) = if gend a
                  then R1 (ggen)
                  else L1 (grot a)
    grot (R1 b) = if gend b
                  then L1 (ggen)
                  else R1 (grot b)
    gend (L1 _) = False
    gend (R1 b) = gend b
    gord  _     = gord (Proxy :: Proxy (f ())) + gord (Proxy :: Proxy (g ()))

以下是更多示例:

-- Perfectly fine instances
instance Cyclic ()
instance Cyclic Bool
instance (Cyclic a, Cyclic b) => Cyclic (Either a b)

-- Not actually possible (the product of two arbitrary cycles is a cyclic group iff they are coprime)
instance (Cyclic a, Cyclic b) => Cyclic (a, b)

-- Doesn't have a finite order, doesn't seem to be a prime transfinite number.
-- instance (Cyclic a) => Cyclic [a]

以及一些要运行的示例代码:

typeOf :: a -> Proxy a
typeOf _ = Proxy

generate :: (Cyclic g) => Proxy g -> [g]
generate _ = go gen
    where
        go g = if end g
               then [g]
               else g : go (rot g)

main = do
    print . generate . typeOf $ A
    print . map rot . generate . typeOf $ A
    putStrLn []

    print . generate $ (Proxy :: Proxy (Either T3 Bool))
    print . map rot . generate $ (Proxy :: Proxy (Either T3 Bool))
    putStrLn []

    print . generate . typeOf $ (A, False)
    print . map rot . generate . typeOf $ (A, False)
    putStrLn []

    print . generate . typeOf $ (False, False)
    print . map rot . generate . typeOf $ (False, False)
    print . take 4 . iterate rot $ (False, True)
    putStrLn []

    print . generate $ (Proxy :: Proxy (Either () (Bool, Bool)))
    print . map rot . generate $ (Proxy :: Proxy (Either () (Bool, Bool)))
    print . take 8 . iterate rot $ (Right (False,True) :: Either () (Bool, Bool))
    putStrLn []

第四个和第五个例子展示了当我们为两个非互质的循环群的乘积创建一个实例时发生了什么。