Skip to content

Instantly share code, notes, and snippets.

@cocoatomo

cocoatomo/MuseMember.hs

Forked from aiya000/MuseMember.hs
Last active Dec 20, 2016
Embed
What would you like to do?
import Data.Monoid
data Muse = HanayoKoizumi | RinHoshizora | MakiNishikino
| UmiSonoda | KotoriMinami | HonokaKosaka
| EliAyase | NicoYazawa | NozomiTojo
deriving (Eq, Ord, Enum, Show)
next :: Muse -> Muse
next HanayoKoizumi = RinHoshizora
next RinHoshizora = MakiNishikino
next MakiNishikino = UmiSonoda
next UmiSonoda = KotoriMinami
next KotoriMinami = HonokaKosaka
next HonokaKosaka = EliAyase
next EliAyase = NicoYazawa
next NicoYazawa = NozomiTojo
next NozomiTojo = HanayoKoizumi
prev :: Muse -> Muse
prev HanayoKoizumi = NozomiTojo
prev RinHoshizora = HanayoKoizumi
prev MakiNishikino = RinHoshizora
prev UmiSonoda = MakiNishikino
prev KotoriMinami = UmiSonoda
prev HonokaKosaka = KotoriMinami
prev EliAyase = HonokaKosaka
prev NicoYazawa = EliAyase
prev NozomiTojo = NicoYazawa
musePlus :: Muse -> Muse -> Muse
HanayoKoizumi `musePlus` HanayoKoizumi = HanayoKoizumi
HanayoKoizumi `musePlus` y = let y' = prev y
in next $ HanayoKoizumi `musePlus` y'
x `musePlus` y = let x' = prev x
in next $ x' `musePlus` y
instance Monoid Muse where
mempty = HanayoKoizumi
mappend = musePlus
class (Monoid g) => MyGroup g where
invert :: g -> g
museInvert :: Muse -> Muse
museInvert HanayoKoizumi = HanayoKoizumi
museInvert y = let y' = prev y
in prev $ museInvert y'
instance MyGroup Muse where
invert = museInvert
areSatisfyMonoidLaw :: Muse -> Muse -> Muse -> Bool
areSatisfyMonoidLaw x y z =
let isAssociative = (x <> y) <> z == x <> (y <> z)
unitExists = mempty <> x == x && x == x <> mempty
in isAssociative && unitExists
museIsMonoid :: Bool
museIsMonoid = foldr (&&) True $ do
x <- [HanayoKoizumi .. NozomiTojo]
y <- [HanayoKoizumi .. NozomiTojo]
z <- [HanayoKoizumi .. NozomiTojo]
return $ areSatisfyMonoidLaw x y z
satisfyGroupLaw :: Muse -> Bool
satisfyGroupLaw x =
let inverseExists = x <> invert x == mempty && invert x <> x == mempty
in inverseExists
museIsGroup :: Bool
museIsGroup = foldr (&&) True $ do
x <- [HanayoKoizumi .. NozomiTojo]
return $ satisfyGroupLaw x
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment