プログラミングの基礎

https://gyazo.com/13d7bca87da12d13c88818ffec9b94d5

OCamlを使ったプログラミングの入門書。

デザインレシピの考え方が素晴らしかった。

授業のビデオはこちら

デザインレシピはこちらにまとめようかな？

OCamlの環境構築手順はこちら

覚え書き

変数定義（14ページ）

code:ocaml

utop # let pi = 3.1415;;

val pi : float = 3.1415

utop # pi;;

- : float = 3.1415

utop # pi *. 2.0;;

- : float = 6.283

関数定義（20ページ）

code:baito_kyuyo.ml

(* baito_kyuyo.ml *)

let baito_kyuyo n j =

let jikyu = 850 + (n * 100) in

jikyu * j

(* test *)

let () =

assert ((baito_kyuyo 0 0) = 0);

assert ((baito_kyuyo 0 1) = 850);

assert ((baito_kyuyo 1 1) = 950);

assert ((baito_kyuyo 1 2) = 1900);

print_string "ok";

print_newline ()

ocamlコマンドで実行

code:sh

$ ocaml baito_kyuyo.ml

ok

$

code:ocaml

val baito_kyuyo : int -> int -> int = <fun>

ok

(* NGならアサーションにひっかかかった行数が表示される *)

val baito_kyuyo : int -> int -> int = <fun>

Exception: Assert_failure ("baito_kyuyo.ml", 9, 2).

自己紹介（21ページ）

code:jikoshokai.ml

(* jikoshokai.ml *)

let jikoshokai name =

"ワタシ ノ ナマエハ " ^ name ^ "。コンゴトモ ヨロシク。"

let () =

print_string (jikoshokai "chikuwax");

print_newline ()

実行してみる

code:sh

$ ocaml jikoshokai.ml

ワタシ ノ ナマエハ chikuwax。コンゴトモ ヨロシク。

$

鶴亀算 (31ページ)

code:tsurukame.ml

(* 目的: 鶴の匹数 n に応じた鶴の足の数を計算する *)

(* tsuru_no_ashi n = int -> int *)

let tsuru_no_ashi n = n * 2

(* 目的: 亀の匹数 n に応じた亀の足の数を計算する *)

(* kame_no_ashi n = int -> int *)

let kame_no_ashi n = n * 4

(* 目的: 鶴の匹数 t と亀の匹数 k に応じた鶴亀の足の数を計算する *)

(* tsurukame_no_ashi t k = int -> int -> int *)

let tsurukame_no_ashi t k = (tsuru_no_ashi t) + (kame_no_ashi k)

(* 目的: 鶴亀の匹数 n と鶴亀の足の数 a から鶴の数を計算する *)

(* tsurukame n a = int -> int -> int *)

let rec tsurukame n a =

if (tsurukame_no_ashi n 0) = a then

n

else

tsurukame (n - 1) (a - (kame_no_ashi 1))

let test1 = (tsuru_no_ashi 0) = 0

let test2 = (tsuru_no_ashi 1) = 2

(* カッコは無くても大丈夫 *)

let test3 = tsuru_no_ashi 2 = 4

let test4 = kame_no_ashi 0 = 0

let test5 = kame_no_ashi 1 = 4

let test6 = kame_no_ashi 2 = 8

let test7 = tsurukame_no_ashi 0 0 = 0

let test8 = tsurukame_no_ashi 1 0 = 2

let test9 = tsurukame_no_ashi 0 1 = 4

let test10 = tsurukame_no_ashi 1 1 = 6

let test11 = tsurukame_no_ashi 2 2 = 12

let test12 = tsurukame 0 0 = 0

let test13 = tsurukame 1 2 = 1

let test14 = tsurukame 1 4 = 0

let test15 = tsurukame 2 6 = 1

let test16 = tsurukame 3 6 = 3

let test17 = tsurukame 3 10 = 1

let test18 = tsurukame 3 12 = 0

(* assert するならこんな感じ *)

let test1 = tsuru_no_ashi 0 = 0

let _ = assert test1

組（タプル）

code:ocaml

utop # (3.14, 2.71);;

- : float * float = (3.14, 2.71)

utop # (3.14, 2.71, 1.31);;

- : float * float * float = (3.14, 2.71, 1.31)

utop # (1, "hatakeyama", 17);;

- : int * string * int = (1, "hatakeyama", 17)

パターンマッチ

code:ocaml

utop # match (3, 5) with

(a, b) -> a + b;;

- : int = 8

(* パターンマッチを使ってタプルから値を取り出す *)

utop # let add pair =

match pair with

(a, b) -> a + b;;

val add : int * int -> int = <fun>

utop # add (5, 3);;

- : int = 8

(* 関数定義の引数部分にパターンを書ける *)

utop # let add (a, b) = a + b;;

val add : int * int -> int = <fun>

utop # add (3, 5);;

- : int = 8

(* 座標aと座標bを足す *)

utop # let add (ax, ay) (bx, by) = (ax + bx, ay + by);;

val add : int * int -> int * int -> int * int = <fun>

utop # add (1, 2) (3, 4);;

- : int * int = (4, 6)

構造データに対するデザインレシピ（54ページ）

テンプレート

入力が構造データの場合は、その中身を取り出すmatch文を作る

レコード（58ページ）

code:ocaml

utop # type user_t = { name : string; age : int };;

type user_t = { name : string; age : int; }

utop # { name = "thata"; age = 17 };;

- : user_t = {name = "thata"; age = 17}

utop #

レコードとパターンマッチ

code:ocaml

utop # let greeting user = match user with

{ name = n; age = a } -> "私の名前は" ^ n ^ "です。年齢は" ^ (string_of_int a) ^ "です。";;

val greeting : user_t -> string = <fun>

utop # greeting { name = "はたけやま"; age = 17 };;

- : string = "私の名前ははたけやまです。年齢は17です。"

(* パターンマッチを使わない方法もある *)

utop # let greeting user = "私の名前は" ^ user.name ^ "です。年齢は" ^ (string_of_int user.age) ^ "です。";;

val greeting : user_t -> string = <fun>

utop # greeting { name = "はたけやま"; age = 17 };;

- : string = "私の名前ははたけやまです。年齢は17です。"

問題 8.3 と問題 8.4

code:ocaml

type person_t = { name: string; height: int; weight: int; birth_month: int; birth_day: int; blood_type: string };;

let person1 = { name = "alice"; height = 130; weight = 20; birth_month = 12; birth_day = 25; blood_type = "A" };;

let person2 = { name = "bob"; height = 140; weight = 30; birth_month = 4; birth_day = 1; blood_type = "B" };;

let person3 = { name = "carol"; height = 150; weight = 40; birth_month = 11; birth_day = 29; blood_type = "O" };;

(* 受け取った person_t の血液型を知らせるメッセージを返す *)

(* ketsueki_hyoji person = person_t -> string *)

utop # let ketsueki_hyoji person = match person with

{name = n; blood_type = bt } -> n ^ "さんの血液型は" ^ bt ^ "型です";;

val ketsueki_hyoji : person_t -> string = <fun>

utop # ketsueki_hyoji person1;;

- : string = "aliceさんの血液型はA型です"

utop # ketsueki_hyoji person2;;

- : string = "bobさんの血液型はB型です"

utop # ketsueki_hyoji person3;;

- : string = "carolさんの血液型はO型です"

駅名と駅間の情報の定義（67ページ）

code:ocaml

(* 駅名 *)

type ekimei_t = {kanji: string; kana: string; romaji: string; shozoku: string}

let eki1 = {kanji = "茗荷谷"; kana = "みょうがだに"; romaji = "MYOGADANI"; shozoku = "丸ノ内線"};;

code:ocaml

(* 渡された ekimei_t の「路線名、駅名（かな）」を返す *)

(* let hyouji ekimei = ekimei_t -> string *)

let hyouji ekimei = match ekimei with

{ kanji = kj; kana = kn; shozoku = s } -> s ^ "、" ^ kj ^ "（" ^ kn ^ "）"

let hyouji_test1 = hyouji eki1 = "丸ノ内線、茗荷谷（みょうがだに）"

駅間（69ページ）

起点の駅名

終点の駅名

距離

路線名

所要時間

code:ocaml

(* 駅間 *)

type ekikan_t = {

kiten: string; (* 起点の駅名 *)

shuten: string; (* 終点の駅名 *)

keiyu: string; (* 経由する路線名 *)

kyori: float; (* 距離（km、実数）*)

jikan: int (* 所要時間 （分、整数）*)

}

リスト（70ページ）

code:ocaml

utop # 1 :: [];;

utop # 1 :: 2 :: [];;

(* 問題9.1 *)

(* 問題9.2 *)

utop # type person_t = { name: string; height: int; weight: int; birth_month: int; birth_day: int; blood_type: string };;

