Probrem 21

今日は Probrem 21 をやってみた。

 cf. http://projecteuler.net/index.php?section=problems&id=21

数 n に対して約数(nを含まない)すべてを足しあわせる関数 d があるとして,d(a) = b かつ d(b) = a となるような a と b (ただしa≠b)を amicable pair,それぞれを amicable number という(んだそうだ)。で,10000未満の amicable number をすべて足しあわせろ,という問題。
内包表記大活躍……なのはいいけど,すっげー時間がかかる。10000未満なんてやったら待ってられないので,下のコードでは1000未満にしてある。いい方法はないだろうか。

module Main (main) where

d :: Int -> Int
d n = sum [x | x <- [1..(n `div` 2)], n `mod` x == 0]

euler021 :: Int -> Int
euler021 n = sum $ map (\(a,b) -> a + b) pairs
  where
    pairs = [(a,b) | a <- [1..n], b <- [1..n], a < b, d a == b, d b == a]

main :: IO ()
main = print $ euler021 1000
^o^ >euler021.exe
504

1000未満では 220 と 284 のペアしかないみたいだ。

追記:

いい方法はないだろうか,と書いたらコメントやらトラックバックやらでいろいろ教えてくれた。ありがとうございます。

 cf. http://haskell.g.hatena.ne.jp/nobsun/20080314/p1

おおっ,速い!

追記2:

ううっ,うっかりとエントリに上書きして消してしまった。できるだけ復元したけど元のエントリとは少し違ってるかも。

Project Euler

ってのがあるのか。

 cf. http://projecteuler.net/index.php
 via Life Goes On – はじめました

気が向いたときにはやってみるかな。
とりあえず Problem 1 を内包表記で。

euler0001 :: Int -> Int
euler0001 n = sum [x | x <- [1..(n-1)], or [x `mod` 3 == 0, x `mod` 5 == 0]]

main :: IO ()
main = print $ euler0001 1000
^o^ >runhaskell euler0001.hs
233168

コラッツ予想

cf. Way of My Life – コラッツ予想

Haskell と OCaml でやってみた。
与えられた数から1になるまでをリストで返す。

collatz :: Int -> [Int]
collatz 1 = 1 : []
collatz n | n `mod` 2 == 0 = n : collatz (n `div` 2)
          | otherwise = n : collatz (n * 3 + 1)
*Main> collatz 19
[19,58,29,88,44,22,11,34,17,52,26,13,40,20,10,5,16,8,4,2,1]

割り算には値を整数で返す div を使っている。はじめ / を使ったら型があわずにエラーになった。

今度は OCaml 版。やってることはおんなじ。

let rec collatz = function
    1 -> 1 :: []
    | n when n mod 2 = 0 -> n :: collatz (n / 2)
    | n -> n :: collatz (n * 3 + 1)
# collatz 19;;
- : int list =
[19; 58; 29; 88; 44; 22; 11; 34; 17; 52; 26; 13; 40; 20; 10; 5; 16; 8; 4; 2; 1]

データの整列

どう書く?.orgに投稿した。

cf. データの整列

sort_by_dic が辞書順に整列する関数,sort_by_dis が距離の昇順に整列する関数。

type point = Point of float * float
let compare_point a b =
match (a, b) with
(Point (x1, y1), Point (x2, y2)) -> if x1 = x2 then compare y1 y2
else compare x1 x2
let distance = function
Point (x, y) -> sqrt (x *. x +. y *. y)
let sort_by_dic = List.sort compare_point
let sort_by_dis = List.sort (fun a b -> compare (distance a) (distance b))

実行結果,辞書順:

# sort_by_dic [Point (3.2, 1.9); Point (3.2, 0.3); Point (1.2, 3.5)];;
- : point list = [Point (1.2, 3.5); Point (3.2, 0.3); Point (3.2, 1.9)]

距離の昇順:

# sort_by_dis [Point (3.2, 1.9); Point (3.2, 0.3); Point (1.2, 3.5)];;
- : point list = [Point (3.2, 0.3); Point (1.2, 3.5); Point (3.2, 1.9)]

データの整列(Haskell版)

同じことをHaskellで。Ordクラスのインスタンスにしたら sortByDic はただの sort ですんだ。

import List

data Point = Pt Float Float deriving (Show, Eq, Ord)

distance :: Point -> Float
distance (Pt x y) = sqrt (x * x + y * y)

sortByDic :: [Point] -> [Point]
sortByDic = sort

sortByDis :: [Point] -> [Point]
sortByDis = List.sortBy (\p1 p2 -> compare (distance p1) (distance p2))

実行結果,辞書順:

*Main> sortByDic [Pt 3.2 1.9, Pt 3.2 0.3, Pt 1.2 3.5]
[Pt 1.2 3.5,Pt 3.2 0.3,Pt 3.2 1.9]

距離の昇順:

*Main> sortByDis [Pt 3.2 1.9, Pt 3.2 0.3, Pt 1.2 3.5]
[Pt 3.2 0.3,Pt 1.2 3.5,Pt 3.2 1.9]

モジュールの定義

モジュール(正確にはストラクチャ)の定義は次のようにして,struct と endo のあいだに各種定義の書く。

# module Tree =
struct
type 'a t = Lf | Br of 'a * 'a t * 'a t
let rec size = function
Lf -> 0
| Br (_, left, right) -> 1 + size left + size right
let rec depth = function
Lf -> 0
| Br (_, left, right) -> 1 + max (depth left) (depth right)
end
;;

モジュールの中に書けるのは:

  • 変数束縛
  • 関数宣言
  • type による型宣言
  • exception宣言
  • open宣言
  • module定義(入れ子)

