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 = (' ':)

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

自然数対の整列列挙

 x_1 \le x_2 \quad\wedge\quad y_1 \le y_2 \quad\Rightarrow\quad f(x_1,y_1) \le f(x_2,y_2)であるような fが与えられとき, a,b \in \mathbb{N} \quad\wedge\quad 1 \le a \le bを満す自然数 (a,b) fで変換したときの大きさの順にならべたリストを生成するプログラムを書け

[id:route150:20110501#1304207462]に綺麗な解が.それをすこしアレンジして写経した.

enumerate :: (Integral a, Ord b) => ((a,a) -> b) -> [(a,a)]
enumerate f = foldr1 (mergeTail f) [[(x,y) | y <- [x..]] | x <- [1..]]

mergeTail :: (Ord b) => (a -> b) -> [a] -> [a] -> [a]
mergeTail f (x:xs) yys = x : mergeBy f xs yys
mergeTail _ xxs    []  = xxs
mergeTail _ []     yys = yys

mergeBy :: (Ord b) => (a -> b) -> [a] -> [a] -> [a]
mergeBy f xxs@(x:xs) yys@(y:ys)
  | f x <= f y = x : mergeBy f xs yys
  | otherwise  = y : mergeBy f xxs ys
mergeBy _ [] yys = yys
mergeBy _ xxs [] = xxs

ライフハック本を買ってしまう

いわゆるライフハック本というのを買ってしまう.

  • 「それ前に読んだろ?」
  • 「どんなことが書いてあったか忘れたから」
  • 「忘れるようなハックが役に立つのか?」
  • 「役に立つかもしれないことが書いてあったと思うんだよな」

何か問題があるという不安はまちがいなくあるが,
何が問題なのかが判らない.
何を解決しなければならないのかが判らない.

という状態を何とかしたいのか.
で?『銀「色」の弾丸』があったような気がするというわけか.

ライフハック本を読んで,何かの不安が解消したことはあったのか.
たぶん,あったのだろう.本を読んだだけで不安が有耶無耶になるのだ.
しかし,不安の源が断たれたわけではないので,そのうちまた不安が頭をもたげる.

ライフハッカー[日本版] 辛そうで辛くない人生と仕事が少し楽になる本

ライフハッカー[日本版] 辛そうで辛くない人生と仕事が少し楽になる本

EOMは確かによい習慣だな.

Type Family (型族)

型族って何?と聞かれたんだけど上手く説明できない.どんなときに便利なの?と聞かれたんだけどそれはHaskell WiKi読めってことで.
で,まぁ無益なプログラムなら,以下のような型だけがあって実体のない(上手い表現を思いつかない)プログラムの例を書ける.
型だけで自然数を定義して,型だけで加法,乗法,べき乗,階乗計算を定義してみました.型族が型の関数であることがわかると思う.この定義では,たとえば,:+: は加法になる.ほんとうに型だけだと,何も見えない「あの世」プログラミングになってしまうので,「浮世(Real World)」プログラミングにするために,Integerという実体のある型の値を使って計算結果を「見える化」してある.

{-# LANGUAGE TypeFamilies
            ,EmptyDataDecls
            ,TypeOperators
            ,FlexibleInstances
            ,OverlappingInstances
            ,UndecidableInstances 
            #-}

module Main where

main :: IO ()
main = print (undefined :: Three :^: Two)

class Nat n where
  toNum :: n -> Integer

instance Nat n => Show n where
  show = show . toNum

data Zero
data Succ n

prev :: Succ n -> n
prev = undefined

type One   = Succ Zero
type Two   = Succ One
type Three = Succ Two
type Four  = Two :+: Two

instance Nat Zero where
  toNum = const 0

instance Nat n => Nat (Succ n) where
  toNum = succ . toNum . prev

type family m :+: n :: *
type instance Zero   :+: n = n
type instance Succ m :+: n = Succ (m :+: n)

type family m :*: n :: *
type instance Zero   :*: n = Zero
type instance Succ m :*: n = n :+: (m :*: n)

type family m :^: n :: *
type instance m :^: Zero   = One
type instance m :^: Succ n = m :*: (m :^: n)

type family Fact n :: *
type instance Fact Zero = One
type instance Fact (Succ n) = Succ n :*: Fact n

割り算を使わない篩

割り算は使ってないけど,sieve のやっている比較が試し割に相当している?

(変更)名前を整理

module Prime (primes,primes') where

import Data.List

primes :: [Integer]
primes = concat primes'

primes' :: [[Integer]]
primes' = [2]:[3]:map fst (iterate collect ([5,7],[6*x+y | x<-[2..],y<-[-1,1]]))

collect :: ([Integer],[Integer]) -> ([Integer],[Integer])
collect (ps,qs) = (ps',qs')
  where
    ((_,qs'),pss) = mapAccumL gatherAndSieve (ps,qs) ps
    ps' = concat pss
    gatherAndSieve (xxs@(x:xs),yys) _ = ((xs,yys'),xxs')
      where
        (xxs',zzs) = span (x^2>) yys
        yys' = sieve (map (x*) (xxs++yys)) zzs
        sieve xxs@(x:xs) yys@(y:ys) 
            | x > y     = y : sieve xxs ys
            | otherwise = sieve xs ys