type person_t = {

name : string;

height : int;

weight : int;

birth_month : int;

birth_day : int;

blood_type : string;

}

utop # let person1 = { name = "alice"; height = 130; weight = 20; birth_month = 12; birth_day = 25; blood_type = "A" };;

val person1 : person_t =

{name = "alice"; height = 130; weight = 20; birth_month = 12; birth_day = 25;

blood_type = "A"}

utop # let person2 = { name = "bob"; height = 140; weight = 30; birth_month = 4; birth_day = 1; blood_type = "B" };;

val person2 : person_t =

{name = "bob"; height = 140; weight = 30; birth_month = 4; birth_day = 1;

blood_type = "B"}

utop # let person3 = { name = "carol"; height = 150; weight = 40; birth_month = 11; birth_day = 29; blood_type = "O" };;

val person3 : person_t =

{name = "carol"; height = 150; weight = 40; birth_month = 11; birth_day = 29;

blood_type = "O"}

- : person_t list =

[{name = "alice"; height = 130; weight = 20; birth_month = 12; birth_day = 25;

blood_type = "A"};

{name = "bob"; height = 140; weight = 30; birth_month = 4; birth_day = 1;

blood_type = "B"};

{name = "carol"; height = 150; weight = 40; birth_month = 11; birth_day = 29;

blood_type = "O"}]

再帰関数 （78ページ）

code:ocaml

(* リストに 0 が含まれているか調べる *)

let rec contain_zero lst =

match lst with

| [] -> false

| 0 :: rest -> true

| _ :: rest -> contain_zero rest

let contain_zero_test1 = contain_zero [] = false

(* リストの含まれる整数の合計を計算する *)

let rec sum lst =

match lst with

| [] -> 0

| head :: rest -> head + sum rest

let sum_test1 = sum [] = 0

(* リストの長さを返す *)

let rec length lst = match lst with [] -> 0 | head :: rest -> 1 + length rest

let length_test1 = length [] = 0

(* リスト中の偶数の要素を返す *)

let rec even lst =

match lst with

| [] -> []

| head :: rest -> if (head mod 2) = 0 then head :: even rest else even rest

let even_test1 = even [] = []

テンプレートの複合（85ページ）

code:ocaml

type gakusei_t = { name: string; tensuu: int; seiseki: string }

let gakusei1 = { name = "alice"; tensuu = 90; seiseki = "A" }

let gakusei2 = { name = "bob"; tensuu = 70; seiseki = "B" }

let gakusei3 = { name = "carol"; tensuu = 50; seiseki = "C" }

let gakusei4 = { name = "dave"; tensuu = 100; seiseki = "A" }

(* 成績Aの生徒の人数を数える *)

let rec count_A lst =

match lst with

| [] -> 0

| { name = n; tensuu = t; seiseki = s } :: rest

-> if s = "A" then 1 + count_A rest

else count_A rest

let count_a_test1 = count_A [] = 0

駅名リストと駅間リストの整備（89ページ）

再帰関数を使ったプログラミング（91ページ）

code:ocaml

(* 配列内の接頭語の先頭に整数 n を追加する（？？？） *)

let rec add_to_each n lst =

match lst with

[] -> []

| first :: rest

-> (n :: first) :: (add_to_each n rest)

let test1 = add_to_each 1 [] = []

(* 受け取った lst の接頭語のリストを求める（？？？） *)

let rec prefix lst =

match lst with

[] -> []

| first :: rest

let test4 = prefix [] = []

(* 問題 10.1 *)

挿入ソート（94ページ）

code:ocaml

(* 問題 10.1 *)

(* 昇順に並んでいる整数にリストに整数 n を照準となる位置に挿入する *)

let rec insert lst n =

match lst with

| first :: rest

->

if n < first then n :: first :: rest

else first :: (insert rest n)

(* 問題 10.2 *)

let rec ins_sort lst =

match lst with

| [] -> []

| first :: rest -> insert (ins_sort rest) first

let test_ins_sort = ins_sort [] = []

リストの中の最小値を求める関数（95ページ）

code:ocaml

(* 渡されたリストの中の整数のうち最小値を返す *)

let rec minimum lst =

match lst with

| [] -> max_int

| first :: rest ->

let min = minimum rest in

if first < min then first

else min

パターンマッチつき局所変数定義（99ページ）

code:ocaml

type gakusei_t = { name: string; tensuu: int; seiseki: string }

let gakusei1 = { name = "alice"; tensuu = 90; seiseki = "A" }

let gakusei2 = { name = "bob"; tensuu = 70; seiseki = "B" }

let gakusei3 = { name = "carol"; tensuu = 50; seiseki = "C" }

let gakusei4 = { name = "dave"; tensuu = 100; seiseki = "A" }

let gakusei5 = { name = "eve"; tensuu = 10; seiseki = "D" }

(* A, B, C, Dの各成績の学生の人数を集計する *)

let rec shukei lst =

match lst with

[] -> (0, 0, 0, 0)

| { name = n; tensuu = t; seiseki = s } :: rest ->

let (a, b, c, d) = shukei rest in

match s with

"A" -> (a + 1, b, c, d)

| "B" -> (a, b + 1, c, d)

| "C" -> (a, b, c + 1, d)

| "D" | _ -> (a, b, c, d + 1)

let test11 = shukei [] = (0, 0, 0, 0)

ふたつのリストを結合する関数（102ページ）

code:ocaml

(* ふたつのリストを結合して返す *)

let rec append lst1 lst2 =

match lst1 with

[] -> lst2

| first :: rest -> first :: append rest lst2

let test16 = append [] [] = []

ふたつの昇順に並んだリストをマージする関数（103ページ）

code:ocaml

(* ふたつの昇順に並んだリストをマージして返す *)

let rec merge lst1 lst2 =

match (lst1, lst2) with

| ([], []) -> []

| (first1 :: rest1, []) -> lst1

| ([], first2 :: rest2) -> lst2

| (first1 :: rest1, first2 :: rest2)

-> if first1 < first2 then first1 :: merge rest1 lst2

else first2 :: merge lst1 rest2

let test = merge [] [] = []

駅名・駅間リストからの情報の取得（105ページ）

code:ocaml

(* ローマ字で駅を検索し、その駅の漢字表記を文字列で返す *)

let rec romaji_to_kanji _romaji lst =

match lst with

| [] -> ""

| {kanji; romaji} :: rest

->

if romaji = _romaji then kanji

else romaji_to_kanji _romaji rest

let test = romaji_to_kanji "heiwadai" global_ekimei_list = "平和台"

let test = romaji_to_kanji "foo" global_ekimei_list = ""

(* 指定した駅間の距離を返す *)

let rec get_ekikan_kyori _kiten _shuten lst =

match lst with

| [] -> infinity

| {kiten; shuten; kyori} :: rest

->

if (kiten = _kiten && shuten = _shuten) || (kiten = _shuten && shuten = _kiten) then kyori

else get_ekikan_kyori _kiten _shuten rest

let test = get_ekikan_kyori "駒込" "西ヶ原" global_ekikan_list = 1.4

let test = get_ekikan_kyori "西ヶ原" "駒込" global_ekikan_list = 1.4

let test = get_ekikan_kyori "西ヶ原" "駒込" [] = infinity

(* ローマ字の駅名ふたつを受け取って距離を表示 *)

let rec kyori_wo_hyoji kiten_romaji shuten_romaji =

let kiten_kanji = romaji_to_kanji kiten_romaji global_ekimei_list in

let shuten_kanji = romaji_to_kanji shuten_romaji global_ekimei_list in

let ekikan_kyori = get_ekikan_kyori kiten_kanji shuten_kanji global_ekikan_list in

if kiten_kanji = "" then kiten_romaji ^ "という駅は存在しません"

else if shuten_kanji = "" then shuten_romaji ^ "という駅は存在しません"

else if ekikan_kyori = infinity then kiten_kanji ^ "駅と" ^ shuten_kanji ^ "駅はつながっていません"

else kiten_kanji ^ "駅から" ^ shuten_kanji ^ "駅までは" ^ string_of_float(ekikan_kyori) ^ "kmです"

let test = kyori_wo_hyoji "ayase" "kitaayase" = "綾瀬駅から北綾瀬駅までは2.1kmです"

let test = kyori_wo_hyoji "hiro" "ebisu" = "広尾駅から恵比寿駅までは1.5kmです"

let test = kyori_wo_hyoji "heiwadai" "nameko" = "namekoという駅は存在しません"

let test = kyori_wo_hyoji "tarako" "heiwadai" = "tarakoという駅は存在しません"

let test = kyori_wo_hyoji "wakousi" "hibiya" = "和光市駅と日比谷駅はつながっていません"

プログラムにおける頂点と辺の定義（118ページ）

code:ocaml