さて,対話環境で上のようにモジュール定義をすると次のような応答が返ってくる。

module Tree :
sig
type 'a t = Lf | Br of 'a * 'a t * 'a t
val size : 'a t -> int
val depth : 'a t -> int
end

これはシグネチャといって,いってみればモジュールの型というべきもの。これについてはまた後で書く。

シグネチャ

前のエントリの例のようにシグネチャをコンパイラに推論させるのではなく,自分で書くこともできる。そのとき,モジュールの外部には公開したくない関数や,定義した型の詳細を隠蔽することもできる。一般には:

  • シグネチャを定義する
  • そのシグネチャをモジュールに与える

という手順を踏む。

たとえば次のようにモジュールを定義したとする。

# module Table =
struct
type ('a, 'b) t = Empty | Entry of 'a * 'b * ('a, 'b) t
let empty = Empty
let add key datum table = Entry (key, datum, table)
let rec retrieve key = function
Empty -> None
| Entry (key', datum, rest) ->
if key = key' then Some datum else retrieve key rest
let rec delete key = function
Empty -> Empty
| Entry (key', datum, rest) ->
if key = key' then delete key rest
else Entry (key', datum, delete key rest)
let rec dump = function
Empty -> []
| Entry (key, datum, rest) ->
(key, datum) :: (dump (delete key rest))
end;;
module Table :
sig
type ('a, 'b) t = Empty | Entry of 'a * 'b * ('a, 'b) t
val empty : ('a, 'b) t
val add : 'a -> 'b -> ('a, 'b) t -> ('a, 'b) t
val retrieve : 'a -> ('a, 'b) t -> 'b option
val delete : 'a -> ('a, 'b) t -> ('a, 'b) t
val dump : ('a, 'b) t -> ('a * 'b) list
end

見てわかるとおり,データ型ひとつと関数を4つ定義している。

さて,ここで Table.t型の詳細とdelete関数を隠すことにする(ついでに書いておくとこのように詳細の隠されたデータ型を抽象データ型という)。隠すには単にシグネチャに書かなければいい。具体的にはデータ型定義の = 以降の部分と,delete関数の定義部分だ。

シグネチャを定義するには module type宣言を使う。

# module type TABLE1 =
sig
type ('a, 'b) t
val empty : ('a, 'b) t
val add : 'a -> 'b -> ('a, 'b) t -> ('a, 'b) t
val retrieve : 'a -> ('a, 'b) t -> 'b option
val dump : ('a, 'b) t -> ('a * 'b) list
end;;
module type TABLE1 =
sig
type ('a, 'b) t
val empty : ('a, 'b) t
val add : 'a -> 'b -> ('a, 'b) t -> ('a, 'b) t
val retrieve : 'a -> ('a, 'b) t -> 'b option
val dump : ('a, 'b) t -> ('a * 'b) list
end

このシグネチャを与えて新しい Table1モジュールを定義する。といっても実態はTableモジュールとおなじだ。

# module Table1 : TABLE1 = Table;;
module Table1 : TABLE1

これで実体は同じだけどシグネチャの違うモジュールができた。2つを比べてみよう。

# Table.empty;;
- : ('a, 'b) Table.t = Table.Empty
# Table1.empty;;
- : ('a, 'b) Table1.t = <abstr>

Table1の方はデータ型か <abstr> になっている。これは抽象データ型を表している。

# Table.retrieve;;
- : 'a -> ('a, 'b) Table.t -> 'b option = <fun>
# Table1.retrieve;;
- : 'a -> ('a, 'b) Table1.t -> 'b option = <fun>

retrieve関数には両方ともアクセスできる。

# Table.delete;;
- : 'a -> ('a, 'b) Table.t -> ('a, 'b) Table.t = <fun>
# Table1.delete;;
Characters 0-13:
Table1.delete;;
^^^^^^^^^^^^^
Unbound value Table1.delete

Table1.delete はダメ。

open宣言

モジュールの関数を使うときには[モジュール名].[関数名]とするけど,open宣言をすればモジュール名をつけなくても使えるようになる。

# map (fun x -> x * x) [1;2;3;4];;
Characters 0-3:
map (fun x -> x * x) [1;2;3;4];;
^^^
Unbound value map
# open List;;
# map (fun x -> x * x) [1;2;3;4];;
- : int list = [1; 4; 9; 16]

複数のモジュールをopenしたとき,同じ名前の関数がある場合には後からopenしたモジュールの関数だけが使えるようになる。たとえば,map関数は ListモジュールにもArrayモジュールにもあるけど,次のようにするとArrayモジュールのほうだけが使える。

# open List;;
# open Array;;
# map (fun x -> x * 10) [|1;2;3;4|];;
- : int array = [|10; 20; 30; 40|]

↑Arrayのmapは使える。↓Listのmapは使えない。

# map (fun x -> x * 10) [1;2;3;4];;
Characters 22-31:
map (fun x -> x * 10) [1;2;3;4];;
^^^^^^^^^
This expression has type 'a list but is here used with type int array

モジュール名をつけてやれば使える。

# List.map (fun x -> x * 10) [1;2;3;4];;
- : int list = [10; 20; 30; 40]

FizzBuzz

出力も覚えたし書いてみた。

let fizzbuzz x =
let f = if x mod 3 = 0 then "Fizz" else "" in
let b = if x mod 5 = 0 then "Buzz" else "" in
let fb = f ^ b in
if fb = "" then string_of_int x else fb
;;
let () = for i = 1 to 100 do
print_endline (fizzbuzz i)
done
;;

実行結果は省略するけど,うまくいったとだけ書いておく。