投稿者: takatoh

原始的なピタゴラス数

互いに素である３数からなるピタゴラス数を原始的な（または素な）ピタゴラス数というらしい。

　cf. http://ja.wikipedia.org/wiki/%E3%83%94%E3%82%BF%E3%82%B4%E3%83%A9%E3%82%B9%E6%95%B0

これには公式があって，内包表記で次のように書ける。公式について詳しくは上のリンク先を見よ。
頭の p は primitive の p。それから let ～ も使ってみた。

pPythagorean a = [(m*m-n*n, 2*m*n, z) | m <- [1..a], n <- [1..a], m>n, let z = m*m+n*n, z <= a]
*Main> pPythagorean 100
[(3,4,5),(8,6,10),(5,12,13),(15,8,17),(12,16,20),(7,24,25),(24,10,26),(21,20,29)
,(16,30,34),(9,40,41),(35,12,37),(32,24,40),(27,36,45),(20,48,52),(11,60,61),(48
,14,50),(45,28,53),(40,42,58),(33,56,65),(24,70,74),(13,84,85),(63,16,65),(60,32
,68),(55,48,73),(48,64,80),(39,80,89),(28,96,100),(80,18,82),(77,36,85),(72,54,9
0),(65,72,97)]

z <= a を let z = ～ よりも前に書いてはいけない。Not in scope: `z’ だと怒られる。

リスト内包表記

リストを作るとき，要素を列挙したり範囲を指定するほかに，計算をしながら作ることもできる。
たとえば100以下の偶数のリストは

*Main> [x | x <- [1..100], x `mod` 2 == 0]
[2,4,6,8,10,12,14,16,18,20,22,24,26,28,30,32,34,36,38,40,42,44,46,48,50,52,54,56
,58,60,62,64,66,68,70,72,74,76,78,80,82,84,86,88,90,92,94,96,98,100]

| の左側がリストの要素，右側がその条件になる。条件には次のことが書ける。

  • パターン <- リスト
  • 真偽式
  • let パターン = 式

上の例では，パターン <- リスト と真偽式と使っている。３番目の let ～は「入門Haskell」には詳しい説明がないけど，「あまり使わない」とか書いてあるからそういうことにしとこう。

以下，練習。
三角数

triangular a = [n*(n+1)/2 | n <- [1..a]]
*Main> triangular 50
[1.0,3.0,6.0,10.0,15.0,21.0,28.0,36.0,45.0,55.0,66.0,78.0,91.0,105.0,120.0,136.0
,153.0,171.0,190.0,210.0,231.0,253.0,276.0,300.0,325.0,351.0,378.0,406.0,435.0,4
65.0,496.0,528.0,561.0,595.0,630.0,666.0,703.0,741.0,780.0,820.0,861.0,903.0,946
.0,990.0,1035.0,1081.0,1128.0,1176.0,1225.0,1275.0]

平方数

square a = [n*n | n <- [1..a]]
*Main> square 50
[1,4,9,16,25,36,49,64,81,100,121,144,169,196,225,256,289,324,361,400,441,484,529
,576,625,676,729,784,841,900,961,1024,1089,1156,1225,1296,1369,1444,1521,1600,16
81,1764,1849,1936,2025,2116,2209,2304,2401,2500]

ピタゴラス数

pythagorean a = [(x, y, z) | x <- [1..a], y <- [1..a], z <- [1..a], x < y, x*x + y*y == z*z]
*Main> pythagorean 50
[(3,4,5),(5,12,13),(6,8,10),(7,24,25),(8,15,17),(9,12,15),(9,40,41),(10,24,26),(
12,16,20),(12,35,37),(14,48,50),(15,20,25),(15,36,39),(16,30,34),(18,24,30),(20,
21,29),(21,28,35),(24,32,40),(27,36,45),(30,40,50)]

ピタゴラス数って結構あるんだな。

foldr と無限リスト

昨日の IO () さんのコメントから。

　cf. id:takatoh:20060514:myInits

えーと，つまり foldl は無限リストを扱えないけど， foldr は扱えるってことだな。foldl を使った版の myInits がダメだったのは last じゃなくて foldl のせいだってことだ。

それより，foldr は無限リストを扱えるって？

Prelude> foldr (:) [] [1..]
[1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,3
0,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,
57,58,59,60,61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83
,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,107

うわ，ホントだ。なんでだ。リストの右（後ろ）から評価するんじゃないのか。
うーん，”Yet Another Haskell Tutorial”を読んでみようか。英語は苦手なんだがなぁ……と思ったら id:moi2 さんのところに翻訳がある。ありがたい。該当個所はこのあたりか。

この中に foldr の評価過程の例がある。

foldr (-) 1 [4,8,5]
==> 4 – (foldr (-) 1 [8,5])
==> 4 – (8 – foldr (-) 1 [5])
==> 4 – (8 – (5 – foldr (-) 1 []))
==> 4 – (8 – (5 – 1))
==> 4 – (8 – 4)
==> 4 – 4
==> 0

上の例をこれと同じようにしてみると

foldr (:) [] [1..]
==> 1:(foldr (:) [] [2..])
==> 1:2:(foldr (:) [] [3..])
==> 1:2:3:(foldr (:) [] [4..])
==> 1:2:3:4:(foldr (:) [] [5..])
（以下無限に続く）

こんな感じになるはずで，無限リストを扱えるようには思えない。
いや，そうか，リストだから遅延評価されるんだ。だからうまくいくってことか。
ということは結果がリストにならないような場合にはうまくいかないはず。

Prelude> foldr (+) 0 [1..]
*** Exception: stack overflow

やっぱり。

myUnlines と myUnlines2

昨日の IO () さんからの宿題の回答。といっても myInits と myTails のほうはまだ解決してない。とりあえずわかったのから。

　cf. id:takatoh:20060513:exercise2

まずは myUnlines を１行で書くことから。これはリストの最後に空文字列をつけてやればいい。

myUnlines list = (concat . intersperse "\n") $ list ++ [""]
*Main> myUnlines ["abc","def","ghi"]
"abc\ndef\nghi\n"
*Main> myUnlines []
""

さらに，セクションにして合成してやれば引数も消せる。

myUnlines = (concat . intersperse "\n") . (++ [""])

じゃあ，次は fold を使って myUnlines2。foldr で右からつないでいけばいい。

myUnlines2 = foldr (\a b -> a ++ "\n" ++ b) ""
*Main> myUnlines2 ["abc","def","ghi"]
"abc\ndef\nghi\n"
*Main> myUnlines2 []
""

無名関数の引数を消すこともできる。

myUnlines2 = foldr ((++) . (++ "\n")) ""

けどかえって分かりにくいかな。

myInits （と myTails）

IO () さんから無限リストに対応できてない，と指摘を受けた myInits。これもできたと思う。

　cf. id:takatoh:20060513:exercise

昨日のは length を使って結果のリストの長さを決めてしまったのがいけなかった。これじゃ無限リストには対応できない。で，はじめは下の myTails と同様の考えで foldl を使って

myInits = foldl (\a b -> a ++ [last a ++ [b]]) [[]]

こうしたんだけど，やっぱり無限リストには対応できなかった。last を使ってるのがいけないのかな。
結局 zipWith を使った。

myInits xs = [] : zipWith (\a b -> a ++ [b]) (myInits xs) xs

これなら無限リストにも対応できるはずだし，zipWith はリストの終わりがくれば止まってくれる。さて，試してみよう。

*Main> myInits "abcde"
["","a","ab","abc","abcd","abcde"]
*Main> myInits ""
[""]
*Main> take 10 $ myInits [1..]
[[],[1],[1,2],[1,2,3],[1,2,3,4],[1,2,3,4,5],[1,2,3,4,5,6],[1,2,3,4,5,6,7],[1,2,3
,4,5,6,7,8],[1,2,3,4,5,6,7,8,9]]

よし，これならOK。ちゃんと無限リストに対応できてるし，先頭には空リストも付いてるな。ちなみに inits はこうだ。

Prelude List> inits "abcde"
["","a","ab","abc","abcd","abcde"]
Prelude List> inits ""
[""]
Prelude List> take 10 $ inits [1..]
[[],[1],[1,2],[1,2,3],[1,2,3,4],[1,2,3,4,5],[1,2,3,4,5,6],[1,2,3,4,5,6,7],[1,2,3
,4,5,6,7,8],[1,2,3,4,5,6,7,8,9]]

もう一つ，myTails。こっちはリストの最後に空リストがないところが違ってた。

myTails = foldr (\a b -> (a:head b):b) [[]]

結果。

*Main> myTails "abcde"
["abcde","bcde","cde","de","e",""]
*Main> myTails ""
[""]

ちなみに tails はこう。おんなじ。

Prelude List> tails "abcde"
["abcde","bcde","cde","de","e",""]
Prelude List> tails ""
[""]

OK。

パスカルの三角形

もう一つ思いついた。といっても「次の行」を作るところは一緒なんだけど。

　cf. id:takatoh:20060512:pascal （コメント欄も参照）

pascalTriangle = iterate (\xs -> zipWith (+) (0:xs) (xs ++ [0])) [1]

takeAndPut n = (((putStr . unlines) . map show) . take n)

結果。

*Main> takeAndPut 10 pascalTriangle
[1]
[1,1]
[1,2,1]
[1,3,3,1]
[1,4,6,4,1]
[1,5,10,10,5,1]
[1,6,15,20,15,6,1]
[1,7,21,35,35,21,7,1]
[1,8,28,56,70,56,28,8,1]
[1,9,36,84,126,126,84,36,9,1]

練習問題

「入門Haskell―はじめて学ぶ関数型言語」　p.78 より。

(1) filter，inits，tails，zip，zipWith を定義しなさい。

myFilter f [] = []
myFilter f (x:xs) | f x = x:myFilter f xs
                  | otherwise = myFilter f xs

myInits [] = []
myInits xs = map ((flip take) xs) [1..(length xs)]

myTails [] = []
myTails xs = map ((flip drop) xs) [0..(length xs -1)]

myZip _ [] = []
myZip [] _ = []
myZip (x:xs) (y:ys) = (x,y) : myZip xs ys

myZipWith f _ [] = []
myZipWith f [] _ = []
myZipWith f (x:xs) (y:ys) = f x y : myZipWith f xs ys

結果。

*Main> myFilter (> 0) [-2,-1,0,1,2]
[1,2]
*Main> myInits "abcde"
["a","ab","abc","abcd","abcde"]
*Main> myInits ""
[]
*Main> myTails "abcde"
["abcde","bcde","cde","de","e"]
*Main> myTails ""
[]
*Main> myZip [1,2,3] [1,2,3,4]
[(1,1),(2,2),(3,3)]
*Main> myZipWith (+) [1,2,3] [1,2,3,4]
[2,4,6]

myZip，myZipWith の余った要素が無視されるのは正しい動作。

(2) sum，product，and，or のそれぞれを fold 系を使って定義しなさい。

mySum :: (Num a) => [a] -> a
mySum = foldl (+) 0

myProduct :: (Num a) => [a] -> a
myProduct = foldl (*) 1

myAnd :: [Bool] -> Bool
myAnd = foldl (&&) True

myOr :: [Bool] -> Bool
myOr = foldl (||) False

結果。

*Main> mySum [1,2,3,4,5]
15
*Main> myProduct [1,2,3,4,5]
120
*Main> mySum []
0*Main> myProduct []
1
*Main> myAnd [True, False, True]
False
*Main> myAnd [True, True, True]
True
*Main> myOr [False, False, True]
True
*Main> myOr [False, False, False]
False

sum と product はそれぞれ 0，1 になる。

*Main> sum []
0*Main> product []
1

追記：
IO () さんから myInits が無限リストに対応できていないと指摘をもらった。コメント欄参照。
ああっ，本当だ。

*Main> take 10 $ map (take 1) $ myInits [1..]
GHC's heap exhausted: current limit is 268435456 bytes;
Use the `-M<size>' option to increase the total heap size.