(* 問題 12.1 *)

type eki_t = {

namae : string;

saitan_kyori : float;

temae_list : string list;

}

(* 問題 12.2 *)

(* ekimei_list を元に eki_list を作成して返す *)

(* make_eki_list ekimei_list = eki_t list *)

let rec make_eki_list ekimei_list =

match ekimei_list with

| [] -> []

| {kanji; kana; romaji; shozoku} :: rest

-> [{namae=kanji; saitan_kyori=infinity; temae_list=[]}] @ (make_eki_list rest)

let test = make_eki_list [] = []

let test = make_eki_list [

{kanji="代々木上原"; kana="よよぎうえはら"; romaji="yoyogiuehara"; shozoku="千代田線"}

] = [

{namae="代々木上原"; saitan_kyori=infinity; temae_list=[]}

]

(* 問題 12.3 *)

(* 始点の駅を初期化する *)

(* - saitan_kyori = 0 *)

(* - temae_list = [] *)

let rec shokika shiten eki_list =

match eki_list with

| [] -> []

| {namae; saitan_kyori; temae_list} as first :: rest

->

let test_eki_list = make_eki_list [

{kanji="代々木上原"; kana="よよぎうえはら"; romaji="yoyogiuehara"; shozoku="千代田線"};

{kanji="代々木公園"; kana="よよぎこうえん"; romaji="yoyogikouen"; shozoku="千代田線"};

{kanji="明治神宮前"; kana="めいじじんぐうまえ"; romaji="meijijinguumae"; shozoku="千代田線"}

]

let test_shokika = shokika "明治神宮前" [] = []

let test_shokika = shokika "明治神宮前" test_eki_list

let test_shokika = shokika "foo" test_eki_list

let test_shokika = shokika "代々木上原" test_eki_list

駅名の重複の除去（119ページ）

code:ocaml

(* 問題 12.4 *)

(* ひらがなでソート済みの ekimei_t のリストに、昇順となるよう ekimei_t を挿入する *)

let rec insert_ekimei lst ekimei =

match lst with

| first :: rest

->

if ekimei.kana < first.kana then ekimei :: first :: rest

else first :: (insert_ekimei rest ekimei)

let ikebukuro1 = {kanji="池袋";kana="いけぶくろ";romaji="ikebukuro";shozoku="丸ノ内線"}

let ikebukuro2 = {kanji="池袋";kana="いけぶくろ";romaji="ikebukuro";shozoku="有楽町線"}

let higashi_ikebukuro = {kanji="東池袋"; kana="ひがしいけぶくろ"; romaji="higasiikebukuro"; shozoku="有楽町線"}

let kanamecho = {kanji="要町"; kana="かなめちょう"; romaji="kanametyou"; shozoku="有楽町線"}

(* 重複する駅名を取り除く *)

let rec uniq_ekimei_list ekimei_list =

match ekimei_list with

| [] -> []

| first :: [] -> first :: []

| first :: second :: rest ->

if first.kana = second.kana then uniq_ekimei_list (first :: rest)

else first :: uniq_ekimei_list (second :: rest)

let test_uniq_ekimei_list = uniq_ekimei_list [

{kanji="池袋"; kana="いけぶくろ"; romaji="ikebukuro"; shozoku="丸ノ内線"};

{kanji="池袋"; kana="いけぶくろ"; romaji="ikebukuro"; shozoku="有楽町線"};

{kanji="後楽園"; kana="こうらくえん"; romaji="korakuen"; shozoku="丸ノ内線"};

{kanji="茗荷谷"; kana="みょうがだに"; romaji="myogadani"; shozoku="丸ノ内線"}

] = [

{kanji="池袋"; kana="いけぶくろ"; romaji="ikebukuro"; shozoku="丸ノ内線"};

{kanji="後楽園"; kana="こうらくえん"; romaji="korakuen"; shozoku="丸ノ内線"};

{kanji="茗荷谷"; kana="みょうがだに"; romaji="myogadani"; shozoku="丸ノ内線"}

]

(* ekimei_t のリストをひらがな(kana)順に整列して、さらに駅の重複を取り除く *)

let rec seiretsu ekimei_list =

match ekimei_list with

| [] -> []

| first :: rest ->

uniq_ekimei_list (insert_ekimei (seiretsu rest) first)

let ekimei_list = [

{kanji="池袋"; kana="いけぶくろ"; romaji="ikebukuro"; shozoku="丸ノ内線"};

{kanji="茗荷谷"; kana="みょうがだに"; romaji="myogadani"; shozoku="丸ノ内線"};

{kanji="後楽園"; kana="こうらくえん"; romaji="korakuen"; shozoku="丸ノ内線"};

{kanji="池袋"; kana="いけぶくろ"; romaji="ikebukuro"; shozoku="有楽町線"}

]

let test_seiretsu1 = seiretsu [] = []

let test_seiretsu2 = seiretsu [

{kanji="池袋"; kana="いけぶくろ"; romaji="ikebukuro"; shozoku="丸ノ内線"};

{kanji="茗荷谷"; kana="みょうがだに"; romaji="myogadani"; shozoku="丸ノ内線"};

{kanji="後楽園"; kana="こうらくえん"; romaji="korakuen"; shozoku="丸ノ内線"}

] = [

{kanji="池袋"; kana="いけぶくろ"; romaji="ikebukuro"; shozoku="丸ノ内線"};

{kanji="後楽園"; kana="こうらくえん"; romaji="korakuen"; shozoku="丸ノ内線"};

{kanji="茗荷谷"; kana="みょうがだに"; romaji="myogadani"; shozoku="丸ノ内線"}

]

let test_seiretsu3 = seiretsu [

{kanji="池袋"; kana="いけぶくろ"; romaji="ikebukuro"; shozoku="丸ノ内線"};

{kanji="茗荷谷"; kana="みょうがだに"; romaji="myogadani"; shozoku="丸ノ内線"};

{kanji="後楽園"; kana="こうらくえん"; romaji="korakuen"; shozoku="丸ノ内線"};

{kanji="池袋"; kana="いけぶくろ"; romaji="ikebukuro"; shozoku="有楽町線"}

] = [

{kanji="池袋"; kana="いけぶくろ"; romaji="ikebukuro"; shozoku="有楽町線"};

{kanji="後楽園"; kana="こうらくえん"; romaji="korakuen"; shozoku="丸ノ内線"};

{kanji="茗荷谷"; kana="みょうがだに"; romaji="myogadani"; shozoku="丸ノ内線"}

]

関数の一般化とMap（124ページ）

code:ocaml

let rec map f lst =

match lst with

| [] -> []

| first :: rest -> (f first) :: (map f rest)

let map_sqrt lst = map sqrt lst

let test_map_sqrt = map_sqrt [] = []

let square n = n * n

let map_square lst = map square lst

let test_map_square = map_square [] = []

関数を返す関数（130ページ）

code:ocaml

(* 問題 13.3 *)

val foo : 'a -> 'a = <fun>

utop # let foo x y = x;;

val foo : 'a -> 'b -> 'a = <fun>

utop # let foo x y = y;;

val foo : 'a -> 'b -> 'b = <fun>

utop # let foo x f = f x;;

val foo : 'a -> ('a -> 'b) -> 'b = <fun>

utop # let foo f g x = g x;;

val foo : 'a -> ('b -> 'c) -> 'b -> 'c = <fun>

utop # let foo f g x = g (f x);;

val foo : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c = <fun>

(* 問題 13.4 *)

let time2 x = x * 2

let add3 x = x + 3

let compose f g =

let h x = f (g x)

in h

let test = (compose time2 add3) 4

確定点に隣接する点の最短距離の更新（133ページ）

以下を実装したぞ

koushin1

koushin

code:ocaml

(* 問題 13.6 *)

(* 目的: 直前に確定した駅 p と未確定の駅 q を受け取り、p と q が直接つながっていたら q の最短距離と手前リストを更新、 *)

(* つながっていなければ q をそのまま返す *)

(* koushin1 : eki_t -> eki_t -> eki_t *)

let koushin1 p q =

let ekikan_kyori = get_ekikan_kyori p.namae q.namae global_ekikan_list in

if ekikan_kyori = infinity then q

else {namae = q.namae; saitan_kyori = p.saitan_kyori +. ekikan_kyori; temae_list = q.namae :: p.temae_list}

(* 湯島 -1.2-> 根津 -1.0-> 千駄木 *)

let eki2 = {namae = "根津"; saitan_kyori = infinity; temae_list = []}

let eki3 = {namae = "千駄木"; saitan_kyori = infinity; temae_list = []}

let eki2_1 = koushin1 eki1 eki2

(* 問題 13.7 *)

(* 目的: 直前に確定した駅 p と未確定の駅リスト v を受け取り、必要な更新処理を行った未確定の駅のリストを返す *)

