読者です 読者をやめる 読者になる 読者になる

R(n)列挙

Haskell

て日々(6月1日)にあった問題.すこし考えたんだけど綺麗には書けず.ぐちゃぐちゃ.Natクラスのメソッドにしたり,禁断の unsafeCoerce を使ってしまった.

R(5)はちょっと長すぎるのでR(3)とR(4)を表示.

ghci> pprR three
"{0,{0},{{0}},{0,{0}}}"
ghci> pprR four
"{0,{0},{{0}},{0,{0}}
,{{{0}}},{0,{{0}}},{{0},{{0}}},{0,{0},{{0}}}
,{{0,{0}}},{0,{0,{0}}},{{0},{0,{0}}},{0,{0},{0,{0}}}
,{{{0}},{0,{0}}},{0,{{0}},{0,{0}}},{{0},{{0}},{0,{0}}},{0,{0},{{0}},{0,{0}}}}"

コードは以下のとおり.美しい書き方ぜひ教えてください.

{-# LANGUAGE TypeFamilies
            ,FlexibleContexts
            #-}

import Unsafe.Coerce

type family PSet n :: *
type instance PSet Zero     = [Zero]
type instance PSet (Succ n) = [PSet n]

class Nat n where
  type Pre  n :: *
  pre   :: n -> Pre n
  pre   =  undefined
  rset  :: n -> PSet n
  pprR  :: Show (PSet n) => n -> String
  pprR  =  pprPSet . show . rset

data Zero
data Succ n

instance Nat Zero where
  type Pre  Zero = Zero
  rset  = const []

instance Nat n => Nat (Succ n) where
  type Pre  (Succ n) = n
  rset = unsafeCoerce . pset . unsafeCoerce . rset . pre

instance Show Zero
instance Nat n => Show (Succ n)

type One   = Succ Zero
type Two   = Succ One
type Three = Succ Two
type Four  = Succ Three
type Five  = Succ Four

zero  :: Zero
one   :: One
two   :: Two
three :: Three
four  :: Four
five  :: Five
zero = undefined
one  = undefined
two  = undefined
three= undefined
four = undefined
five = undefined

pset :: [a] -> [[a]]
pset []     = [[]]
pset (x:xs) = xss /\/ map (x:) xss 
  where 
    xss = pset xs
    [] /\/ ys = ys
    (x:xs) /\/ ys = x : (ys /\/ xs)

pprPSet :: String -> String
pprPSet "" = ""
pprPSet ('[':']':s) = '0':pprPSet s
pprPSet ('[':s)     = '{':pprPSet s
pprPSet (']':s)     = '}':pprPSet s
pprPSet (c  :s)     = c  :pprPSet s