ついでに気が付いたけど，inits の結果は先頭に空リストがあるじゃないか。この点でも違っている（これは「入門Haskell」も間違っている。p.75）。

Prelude List> inits "abcde"
["","a","ab","abc","abcd","abcde"]

えーと，もしかして tails も？

Prelude List> tails "abcde"
["abcde","bcde","cde","de","e",""]

……出直してきます。

練習問題（つづき）

「入門Haskell―はじめて学ぶ関数型言語」　p.78 より。

(3) unlines，unwords を intersperse を使って定義しなさい。また使わずに定義しなさい。

まずは使う方から。

myUnlines = (concat . intersperse "\n")

myUnwords = (concat . intersperse " ")

結果。

*Main> myUnlines ["abc","def","ghi"]
"abc\ndef\nghi"
*Main> myUnwords ["abc","def","ghi"]
"abc def ghi"

OK……とおもったら，unlines は一番最後にも改行文字が付くのか。

*Main> unlines ["abc","def","ghi"]
"abc\ndef\nghi\n"

そしたらこうか。あんまりきれいじゃないなぁ。

myUnlines [] = ""
myUnlines list = (concat . intersperse "\n") list ++ "\n"
*Main> myUnlines ["abc","def","ghi"]
"abc\ndef\nghi\n"