let koushin p v =

let f eki = koushin1 p eki in

List.map f v

let eki2 = {namae = "根津"; saitan_kyori = infinity; temae_list = []}

let eki3 = {namae = "千駄木"; saitan_kyori = infinity; temae_list = []}

{namae = "千駄木"; saitan_kyori = infinity; temae_list = []}

]

高階関数を使ったリスト処理（135ページ）

even と count_A を filter を使って書き直す。

code:ocaml

(* リスト中の偶数の要素を返す *)

let rec even lst =

let p x = (x mod 2) = 0 in

List.filter p lst

let even_test1 = even [] = []

type gakusei_t = { name: string; tensuu: int; seiseki: string }

let gakusei1 = { name = "alice"; tensuu = 90; seiseki = "A" }

let gakusei2 = { name = "bob"; tensuu = 70; seiseki = "B" }

let gakusei3 = { name = "carol"; tensuu = 50; seiseki = "C" }

let gakusei4 = { name = "dave"; tensuu = 100; seiseki = "A" }

(* 成績Aの生徒の人数を数える *)

let rec count_A lst =

let p {seiseki} = seiseki = "A" in

List.length (List.filter p lst)

let count_a_test1 = count_A [] = 0

各要素をまとめあげる関数（137ページ）

fold_right が登場。

code:ocaml

(* my_fold_right *)

let rec my_fold_right f lst init =

match lst with

| [] -> init

| first :: rest -> f first (my_fold_right f rest init)

(* sum *)

let sum lst =

my_fold_right (fun x y -> x + y) lst 0

let sum_test = sum [] = 0

(* length *)

let length lst =

my_fold_right (fun _ y -> y + 1) lst 0

let length_test = length [] = 0

名前のない関数（143ページ）

code:ocaml

utop # (fun x y -> x * y) 3 5;;

- : int = 15

完全数を求める関数（147ページ）

code:ocaml

(* 完全数 *)

let perfect n =

List.filter (fun x -> perfectp x) (enumerate n)

let rec enumerate n =

if n = 0 then []

else n :: (enumerate (n - 1))

let divisors n = List.filter (fun x -> (n mod x) = 0) (enumerate n)

let perfectp n =

let sum = List.fold_right (+) (divisors n) 0 in

n = (sum - n)

let test = perfect 1000

(* 問題 14.15 *)

let one_to_n n = List.fold_right (+) (enumerate n) 0;;

(* 問題 14.16 *)

(* n の階乗を返す *)

let fac n = List.fold_right ( * ) (enumerate n) 1

分割統治法（151ページ）

問題を部分問題に分割する

各々の部分問題を独立に解く

得られた解から全体の解を計算する

クイックソート（151ページ）

code:ocaml

let rec qsort lst =

match lst with

| [] -> []

| first :: rest ->

let pivot = first in

let a = List.filter (fun x -> x < pivot) rest in

let b = List.filter (fun x -> x >= pivot) rest in

最短距離最小の点の分離（163ページ）

code:ocaml

(* 問題 15.4 *)

let saitan_sentinel = {namae = ""; saitan_kyori = infinity; temae_list = []}

let rec saitan_eki lst =

List.fold_right

(fun x y -> if x.saitan_kyori < y.saitan_kyori then x else y)

lst

saitan_sentinel

(* 目的: eki_t のリストを受け取り、「最短距離最小の駅」と「最短距離最小の駅を除外したリスト」のタプルを返す *)

let saitan_wo_bunri eki_list =

let saitan = saitan_eki eki_list in

let saitan_igai = List.filter (fun e -> e.namae != saitan.namae) eki_list in

(saitan, saitan_igai)

let test = saitan_wo_bunri [] = (saitan_sentinel, [])

code:ocaml

let rec saitan_wo_bunri lst =

match lst with

| [] -> failwith "lst shoud have at least one element"

| first :: [] -> (first, [])

| first :: rest ->

let (saitan_eki, v) = saitan_wo_bunri rest in

if first.saitan_kyori < saitan_eki.saitan_kyori then (first, saitan_eki :: v)

else (saitan_eki, first :: v)

これを fold_right で書き換えられるらしい

↓

書き換えた。分かりやすいかどうかわ判断しずらいが、確かに短くなった。

code:ocaml

let rec saitan_wo_bunri lst =

let f eki (saitan_eki, v) =

if eki.saitan_kyori < saitan_eki.saitan_kyori then (eki, saitan_eki :: v)

else (saitan_eki, eki :: v) in

match lst with

| [] -> ({namae = ""; saitan_kyori = infinity; temae_list = []}, [])

| first :: rest ->

List.fold_right f rest (first, [])

アキュムレータ（167ページ）

code:ocaml

(* 目的: 整数のリストを受け取り、それまでの数の合計からなるリストを返す *)

let sum_list lst =

let rec sum_list_with_acc lst acc =

match lst with

[] -> []

| first :: rest

-> let sum = first + acc in sum :: (sum_list_with_acc rest sum) in

sum_list_with_acc lst 0

アキュムレータの活用（170ページ）

code:ocaml

let rec reverse lst =

let rec rev lst result =

match lst with [] -> result | first :: rest -> rev rest (first :: result)

in rev lst []

let test = reverse [] = []

(* 問題 16.2 *)

let rec fold_left f init lst =

match lst with

[] -> init

| first :: rest -> fold_left f (f init first) rest

最初の完動プログラム（173ページ）

koushin で global_ekikan_list を直接使うのではなく、koushin の引数に ekikan_t list を渡すように修正する

code:ocaml

(* 問題 16.3 *)

(* 直前に確定した駅 p と未確定の駅 q を受け取り、p と q が直接つながっていたら q の最短距離と手前リストを更新、 *)

(* つながっていなければ q をそのまま返す *)

(* koushin1 : eki_t -> eki_t -> ekikan_t list -> eki_t *)

let koushin1 p q ekikan_list =

let ekikan_kyori = get_ekikan_kyori p.namae q.namae ekikan_list in

if ekikan_kyori = infinity then q

else {namae = q.namae; saitan_kyori = p.saitan_kyori +. ekikan_kyori; temae_list = q.namae :: p.temae_list}

let eki2 = {namae = "根津"; saitan_kyori = infinity; temae_list = []}

let eki3 = {namae = "千駄木"; saitan_kyori = infinity; temae_list = []}

let koushin1_test = koushin1 eki1 eki3 global_ekikan_list = {namae = "千駄木"; saitan_kyori = infinity; temae_list = []}

let eki2_1 = koushin1 eki1 eki2 global_ekikan_list

(* 目的: 直前に確定した駅 p と未確定の駅リスト v を受け取り、必要な更新処理を行った未確定の駅のリストを返す *)

let koushin p v ekikan_list=

let f eki = koushin1 p eki ekikan_list in

List.map f v

let eki2 = {namae = "根津"; saitan_kyori = infinity; temae_list = []}

let eki3 = {namae = "千駄木"; saitan_kyori = infinity; temae_list = []}

{namae = "千駄木"; saitan_kyori = infinity; temae_list = []}

]

dijkstra_main を書くよ。

code:ocaml

(* 問題 16.4 *)

(* dijkstra_main : eki_t list -> ekikan_t list -> eki_t list *)

let rec dijkstra_main eki_list ekikan_list =

let rec dijkstra0 s v ekikan_list =

match v with

[] -> s

| _ ->

let (saitan, v0) = saitan_wo_bunri v in

dijkstra0 (saitan :: s) (koushin saitan v0 ekikan_list) ekikan_list

in dijkstra0 [] eki_list ekikan_list

let test_ekikan_list = [

{kiten="A"; shuten="B"; keiyu="AA"; kyori=1.0; jikan=5};

{kiten="B"; shuten="C"; keiyu="AA"; kyori=1.3; jikan=7};

{kiten="C"; shuten="D"; keiyu="AA"; kyori=0.8; jikan=3}

]

(* 始点しかない場合 *)

(* A -> B *)

let test_eki_list = [

{namae = "B"; saitan_kyori = infinity; temae_list = []}

]

let test = dijkstra_main test_eki_list test_ekikan_list = [

]

(* A -> B -> C *)

let test_eki_list = [

{namae = "B"; saitan_kyori = infinity; temae_list = []};

{namae = "C"; saitan_kyori = infinity; temae_list = []}

]

let test = dijkstra_main test_eki_list test_ekikan_list = [

]

(* 駅の初期化処理の練習 *)

let test_eki_list = (shokika "池袋" (make_eki_list (seiretsu global_ekimei_list)))

let test = dijkstra_main test_eki_list global_ekikan_list

(* 問題 16.5 *)

let dijkstra shiten_romaji shuten_romaji =

let shiten = romaji_to_kanji shiten_romaji global_ekimei_list in

let shuten = romaji_to_kanji shuten_romaji global_ekimei_list in

