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
プログラムの書き方を忘れる
4月はコードを書かなかった.すっかりコードの書き方を忘れてる.orz
自然数対の整列列挙
であるようなが与えられとき,を満す自然数対をで変換したときの大きさの順にならべたリストを生成するプログラムを書け
[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
ライフハック本を買ってしまう
いわゆるライフハック本というのを買ってしまう.
- 「それ前に読んだろ?」
- 「どんなことが書いてあったか忘れたから」
- 「忘れるようなハックが役に立つのか?」
- 「役に立つかもしれないことが書いてあったと思うんだよな」
何か問題があるという不安はまちがいなくあるが,
何が問題なのかが判らない.
何を解決しなければならないのかが判らない.
という状態を何とかしたいのか.
で?『銀「色」の弾丸』があったような気がするというわけか.
ライフハック本を読んで,何かの不安が解消したことはあったのか.
たぶん,あったのだろう.本を読んだだけで不安が有耶無耶になるのだ.
しかし,不安の源が断たれたわけではないので,そのうちまた不安が頭をもたげる.
ライフハッカー[日本版] 辛そうで辛くない人生と仕事が少し楽になる本
- 作者: ライフハッカー[日本版]編集部
- 出版社/メーカー: 朝日新聞出版
- 発売日: 2011/02/18
- メディア: 単行本
- 購入: 4人 クリック: 258回
- この商品を含むブログ (17件) を見る
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