OK。

intersperse を使わないほう。これは似たようなことを前（cf. id:takatoh:20060413）にやった。

myUnlines2 [] = ""
myUnlines2 (x:xs) = x ++ "\n" ++ myUnlines2 xs

myUnwords2 [] = ""
myUnwords2 (x:[]) = x
myUnwords2 (x:xs) = x ++ " " ++ myUnwords2 xs

結果。

*Main> myUnlines2 ["abc","def","ghi"]
"abc\ndef\nghi\n"
*Main> myUnwords2 ["abc","def","ghi"]
"abc def ghi"

こっちはすんなりOK。

両替の組み合わせは？

id:a-san さんの両替するのに何通りあるか？に刺激されて，両替の組み合わせを列挙する enumChange をつくってみた。Maybe の扱いでちょっと苦労したよ。

　cf. http://d.hatena.ne.jp/a-san/20060508#p1

enumChange coins amount = map peel (cc amount 0)
    where
        cc amount kindsOfCoins
            | amount == 0 = [Just []]
            | (amount < 0) = [Nothing] | kindsOfCoins >= length coins = [Nothing]
            | otherwise =
                filterN ((cc amount (kindsOfCoins + 1)) ++
                       (divide faceOfCoin (cc (amount - faceOfCoins) kindsOfCoins)))
            where
                faceOfCoin = coins !! kindsOfCoins