let eki_list = (shokika shiten (make_eki_list (seiretsu global_ekimei_list))) in

List.find

(fun {namae} -> namae = shuten)

(dijkstra_main eki_list global_ekikan_list)

第17章 再帰的なデータ構造（177ページ）

バリアント型（177ページ）

code:ocaml

(* 問題 17.1 *)

type nengou_t =

Meiji of int

| Taisho of int

| Showa of int

| Heisei of int

| Reiwa of int

let to_seireki nengou = match nengou with

Meiji (n) -> n + 1867

| Taisho (n) -> n + 1911

| Showa (n) -> n + 1925

| Heisei (n) -> n + 1988

| Reiwa (n) -> n + 2018

let nenrei tanjou genzai =

let tanjou_seireki = to_seireki tanjou in

let genzai_seireki = to_seireki genzai in

genzai_seireki - tanjou_seireki

let test = nenrei (Meiji 10) (Meiji 10) = 0

let test = nenrei (Heisei 26) (Reiwa 4) = 8

(* 問題 17.2 *)

type year_t =

January of int

| February of int

| March of int

| April of int

| May of int

| June of int

| July of int

| August of int

| September of int

| October of int

| November of int

| December of int

(* 問題 17.3 *)

type seiza_t =

Aries (* 牡羊座 *)

| Taurus (* 牡牛座 *)

| Gemini (* 双子座 *)

| Cancer (* 蟹座 *)

| Leo (* 獅子座 *)

| Virgo (* 乙女座 *)

| Libra (* 天秤座 *)

| Scorpius (* 蠍座 *)

| Sagittarius (* 射手座 *)

| Capricornus (* 山羊座 *)

| Aquarius (* 水瓶座 *)

| Pisces (* 魚座 *)

(* 問題 17.4 *)

(* seiza : year_t -> seiza_t *)

let seiza year =

match year with

| January (n) -> if n <= 19 then Capricornus else Aquarius

| February (n) -> if n <= 18 then Aquarius else Pisces

| March (n) -> if n <= 20 then Pisces else Aries

| April (n) -> if n <= 19 then Aries else Taurus

| May (n) -> if n <= 20 then Taurus else Gemini

| June (n) -> if n <= 21 then Gemini else Cancer

| July (n) -> if n <= 22 then Cancer else Leo

| August (n) -> if n <= 22 then Leo else Virgo

| September (n) -> if n <= 22 then Virgo else Libra

| October (n) -> if n <= 23 then Libra else Scorpius

| November (n) -> if n <= 22 then Scorpius else Sagittarius

| December (n) -> if n <= 21 then Sagittarius else Capricornus

let test = seiza (April 19) = Aries

let test = seiza (April 20) = Taurus

let test = seiza (May 20) = Taurus

let test = seiza (May 21) = Gemini

木（180ページ）

code:ocaml

type tree_t =

Empty

| Leaf of int

| Node of tree_t * int * tree_t

let test = Empty

let test = Leaf (10)

let test = Node (Empty, 7, Leaf 3)

(* 問題 17.5 *)

(* 目的: 渡された木の値をすべて2倍の値にして返す *)

let rec tree_double tree =

match tree with

Empty -> Empty

| Leaf (n) -> Leaf (n * 2)

| Node (t1, n, t2) -> Node ((tree_double t1), n * 2, (tree_double t2))

let test = tree_double Empty = Empty

let test = tree_double (Leaf 0) = Leaf (0)

let test = tree_double (Node (Empty, 0, Empty)) = Node (Empty, 0, Empty)

let test = tree_double (Leaf 10) = Leaf (20)

let test = tree_double (Node (Empty, 10, Empty)) = Node (Empty, 20, Empty)

let test = tree_double (Node (Leaf (5), 10, Empty)) = Node (Leaf (10), 20, Empty)

let test = tree_double (Node (Leaf (5), 10, Node (Leaf 10, 20, Leaf 30))) = Node (Leaf (10), 20, Node (Leaf 20, 40, Leaf 60))

(* 問題 17.6 *)

(* 目的: int -> int 型の関数 f と tree_t を受け取ったら、Leaf や Node の値すべてに f を適用した木を返す *)

let rec tree_map f tree =

match tree with

Empty -> Empty

| Leaf (n) -> Leaf (f n)

| Node (t1, n, t2) -> Node ((tree_map f t1), f n, (tree_map f t2))

let test = tree_map (fun x -> x * x) Empty = Empty

let test = tree_map (fun x -> x * x) (Leaf 0) = Leaf (0)

let test = tree_map (fun x -> x * x) (Node (Empty, 0, Empty)) = Node (Empty, 0, Empty)

let test = tree_map (fun x -> x * x) (Leaf 10) = Leaf (100)

let test = tree_map (fun x -> x * x) (Node (Empty, 10, Empty)) = Node (Empty, 100, Empty)

let test = tree_map (fun x -> x * x) (Node (Leaf (5), 10, Empty)) = Node (Leaf (25), 100, Empty)

let test = tree_map (fun x -> x * x) (Node (Leaf (5), 10, Node (Leaf 10, 20, Leaf 30))) = Node (Leaf (25), 100, Node (Leaf 100, 400, Leaf 900))

二分探索木（185ページ）

code:ocaml

(* 目的: data が二分探索木に含まれているかどうかを返す *)

let rec search tree data =

match tree with

Empty -> false

| Leaf (n) -> n = data

| Node (t1, n, t2) ->

if n = data then true

else if data < n then search t1 data

else search t2 data

let tree1 = Empty

let tree2 = Leaf (3)

let tree3 = Node (Leaf (1), 2, Leaf (3))

let tree4 = Node (Empty, 7, Leaf (9))

let tree5 = Node (tree3, 6, tree4)

(* テスト *)

let test = search tree1 3 = false

let test = search tree2 3 = true

let test = search tree2 4 = false

let test = search tree5 6 = true

let test = search tree5 2 = true

let test = search tree5 1 = true

let test = search tree5 4 = false

let test = search tree5 7 = true

let test = search tree5 8 = false

(* 目的: 二分木に新しい要素 data を追加する *)

let rec insert_tree tree data =

match tree with

Empty -> Leaf (data)

| Leaf (n) ->

if n = data then Leaf (n)

else if n > data then Node (Leaf (data), n, Empty)

else Node (Empty, n, Leaf (data))

| Node (t1, n, t2) ->

if n = 0 then Node (t1, n, t2)

else if n > data then Node ((insert_tree t1 data), n, t2)

else Node (t1, n, (insert_tree t2 data))

let test = insert_tree Empty 3 = Leaf (3)

let test = insert_tree (Leaf (3)) 2 = Node ((Leaf 2), 3, Empty)

let test = insert_tree (Leaf (3)) 3 = Leaf (3)

let test = insert_tree (Leaf (3)) 4 = Node (Empty, 3, Leaf (4))

let test = insert_tree tree5 4 = Node (Node (Leaf (1), 2, Node (Empty, 3, Leaf (4))), 6, Node (Empty, 7, Leaf (9)))

多相型の宣言（189ページ）

code:ocaml

(* 内部に整数しか持てない木 *)

let tree_t =

Empty

| Leaf of int

| Node of tree_t * int * tree_t

(* 多相の木を表す型 *)

type 'a tree_t =

Empty

| Leaf of 'a

| Node of 'a tree_t * 'a * 'a tree_t

get_ekikan_kyori の高速化（192ページ）

code:ocaml

(* 問題 17.10 *)

type ekikan_tree_t =

Empty

| Node of ekikan_tree_t * string * (string * float) list * ekikan_tree_t

(* 問題 17.11 *)

(* 目的: 連想リストに格納された距離を取得する *)

let rec assoc key pairs =

match pairs with

[] -> infinity

| (key0, value0) :: rest ->

if key = key0 then value0

else assoc key rest

(* 問題 17.12 *)

(* 目的: ekikan_tree_t に ekikan_t を挿入する *)

let insert_ekikan ekikan_tree ekikan =

let rec insert_ekikan0 ekikan_tree kiten shuten kyori =

match ekikan_tree with

| Node (t1, ekimei, ekimei_kyori_pairs, t2) ->

if kiten = ekimei then Node (t1, ekimei, ((shuten, kyori) :: ekimei_kyori_pairs), t2)

else if kiten < ekimei then Node ((insert_ekikan0 t1 kiten shuten kyori), ekimei, ekimei_kyori_pairs, t2)

else Node (t1, ekimei, ekimei_kyori_pairs, (insert_ekikan0 t2 kiten shuten kyori))

in

insert_ekikan0

(insert_ekikan0 ekikan_tree ekikan.kiten ekikan.shuten ekikan.kyori)

ekikan.shuten ekikan.kiten ekikan.kyori

