I have a typeclass Cyclic
for which I would like to be able to provide generic instances.
class Cyclic g where
gen :: g
rot :: g -> g
ord :: g -> Int
Given a sum type of nullary constructors,
data T3 = A | B | C deriving (Generic, Show)
I want to generate an instance equivalent to this:
instance Cyclic T3 where
gen = A
rot A = B
rot B = C
rot C = A
ord _ = 3
I've tried to work out the required Generic
machinery like so
{-# 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)
Now I can provide default implementations for Cyclic
using 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
but my GCyclic
instances are incorrect. Using T3
from above
λ. map rot [A, B, C] -- == [B, C, A]
[A, B, C]
It's clear why rot
is equivalent to id
here. grot
recurses down the (:+:)
structure of T3
until it hits the base case grot U1 = U1
.
It was suggested on #haskell
to make use of constructor information from M1
so grot
can choose the next constructor to recurse on, but I'm not sure how to do this.
Is it possible to generate the desired instances of Cyclic
using GHC.Generics
or some other form of Scrap Your Boilerplate?
EDIT: I could write Cyclic
using Bounded
and 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)
but (as is) this is unsatisfying, as it requires all of Bounded
, Enum
and Eq
. Additionally, Enum
cannot be automatically derived by GHC in some cases whereas the more robust Generic
can.
Edited after rereading what ord
is supposed to mean, and again to try to address the product of two cycles problem
You can figure out when to go to the other side of a sum of constructors if you can tell that whats inside is already at the last constructor, which is what the new end
and gend
functions do. I can't imagine a cyclic group for which we can't define end
.
You can implement gord
for sums without even examining the values; the ScopedTypeVariables
extension helps with this. I've changed the signatues to use proxies, since you're now mixing undefined
and trying to deconstruct a value in your code.
import Data.Proxy
Here's the Cyclic
class with end
, defaults, and Integral n
(instead of assuming Int
) for 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
And the GCyclic
class and its implementations:
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 ()))
I can't stress enough that the following is making an equivalence class over multiple cyclic subgroups of the product of the two cycles. Due to the need to detect ends for sums, and the face that the computations for lcm
and gcm
aren't lazy, we can no longer do fun stuff like derive a cyclic instance for [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 ()))
Here are some more example instances:
-- 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]
And some example code to run:
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 []
The fourth and fifth examples show off what's happening when we make an instance for the product of two cyclic groups whose orders are not coprime.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With