divide a = map divide'
    where
        divide' x = case x of
            Just m -> Just (a:m)
            Nothing -> Nothing

filterN list = filter (\x -> x /= Nothing) list

peel x = case x of
             Just m -> m
             Nothing -> error "`Nothing' is found."

実行。

*Main> enumChange [10,5,1] 10
[[1,1,1,1,1,1,1,1,1,1],[5,1,1,1,1,1],[5,5],[10]]
*Main> length $ enumChange [10,5,1] 10
4

countChange は id:a-san さんのもの。

*Main> length $ enumChange [500,100,50,10,5,1] 100
159
*Main> countChange [500,100,50,10,5,1] 100
159
*Main> length $ enumChange [50,25,10,5,1] 100
292
*Main> countChange [50,25,10,5,1] 100
292
*Main> enumChange [500,100,50,10,5,1] 100
[[1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1],[5,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1],[5,
5,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1],[5,5,5,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1],[5,5,5,5,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
（以下略）

いけてるみたいだな。

以下，自分用のメモ。

  • cc は両替したコインの組み合わせのリストを返す。
  • amount == 0 ならうまくいった組み合わせなので，リストの終端としての空リストを返す。
  • (amont < 0)，kindsOfCoins >= length coins のときはその組み合わせがうまくいかないときなので Nothing。
  • (cc amount (kindsOfCoins + 1)) は kindsOfCoins のコインを１枚も使わない場合の組み合わせ。返ってくるリストには Nothing が混じっているから filterN で取り除いてやる。
  • (divide …) は kindsOfCoins のコインを１枚以上使う場合の組み合わせ。これは kindsOfCoins のコインを０枚以上使って (amount – faceOfCoin) を両替する場合の組み合わせのそれぞれに，kindsOfCoins を１枚追加して求めている。
  • cc の返すリストは Maybe [a] のリストだから peel で Maybe をはずす。

追記：
Data.Maybe に catMaybes という関数があった。わざわざ peel を作んなくてもよかったのか。
GHCi で使うなら :module Data.Maybe，プログラムで使うなら import Data.Maybe しておく。

Prelude Data.Maybe> :type catMaybes
catMaybes :: [Maybe a] -> [a]
Prelude Data.Maybe> catMaybes [Just 1, Just 2, Just 3]
[1,2,3]

Nothing は無視してくれるみたいだ。

Prelude Data.Maybe> catMaybes [Just 1, Nothing, Just 3]
[1,3]

ってことは filterN もいらないのか……orz