(* 千駄木 < 根津 < 湯島 < 町屋 < 西日暮里 *)

let ekikan1 = {kiten="湯島"; shuten="根津"; keiyu="千代田線"; kyori=1.2; jikan=2}

let ekikan2 = {kiten="根津"; shuten="千駄木"; keiyu="千代田線"; kyori=1.0; jikan=2}

let ekikan3 = {kiten="千駄木"; shuten="西日暮里"; keiyu="千代田線"; kyori=0.9; jikan=1}

let ekikan4 = {kiten="西日暮里"; shuten="町屋"; keiyu="千代田線"; kyori=1.7; jikan=2}

let tree1 = insert_ekikan Empty ekikan1

let tree2 = insert_ekikan tree1 ekikan2

let tree3 = insert_ekikan tree2 ekikan3

let tree4 = insert_ekikan tree3 ekikan4

(* 問題 17.13 *)

(* 目的: ekikan_tree_t に ekikan_t list を挿入する *)

let inserts_ekikan ekikan_tree ekikan_list =

List.fold_right (fun ekikan tree-> insert_ekikan tree ekikan) ekikan_list ekikan_tree

let test = inserts_ekikan Empty [] = Empty

最短経路検索のメイン処理

code:ocaml

let () =

let {namae; saitan_kyori; temae_list} = dijkstra "ikebukuro" "kotakemukaihara"

in

print_string namae;

print_float saitan_kyori;

List.iter (print_string) temae_list

code:ocaml

(* 駅間リストから駅間ツリーを作成 *)

let tree = inserts_ekikan Empty global_ekikan_list

文字列のリストをひとつの文字列にまとめる

code:ocaml

- : string = "A B C"

OCamlでprintデバッグ。

code:ocaml

let rec get_ekikan_node tree ekimei =

match tree with

Empty -> None

| Node (t1, ekimei0, ekimei_kyori_pairs, t2) ->

if ekimei = ekimei0 then

let _ = Printf.printf "%s == %s\n" ekimei ekimei0 in

Some (Node (Empty, ekimei0, ekimei_kyori_pairs, Empty))

else if ekimei < ekimei0 then

let _ = Printf.printf "%s < %s\n" ekimei ekimei0 in

get_ekikan_node t1 ekimei

else

let _ = Printf.printf "%s > %s\n" ekimei ekimei0 in

get_ekikan_node t2 ekimei

出力結果はこんな感じ。

code:text

utop # get_ekikan_node global_ekikan_tree "池袋";;

池袋 > 営団成増

池袋 > 和光市

池袋 > 平和台

池袋 > 営団赤塚

池袋 > 氷川台

池袋 < 要町

池袋 == 池袋

- : ekikan_tree_t option =

Some

