R(n)列挙
て日々(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
1to100penさんのヒントにより書いたもの
data List = Nil | List ::: List を使った.
Python 読めないので,Pythonの解と同じかどうかは良くわからない.
data List = Nil | List ::: List r :: Int -> List r 0 = Nil r n = powerset (r (n-1)) powerset :: List -> List powerset Nil = Nil ::: Nil powerset (xs ::: ys) = yss >< mapL (xs :::) yss where yss = powerset ys mapL :: (List -> List) -> List -> List mapL f Nil = Nil mapL f (h ::: t) = f h ::: mapL f t infixr 5 ><, ::: (><) :: List -> List -> List (xs ::: ys) >< zs = xs ::: (zs >< ys) Nil >< zs = zs instance Show List where show = pprL pprL :: List -> String pprL = flip pprh' "" where pprh' Nil = zr pprh' (h ::: t) = ob . nl . sp . pprh h . nl . pprt' t . cb pprh Nil = zr pprh (h ::: t) = ob . pprh h . pprt t . cb pprt' Nil = id pprt' (h ::: t) = cm . pprh h . nl . pprt' t pprt Nil = id pprt (h ::: t) = cm . pprh h . pprt t nl = ('\n':); ob = ('{':); cb = ('}':); cm = (',':); zr = ('0':); sp = (' ':)