(Node (Empty, "池袋",

バグでした...

オプション型（197ページ）

code:ocaml

let yaoya_list = [("トマト", 300); ("たまねぎ", 200);

("にんじん", 150); ("ほうれん草", 200)]

(* 目的: item の値段を返す *)

let rec price item yaoya_list = match yaoya_list with

[] -> None

| (namae, nedan) :: rest ->

if item = namae then Some (nedan)

else price item rest

let test = price "トマト" yaoya_list = Some (300)

let test = price "ほうれん草" yaoya_list = Some (200)

let test = price "つけ麺" yaoya_list = None

code:ocaml

(* yasai_list を買った時の合計額を返す *)

let rec total_price yasai_list yaoya_list = match yasai_list with

[] -> 0

| first :: rest ->

match price first yaoya_list with

None -> total_price rest yaoya_list

| Some (p) -> p + (total_price rest yaoya_list)

let test = total_price [] yaoya_list = 0

例外処理の実際（206ページ）

total_priceを例外を使って書き換え。

code:ocaml

(* 売り切れを示す例外 *)

exception Urikire

(* 目的: itemの値段を返す *)

(* 見つからない時は Urikire 例外を投げる *)

(* price : string -> (string * int) list -> int *)

let rec price item yaoya_list = match yaoya_list with

[] -> raise Urikire

| (namae, nedan) :: rest ->

if item = namae then nedan

else price item rest

(* 目的: yasai_list を買った時の値段の合計を調べる *)

(* total_price: string list -> (string * int) list -> int *)

let total_price yasai_list yaoya_list =

let rec _total_price yasai_list yaoya_list = match yasai_list with

[] -> 0

| first :: rest -> price first yaoya_list + (_total_price rest yaoya_list)

in

try _total_price yasai_list yaoya_list with

Urikire -> 0

let test = total_price [] yaoya_list = 0

2分探索木を表すモジュール（214ページ）

code:ocaml

(* ２分探索木を表すモジュール *)

module Tree = struct

type ('a, 'b) t = Empty

| Node of ('a, 'b) t * 'a * 'b * ('a, 'b) t

(* 空の木 *)

let empty = Empty

(* 目的: tree にキー k で値が v なノードを挿入した木を返す *)

(* insert : ('a, 'b) t -> 'a -> 'b -> ('a, 'b) t *)

let rec insert tree k v = match tree with

Empty -> Node (Empty, k, v, Empty)

| Node (t1, k0, v0, t2) ->

if k = k0 then Node (t1, k, v, t2)

else

if k < k0 then Node ((insert t1 k v), k0, v0, t2)

else Node (t1, k0, v0, (insert t2 k v))

(* 目的: tree からキー k に対応する値 v を検索して返す *)

(* 見つからなければ Not_found 例外を投げる *)

let rec search tree k = match tree with

Empty -> raise Not_found

| Node (t1, k0, v0, t2) ->

if k = k0 then v0

else

if k < k0 then search t1 k

else search t2 k

end

open Tree

(* insert のテスト *)

let t0 = empty

let test = t0 = Empty

let t1 = insert empty "i" 10

let test = t1 = Node (Empty, "i", 10, Empty)

let t2 = insert empty "i" 11

let test = t2 = Node (Empty, "i", 11, Empty)

let t3 = insert t2 "e" 20

let test = t3 = Node (Node (Empty, "e", 20, Empty), "i", 11, Empty)

let t4 = insert t3 "k" 30

let test = t4 = Node (Node (Empty, "e", 20, Empty), "i", 11, Node (Empty, "k", 30, Empty))

let t5 = insert t4 "g" 40

let test = t5 = Node (Node (Empty, "e", 20, Node (Empty, "g", 40, Empty)), "i", 11, Node (Empty, "k", 30, Empty))

let t6 = insert t5 "a" 50

let test = t6 = Node (Node (Node (Empty, "a", 50, Empty), "e", 20, Node (Empty, "g", 40, Empty)), "i", 11, Node (Empty, "k", 30, Empty))

(* search のテスト *)

let test = (try search empty "a" with Not_found -> 9999) = 9999

let test = search t1 "i" = 10

let test = search t6 "k" = 30

let test = search t6 "g" = 40

let test = search t6 "a" = 50

let test = (try search t6 "z" with Not_found -> 9999) = 9999

モジュールの実装とシグネチャ

code:tree.ml

(* ２分探索木モジュール *)

type ('a, 'b) t = Empty

| Node of ('a, 'b) t * 'a * 'b * ('a, 'b) t

(* 空の木 *)

let empty = Empty

(* 目的: tree にキー k で値が v なノードを挿入した木を返す *)

(* insert : ('a, 'b) t -> 'a -> 'b -> ('a, 'b) t *)

let rec insert tree k v = match tree with

Empty -> Node (Empty, k, v, Empty)

| Node (t1, k0, v0, t2) ->

if k = k0 then Node (t1, k, v, t2)

else

if k < k0 then Node ((insert t1 k v), k0, v0, t2)

else Node (t1, k0, v0, (insert t2 k v))

(* 目的: tree からキー k に対応する値 v を検索して返す *)

(* 見つからなければ Not_found 例外を投げる *)

let rec search tree k = match tree with

Empty -> raise Not_found

| Node (t1, k0, v0, t2) ->

if k = k0 then v0

else

if k < k0 then search t1 k

else search t2 k

code:tree.mli

(* キーが 'a 値が 'b の木 *)

type ('a, 'b) t

(* 使い方: empty *)

(* 空の木を返す *)

val empty : ('a, 'b) t

(* 使い方: insert tree key value *)

(* 木 tree にキー key と値 value を挿入した木を返す *)

val insert : ('a, 'b) t -> 'a -> 'b -> ('a, 'b) t

(* 使い方: search tree key *)

(* 木 tree の中からキー key に対応する値を返す *)

val search : ('a, 'b) t -> 'a -> 'b

code:tree_test.ml

open Tree

let () =

let tree = insert empty "a" 10 in

let n = search tree "a" in

print_int n;

print_newline ()

code:tree.mk

all: tree_test

clean:

rm -f *.cmo *.cmi *.top tree_test

%.cmi: %.mli

ocamlc -c $<

%.cmo: %.ml

ocamlc -c $<

tree_test: tree.cmi tree.cmo tree_test.cmo

ocamlc -o tree_test tree.cmo tree_test.cmo

run: tree_test

./tree_test

tree_test.ml をビルドして実行してみる。

code:sh

$ make -f tree.mk

ocamlc -c tree.mli

ocamlc -c tree.ml

ocamlc -c tree_test.ml

ocamlc -o tree_test tree.cmo tree_test.cmo

$ ./tree_test

10

tree.topを作成して対話環境から呼び出してみる。

まずはtree.top をビルド。シグネチャの方を先にビルドする必要があるみたい。

code:sh

$ ocamlmktop -o tree.top tree.mli tree.ml

tree.top を実行

code:ocaml

$ ./tree.top

# let t = Tree.empty;;

val t : ('a, 'b) Tree.t = <abstr>

# let t = Tree.insert Tree.empty "a" 10;;

val t : (string, int) Tree.t = <abstr>

# Tree.search t "a";;

- : int = 10

#

モジュールとopen

code:ocaml

open Printf

let () = List.iter (printf "%s\n") data

赤黒木（224ページ）

code:ex20_1.ml

type color_t = Red | Black

(* 問題 20.1 *)

type ('a, 'b) rb_tree_t = Empty

| Node of ('a, 'b) rb_tree_t * 'a * 'b * color_t * ('a, 'b) rb_tree_t

作成した rb_tree_t のテスト

code:ocaml

type color_t = Red | Black

type ('a, 'b) rb_tree_t =

Empty

| Node of ('a, 'b) rb_tree_t * 'a * 'b * color_t * ('a, 'b) rb_tree_t

utop # Empty;;

- : ('a, 'b) rb_tree_t = Empty

utop # Node (Empty, "a", 10, Red, Empty);;

- : (string, int) rb_tree_t = Node (Empty, "a", 10, Red, Empty)

赤黒木への挿入（225ページ）

code:ex20_2.ml

(* 目的: 赤黒木のバランスをとる。偏っていない場合はそのままの木を返す *)

let balance t =

match t with

Node (a, xk, xv, Black, Node (b, yk, yv, Red, Node (c, zk, zv, Red, d)))

| Node (a, xk, xv, Black, Node (Node (b, yk, yv, Red, c), zk, zv, Red, d))

| Node (Node (a, xk, xv, Red, Node (b, yk, yv, Red, c)), zk, zv, Black, d)

| Node (Node (Node (a, xk, xv, Red, b), yk, yv, Red, c), zk, zv, Black, d)

-> Node (Node (a, xk, xv, Black, b), yk, yv, Red, Node (c, zk, zv, Black, d))

| _

-> t

let t0 = Empty

let test = balance t0 = Empty

let t1 = (Node (Empty, "x", 10, Black, Empty))

let test =

balance t1 = Node (Empty, "x", 10, Black, Empty)

let t2 = (Node (Empty, "x", 10, Black, (Node (Empty, "b", 20, Red, Empty))))

let test =

balance t2 = Node (Empty, "x", 10, Black, (Node (Empty, "b", 20, Red, Empty)))

let t3 = Node (Empty, "x", 10, Black, (Node (Empty, "b", 20, Red, Empty)))

let test =

balance t3 = Node (Empty, "x", 10, Black, (Node (Empty, "b", 20, Red, Empty)))

let t4 = Node (Empty, "x", 10, Black, (Node (Empty, "b", 20, Red, (Node (Empty, "c", 30, Red, Empty)))))

let test =

balance t4 = Node (Node (Empty, "x", 10, Black, Empty), "y", 20, Red, Node (Empty, "z", 30, Black, Empty))

let t5 = Node (Empty, "x", 10, Black, (Node ((Node (Empty, "y", 20, Red, Empty)), "z", 30, Red, Empty)))

let test =

balance t5 = Node (Node (Empty, "x", 10, Black, Empty), "y", 20, Red, Node (Empty, "z", 30, Black, Empty))

let t6 = Node ((Node (Empty, "x", 10, Red, (Node (Empty, "y", 20, Red, Empty)))), "z", 30, Black, Empty)

let test =

balance t6 = Node (Node (Empty, "x", 10, Black, Empty), "y", 20, Red, Node (Empty, "z", 30, Black, Empty))

let t7 = Node ((Node ((Node (Empty, "x", 10, Red, Empty), "y", 20, Red, Empty))), "z", 30, Black, Empty)

let test =

balance t7 = Node (Node (Empty, "x", 10, Black, Empty), "y", 20, Red, Node (Empty, "z", 30, Black, Empty))

(* X, Y, Z にぶら下がる a, b, c, d のテストも行う *)

let ta = Node (Empty, "a", 999, Black, Empty)

let tb = Node (Empty, "b", 999, Black, Empty)

let tc = Node (Empty, "c", 999, Black, Empty)

let td = Node (Empty, "d", 999, Black, Empty)

let t8 = Node ((Node ((Node (ta, "x", 10, Red, tb), "y", 20, Red, tc))), "z", 30, Black, td)

let test =

balance t8 = Node (Node (ta, "x", 10, Black, tb), "y", 20, Red, Node (tc, "z", 30, Black, td))

let t9 = Node ((Node (ta, "x", 10, Red, (Node (tb, "y", 20, Red, tc)))), "z", 30, Black, td)

let test =

balance t9 = Node (Node (ta, "x", 10, Black, tb), "y", 20, Red, Node (tc, "z", 30, Black, td))

let t10 = Node (ta, "x", 10, Black, (Node ((Node (tb, "y", 20, Red, tc)), "z", 30, Red, td)))

let test =

balance t10 = Node (Node (ta, "x", 10, Black, tb), "y", 20, Red, Node (tc, "z", 30, Black, td))

let t11 = Node (ta, "x", 10, Black, (Node (tb, "y", 20, Red, (Node (tc, "z", 30, Red, td)))))

let test =

balance t11 = Node (Node (ta, "x", 10, Black, tb), "y", 20, Red, Node (tc, "z", 30, Black, td))

code:ex20_3.ml

(* 目的: 木とキーと値を受け取ったら、その木へキーと値を挿入した赤黒木を返す *)

let insert t k v =

let turnB t = match t with

Node (t1, k, v, c, t2) -> Node (t1, k, v, Black, t2)

| _ -> assert false in

let rec ins t k v = match t with

Empty -> Node (Empty, k, v, Red, Empty)

| Node (t1, k0, v0, c0, t2)

->

if k < k0 then balance (Node ((ins t1 k v), k0, v0, c0, t2))

else if k > k0 then balance (Node (t1, k0, v0, c0, (ins t2 k v)))

else Node (t1, k, v, c0, t2) in

turnB (ins t k v)

let t0 = Empty

let t1 = insert t0 1 "dummy"

let test = t1 = Node (Empty, 1, "dummy", Black, Empty)

let t2 = insert t1 2 "dummy"

let test = t2 = Node (Empty, 1, "dummy", Black, Node (Empty, 2, "dummy", Red, Empty))

let t3 = insert t2 3 "dummy"

let test = t3 = Node (Node (Empty, 1, "dummy", Black, Empty), 2, "dummy", Black, Node (Empty, 3, "dummy", Black, Empty))

let t4 = insert t3 4 "dummy"

let test = t4 = Node (Node (Empty, 1, "dummy", Black, Empty), 2, "dummy", Black, Node (Empty, 3, "dummy", Black, Node (Empty, 4, "dummy", Red, Empty)))

let t5 = insert t4 5 "dummy"

let test = t5 = Node (Node (Empty, 1, "dummy", Black, Empty), 2, "dummy", Black, Node (Node (Empty, 3, "dummy", Black, Empty), 4, "dummy", Red, Node (Empty, 5, "dummy", Black, Empty)))

let t6 = insert t5 6 "dummy"

let test = t6 = Node (Node (Empty, 1, "dummy", Black, Empty), 2, "dummy", Black, Node (Node (Empty, 3, "dummy", Black, Empty), 4, "dummy", Red, Node (Empty, 5, "dummy", Black, Node (Empty, 6, "dummy", Red, Empty))))

let t7 = insert t6 7 "dummy"

let test = t7 = Node (Node (Node (Empty, 1, "dummy", Black, Empty), 2, "dummy", Black, Node (Empty, 3, "dummy", Black, Empty)), 4, "dummy", Black, Node (Node (Empty, 5, "dummy", Black, Empty), 6, "dummy", Black, Node (Empty, 7, "dummy", Black, Empty)))

let t8 = insert t7 4 "DUMMY"

let test = t8 = Node (Node (Node (Empty, 1, "dummy", Black, Empty), 2, "dummy", Black, Node (Empty, 3, "dummy", Black, Empty)), 4, "DUMMY", Black, Node (Node (Empty, 5, "dummy", Black, Empty), 6, "dummy", Black, Node (Empty, 7, "dummy", Black, Empty)))

let t9 = insert t8 0 "dummy"

let test = t9 = Node (Node (Node (Node (Empty, 0, "dummy", Red, Empty), 1, "dummy", Black, Empty), 2, "dummy", Black, Node (Empty, 3, "dummy", Black, Empty)), 4, "DUMMY", Black, Node (Node (Empty, 5, "dummy", Black, Empty), 6, "dummy", Black, Node (Empty, 7, "dummy", Black, Empty)))

let t10 = insert t9 (-1) "dummy"

let test = t10 = Node (Node (Node (Node (Empty, -1, "dummy", Black, Empty), 0, "dummy", Red, Node (Empty, 1, "dummy", Black, Empty)), 2, "dummy", Black, Node (Empty, 3, "dummy", Black, Empty)), 4, "DUMMY", Black, Node (Node (Empty, 5, "dummy", Black, Empty), 6, "dummy", Black, Node (Empty, 7, "dummy", Black, Empty)))

赤黒木のモジュール化（229ページ）

code:ex20_4.ml

(* 目的: 木とキーを受け取ったら、そのキーに対応する値を返す *)

let rec search tree key =

match tree with

Empty -> raise Not_found

| Node (t1, k, v, _, t2) ->

if k = key then v

else if key > k then search t2 key

else search t1 key

let t0 = Empty

let t1 = insert t0 1 "1"

let t2 = insert t1 2 "10"

let t3 = insert t2 3 "11"

let t4 = insert t3 4 "100"

let t5 = insert t4 5 "101"

let t6 = insert t5 6 "110"

let t7 = insert t6 7 "111"

let test = try search t0 1 with Not_found -> 999 = 999

let test = search t1 1 = "1"

let test = search t3 2 = "10"

let test = search t3 1 = "1"

let test = search t3 3 = "11"

let test = search t7 7 = "111"

code:redBlack.ml

type color_t = Red | Black

type ('a, 'b) t = Empty

| Node of ('a, 'b) t * 'a * 'b * color_t * ('a, 'b) t

let empty = Empty

(* 目的: 赤黒木のバランスをとる。偏っていない場合はそのままの木を返す *)

let balance t =

match t with

Node (a, xk, xv, Black, Node (b, yk, yv, Red, Node (c, zk, zv, Red, d)))

| Node (a, xk, xv, Black, Node (Node (b, yk, yv, Red, c), zk, zv, Red, d))

| Node (Node (a, xk, xv, Red, Node (b, yk, yv, Red, c)), zk, zv, Black, d)

| Node (Node (Node (a, xk, xv, Red, b), yk, yv, Red, c), zk, zv, Black, d)

-> Node (Node (a, xk, xv, Black, b), yk, yv, Red, Node (c, zk, zv, Black, d))

| _

-> t

(* 目的: 木とキーと値を受け取ったら、その木へキーと値を挿入した赤黒木を返す *)

let insert t k v =

let turnB t = match t with

Node (t1, k, v, c, t2) -> Node (t1, k, v, Black, t2)

| _ -> assert false in

let rec ins t k v = match t with

Empty -> Node (Empty, k, v, Red, Empty)

| Node (t1, k0, v0, c0, t2)

->

if k < k0 then balance (Node ((ins t1 k v), k0, v0, c0, t2))

else if k > k0 then balance (Node (t1, k0, v0, c0, (ins t2 k v)))

else Node (t1, k, v, c0, t2) in

turnB (ins t k v)

(* 目的: 木とキーを受け取ったら、そのキーに対応する値を返す *)

let rec search tree key =

match tree with

Empty -> raise Not_found

| Node (t1, k, v, _, t2) ->

if k = key then v

else if key > k then search t2 key

else search t1 key

code:redBlack.mli

type color_t = Red | Black

type ('a, 'b) t

val empty : ('a, 'b) t

val insert : ('a, 'b) t -> 'a -> 'b -> ('a, 'b) t

val search : ('a, 'b) t -> 'a -> 'b

code:redBlackTest.ml

open RedBlack

let () =

let tree = insert empty "a" 10 in

let n = search tree "a" in

print_int n;

print_newline ()

code:redBlack.mk

all: redBlackTest

clean:

rm -f *.cmo *.cmi *.top redBlackTest

%.cmi: %.mli

ocamlc -c $<

%.cmo: %.ml

ocamlc -c $<

redBlackTest: redBlack.cmi redBlack.cmo redBlackTest.cmo

ocamlc -o redBlackTest redBlack.cmo redBlackTest.cmo

run: redBlackTest

./redBlackTest

redBlack.top:

ocamlmktop -o redBlack.top redBlack.mli redBlack.ml

top: redBlack.top

rlwrap ./redBlack.top

赤黒木に変更前の最短経路検索。

code:sh

$ ocaml metro.ml

淡路町7.2淡路町御茶ノ水本郷三丁目後楽園茗荷谷新大塚池袋

副作用を持つ関数（232ページ）

code:ocaml

utop # print_string "Hello World";;

Hello World- : unit = ()

code:ocaml

utop # ();;

- : unit = ()

code:ocaml

utop # print_newline;;

- : unit -> unit = <fun>

utop # print_newline ();;

- : unit = ()

code:ocaml

utop # let name = "htkymtks" in

let age = 17 in

(print_string "私の名前は";

print_string name;

print_string "です。年齢は";

print_int age;

print_string "です。";

print_newline ();

0);;

私の名前はhtkymtksです。年齢は17です。

- : int = 0

スタンドアローンのプログラム（238ページ）

code:fac.ml

let rec f n =

if n = 0 then 1 else n * f (n - 1)

code:mail.ml

let main () =

let result = Fac.f 10 in

(print_int result;

print_newline ())

let _ = main ()

code:Makefile

all: fac

clean:

rm -f *.cmo *.cmi fac

%.cmo: %.ml

ocamlc -c $<

fac: fac.cmo main.cmo

ocamlc -o fac fac.cmo main.cmo

run: fac

./fac

ビルドと実行

code:sh

$ make run

ocamlc -c fac.ml

ocamlc -c main.ml

ocamlc -o fac fac.cmo main.cmo

./fac

3628800

$

引数の渡し方（241ページ）

引数を渡せるようにしてみる。

code:main.ml

let main n =

let result = Fac.f n in

(print_int result;

print_newline ())

let _ = main (int_of_string Sys.argv.(1))

引数を渡して呼び出してみる。

code:sh

$ ./fac 1

1

$ ./fac 2

2

$ ./fac 3

6

$ ./fac 4

24

$ ./fac 5

120

参照型と値の書き換え（245ページ）

code:ocaml

utop # ref 0;;

- : int ref = {contents = 0}

code:ocaml

utop # let count = ref 0;;

val count : int ref = {contents = 0}

utop # !count;;

- : int = 0

utop # count := 10;;

- : unit = ()

utop # !count;;

- : int = 10

code:fib.ml

let count = ref 0

let rec fib n =

(count := !count + 1;

if n < 2 then n else fib (n - 1) + fib (n - 2))

let main =

(print_int (fib 8);

print_newline ();

print_int !count;

print_newline ())

let _ = main

呼び出してみる。8番目のフィボナッチ数21と、fibが呼ばれた回数67が返る。

code:ocaml

val count : int ref = {contents = 0}

val fib : int -> int = <fun>

21

67

val main : unit = ()

- : unit = ()

変更可能なレコード（250ページ）

code:ocaml

utop # type eki_t = {

namae: string;

mutable saitan_kyori: float;

mutable temae_list: string list;

};;

type eki_t = {

namae : string;

mutable saitan_kyori : float;

mutable temae_list : string list;

}

utop # let a = {namae = "A"; saitan_kyori = 3.2; temae_list = []};;

val a : eki_t = {namae = "A"; saitan_kyori = 3.2; temae_list = []}

utop # a.saitan_kyori <- 4.1;;

- : unit = ()

utop # a;;

- : eki_t = {namae = "A"; saitan_kyori = 4.1; temae_list = []}

code:ocaml

utop # let count = ref 0;;

val count : int ref = {contents = 0}

utop # count.contents <- 99;;

- : unit = ()

utop # !count;;

- : int = 99

配列（251ページ）

code:ocaml

utop # [];;

- : 'a list = []

utop # Array.get a 3;;

- : int = 4

utop # a.(3);;

- : int = 4

配列の変更（253ページ）

code:ocaml

utop # a;;

utop # Array.set a 1 7;;

- : unit = ()

utop # a;;

utop # a.(2) <- 6;;

- : unit = ()

utop # a;;

無名関数

code:ocaml

utop # (fun x y -> x * y) 10 20;;

- : int = 200