Skip to content

Instantly share code, notes, and snippets.

@t-nissie
Last active December 29, 2020 14:16
Show Gist options
  • Star 9 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save t-nissie/c9fe1dc9f5e9fe1f90f5 to your computer and use it in GitHub Desktop.
Save t-nissie/c9fe1dc9f5e9fe1f90f5 to your computer and use it in GitHub Desktop.
OCaml練習帳

OCaml練習帳

OCamlを自習する。 浅井健一著『プログラミングの基礎』とそのWebサイト http://pllab.is.ocha.ac.jp/~asai/book-mov/ を使う。

インストール

UTF-8で漢字の入出力に対応させるのがわりと面倒。

Ubuntu 14.04 LTSへのインストール

UbuntuなどDebian系のGNU/Linuxにはapt-getで簡単にインストールできる:

sudo apt-get install tuareg-mode ocaml ocaml-findlib ocaml-doc

$HOME/.emacsには

;;; tuareg for OCaml
(load "tuareg")

を加える。

Debianへのインストールと環境設定

opamを使う方法がOCaml: 環境設定Debian 8向けに書かれている。 tuaregもEmacs 24.4でM-x package-install tuaregとインストールしている。

opamを使ってOCamlのコンパイラのアップグレードは

opam update
opam upgrade --unlock-base

とする。たぶん。

Mac OS Xへのインストール

MacPortsでインストールするのは、Graphicsモジュールが入らなかったり、opamでごにょごにょしないといけなかったり面倒。 結局、ソースからインストールした。X11はXQuartzを使った。

wget http://caml.inria.fr/pub/distrib/ocaml-4.02/ocaml-4.02.3.tar.xz
wget http://caml.inria.fr/pub/distrib/ocaml-4.02/MD5SUM
md5 ocaml-4.02.3.tar.xz | grep 9115706e30dad644f8dec9dfb459a9ab
tar xf ocaml-4.02.3.tar.xz
cd ocaml-4.02.3
cat INSTALL
./configure -x11include /opt/X11/include -x11lib /opt/X11/lib
make world
make bootstrap
make world.opt
sudo make install
hash -r
which ocamlc.opt

Graphicsを使わないのであれば、opamを使ってOCamlをインストール/アップグレードしていくのが便利そう。

最新のtuaregもインストールしてみる。 (opam install tuaregでインストールされるtuareg 2.0.8はEmacs 24で Error during redisplay: (void-function tuareg-syntax-propertize) とかいうエラーで動かなかった。)

$ git clone https://github.com/ocaml/tuareg.git tuareg
$ cp tuareg/*.el ~/COMMON/share/emacs/24/site-lisp/

$HOME/.emacsに次を書き加える。

;;; tuareg for OCaml
(load "tuareg-site-file")

WindowsのCygwinへのインストール

WindowsのCygwin(gnupackを使ってインストールしたもの) にOCamlをインストールするのはapt-cygで簡単:

$ apt-cyg install ocaml

tuaregはMacと同じようにすれば、gnupack付属のEmacsで困難なく使えた。

漢字 (UTF-8) の設定

漢字 (UTF-8) を扱えるようにするために、$HOME/.ocamlinit

(*  -*-Tuareg-*-
   This file is for UTF-8 input/output of OCaml. See
   http://d.hatena.ne.jp/murase_syuka/20150814/1439506123
   https://github.com/murasesyuka/dotfils/blob/5f6d38e617a3109e5bd6dbe216c40831c693475c/.ocamlinit
*)
let printer ppf = Format.fprintf ppf "\"%s\"";;
#install_printer printer

を書き加える。意味は不明。

Findlib, ocamlfindのインストール

何をするためのものなのか、いまいち不明。Ubuntuにはapt-getでインストールしたもの。

ocamlfindcamlcityからFindlibのソースを取ってきて、

tar xf findlib-1.6.1.tar.gz
cd findlib-1.6.1
cat INSTALL
./configure
make all
make opt
sudo make install

使ってみる

REPL環境

OCamlのREPL環境は toplevel systemトップレベル対話環境 と呼ばれるocamlコマンドである。 しかしながら、履歴機能がなかったりdeleteキーが^Hと表示されたりと、必ずしも使いやすいものではない。 (C-?で1文字消して戻ることはできる。)

$ ocaml
        OCaml version 4.02.3

# let average a b =
  (a +. b)/. 2.0;;
val average : float -> float -> float = <fun>
# average 2.0 3.0;;
- : float = 2.5
# "雲古";;
- : string = "雲古"
# ^D

ledit

ocaml インタプリタでコマンドの履歴を利用するに書かれているとおり、 leditを使うと入力の履歴が使えるが、utf-8(日本語、漢字)の入力が化ける。出力は化けないでうまくいく。

tuareg

EmacsでtuaregはM-x tuareg-run-ocamlで起動。 M-p, M-nで履歴が使える。エラーに色がついたり、マウスが使えたり、 また、foo.mlというファイルを編集するとキーワードに色がついたりして便利。 何もしなくても漢字が表示される。上記の$HOME/.ocamlinitの設定のおかげなのかは不明。 (OCaml 4.11.1 と Emacs 27.1 の組み合わせでは M-x set-buffer-process-coding-systemでoutput/inputをutf-8を指定する必要はなくなったみたい。) 住井英二郎著 数理科学的バグ撲滅方法論のすすめ 第1回 OCamlを試してみる のとおりgraphics.cmaをロード(#load, インタラクディブにダイナミックリンク)して円が描けた。

M-x tuareg-run-ocaml
        OCaml version 4.02.3
# "雲古";;
- : string = "雲古"
# #load "graphics.cma" ;;
# Graphics.open_graph "" ;;
- : unit = ()
# Graphics.draw_circle 100 100 50 ;;
- : unit = ()
# #quit;;

tuareg-kill-ocaml (C-c C-k) でも終了できる。

以下では、このtuareg上で、浅井健一著『プログラミングの基礎』 と http://pllab.is.ocha.ac.jp/~asai/book-mov/ を使って自習を進める。

基本的なデータ型(もしくは強く型付けされた言語)

整数

整数は加減乗除+, -, *, /と余りmodの計算ができる。 これらを含め基本的な演算は Module Pervasives に定義されていて、毎回自動的にopenされる。 したがって、その構成要素はすべてPervasivesをつけずに参照することができる。

問題 2.1

# 7-3*4;;
- : int = -5
# 7/2*2;;
- : int = 6
# 7*2/2;;
- : int = 7
# 7 mod 3;;
- : int = 1
# -7 mod 3;;
- : int = -1

(蛇足)中置演算子、前置演算子

OCamlでは+もmodも関数で、実は中置演算子というのは糖衣構文 (syntactic sugar)

# (+);;
- : int -> int -> int = <fun>
# (+) 3;;
- : int -> int = <fun>
# List.map ((+) 2) [1; 2; 3];;
- : int list = [3; 4; 5]

負の定数には前置演算子(?)~-2~-.0.16を用いる必要があることもある。

# let bmi height weight = weight /. height ** 2.0;;
val bmi : float -> float -> float = <fun>
# bmi 1.77 68.9;;
- : float = 21.9924032046985225
# bmi 1.77;;
- : float -> float = <fun>
# bmi 1.77 -. 0.01;;
Characters 0-8:
  bmi 1.77 -. 0.01;;
  ^^^^^^^^
Error: This expression has type float -> float
       but an expression was expected of type float
# bmi (1.77 -. 0.01);;
- : float -> float = <fun>
# bmi 1.77 ~-.70.01;;
- : float = -22.3467075233808927

実数

実数は加減乗除+., -., *., /.とベキ乗**の計算ができる。

問題 2.2

# 7.0/.2.0;;
- : float = 3.5
# 2.0 *. 3.14 *. 10.0;;
- : float = 62.8000000000000043
# 1.73 ** 2.0;;
- : float = 2.9929
# 7.0 /. 2.0;;
- : float = 3.5

±∞と-0.0とNaN

# infinity *. -0.1;;
- : float = neg_infinity
# -0.0;;
- : float = -0.
# infinity *. 0.0;;
- : float = nan

型の違いによるエラーの例

# 2.0 *. 2;;
Characters 7-8:
  2.0 *. 2;;
         ^
Error: This expression has type int but an expression was expected of type float

文字列

文字列は^で結合できる。

問題 2.3

# "東京" ^ "特許" ^ "許可局" ^ "局長";;
- : string = "東京特許許可局局長"
# "関数" ^ "型" ^ "言語";;
- : string = "関数型言語"

キャラクタ

'A'などと指定する。 Char標準モジュールがある。

# 'A';;
- : char = 'A'
# Char.code 'A';;
- : int = 65
# "ABC".[1];;
- : char = 'B'

真偽値 (Boolean)

true or false&&, ||, not

問題 2.3

同じ型のものは比較できても異なる型のものは比較できない。

# 2 > 3;;
- : bool = false
# not(3.1415**2.0 > 10.0);;
- : bool = true
# 3+4+5 = 4*3;;
- : bool = true
# true > false;;
- : bool = true
# 3.14 > 3;;
Characters 7-8:
  3.14 > 3;;
         ^
Error: This expression has type int but an expression was expected of type float

NaNの比較

NaNが含まれる実数の比較はいつもfalseが返ることを利用してNaNの判定をしてみる。 引数が実数あるという制限 (type constraint) をかけて、実数の比較が呼ばれるようになっている。 詳しくは https://groups.google.com/forum/#!topic/fa.caml/ZVxHLBYEMwA を見よ。

# nan > 1.0;;
- : bool = false
# nan < 1.0;;
- : bool = false
# 1.0 < nan;;
- : bool = false
# 1.0 > nan;;
- : bool = false
# infinity > nan;;
- : bool = false
# nan > infinity;;
- : bool = false
# nan = nan;;
- : bool = false
# let is_nan (x:float) = not (x = x);;
val is_nan : float -> bool = <fun>
# is_nan (1.0 /. 0.0);;
- : bool = false
# is_nan (infinity /. 0.0);;
- : bool = false
# is_nan (infinity *. 0.0);;
- : bool = true

unit型

unit型は()という値のみを持つ型。 C言語でいうところのvoid。 forループやString.iterは()を返さないといけない。 :=は()を返す。

変数の定義

問題 3.1

次の変数をOCamlインタプリタで定義せよ。それぞれの変数の型は何か。

# let e = 2.7182;;
val e : float = 2.7182
# let positive = e > 0.0;;
val positive : bool = true
# let seconds_of_day = 60*60*24;;
val seconds_of_day : int = 86400
# let name = "茗荷谷";;
val name : string = "茗荷谷"

問題 3.2

こういうのを表示してくれる仕組みはないのかな。trace?

1.0 +. e      *. 2.0
1.0 +. 2.7182 *. 2.0
1.0 +. 5.4364
6.4364

関数の定義

問題 4.1

アルバイトを始めたときには時給850円だが1年経過するごとに時給が100円ずつあがることにしよう。 アルバイトを始めてからの年数とその月に働いた時間が与えられたら、 その月の給与を返す関数baito_kyuyoを定義せよ。 (引数以外の変数は関数の定義の前に定義されていなくてはならない。)

# let baito_kyuyo years hours = kihonkyu + hours * (jikyu + 100 * years);;
Characters 24-32:
  let baito_kyuyo years hours = kihonkyu + hours * (jikyu + 100 * years);;
                          ^^^^^^^^
Error: Unbound value kihonkyu
# let kihonkyu=100;;
val kihonkyu : int = 100
# let jikyu = 850;;
val jikyu : int = 850
# let baito_kyuyo years hours = kihonkyu + hours * (jikyu + 100 * years);;
val baito_kyuyo : int -> int -> int = <fun>
# baito_kyuyo 1 25 + baito_kyuyo 1 28 + baito_kyuyo 1 31;;
- : int = 80100

問題 4.2

名前を与えたら、適当な自己紹介文を返す関数。

# let jikoshokai name = "私の名前は" ^ name ^ "です。";;
val jikoshokai : string -> string = <fun>
# jikoshokai "松子";;
- : string = "私の名前は松子です。"

問題 4.3

標準体重。

# let hyojun_taiju height = height ** 2.0 *. 22.0;;
val hyojun_taiju : float -> float = <fun>
# hyojun_taiju 1.77;;
- : float = 68.9238

問題 4.3

BMI。 身長だけを入れると、引数が1つだけの関数が返される。 つまりval bmi : float -> (float -> float) = <fun>ということ。

# let bmi height weight = weight /. height ** 2.0;;
val bmi : float -> float -> float = <fun>
# bmi 1.77 68.9;;
- : float = 21.9924032046985225
# bmi 1.77;;
- : float -> float = <fun>

関数のデザインレシピ

「強く型付けされた言語」でも test first で書くのね。

問題 4.8

tsurukame.ml

# #use "tsurukame.ml";;
val tsurukame : int -> int -> int = <fun>
val test1 : bool = true
val test2 : bool = true
val test3 : bool = true

データ型

ここではタプル、レコード、リストを説明。 バリアント型と配列は後半で節を改めて説明。

タプル(tuple, 組)

タプルは("Paul", "Dirac", 1902, 8, 8)のようにカンマで区切る。 カッコは必須ではないが、混乱を避けるため付けておく。 _がワイルドカード。

# let dirac = ("Paul", "Dirac", 1902, 8, 8);;
val dirac : string * string * int * int * int = ("Paul", "Dirac", 1902, 8, 8)
# 1900 < match dirac with (_,_,year,_,_) -> year;;
- : bool = true

パターンマッチが使える。Erlangみたいなことができる?

問題 7.2

seiseki.ml

# #use "seiseki.ml";;
val seiseki : string * int -> string = <fun>
val test1 : bool = true
val test2 : bool = true
# seiseki ("桃子", 77);;
- : string = "桃子さんの評価は 77点です"

レコード (record)

typeで定義。{}でくくる。フィールドとその値。 フィールドは他のレコードのフィールドと重なってはいけない。 フィールドの順番は自由だが、フィールドを省略することはできない。 教科書『プログラミングの基礎』では.(ドット)を使ったフィールドの参照は非推奨。

# type gakusei_t = {
    name    : string;
    tensuu  : int;
    seiseki : string;
};;
        type gakusei_t = { name : string; tensuu : int; seiseki : string; }
# let asai = {
    name    = "浅井";
    tensuu  = 70;
    seiseki = "B";
};;
        val asai : gakusei_t = {name = "浅井"; tensuu = 70; seiseki = "B"}
# asai.seiseki;;
- : string = "B"
# let kiyo = {name = "清原";};;
Characters 11-32:
  let kiyo = {name = "清原";};;
             ^^^^^^^^^^^^^^^^^^
Error: Some record fields are undefined: tensuu seiseki

8.3節あたり

tsuuchi.mltuareg-eval-buffer (C-c C-b) を使ってみる。

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

let tsuuchi gakusei = match gakusei with
    {name=n; tensuu=t; seiseki=s} ->
    {name=n; tensuu=t;
         seiseki= if t>=80 then "A"
         else     if t>=70 then "B"
         else     if t>=60 then "C" else "D"}

(* tests *)
let test1 = tsuuchi {name="花子"; tensuu=100; seiseki=""} = {name="花子"; tensuu=100; seiseki="A"}
let test2 = tsuuchi {name="太郎"; tensuu= 77; seiseki=""} = {name="太郎"; tensuu= 77; seiseki="B"};;
                              type gakusei_t = { name : string; tensuu : int; seiseki : string; }
val tsuuchi : gakusei_t -> gakusei_t = <fun>
val test1 : bool = true
val test2 : bool = true

OCaml入門(3) レコード、バリアント、例外、参照も参考になる。 参照を使ったリストの連結の定義がナゾ。

複素数

標準ライブラリのComplexはこのレコードで実装されている。 日本語のマニュアル英語のマニュアル

# open Complex;;
# mul {re=1.0; im=1.0} {re=1.0; im=1.0};;
- : Complex.t = {re = 0.; im = 2.}

リスト

要素の型は1つに限る。 ::がcons演算子。@が連結。 操作はList Moduleに定義されている。 car, cdrはそれぞれList.hd, List.tl(headとtail)だが、 パターンマッチングでhead :: tailを使うのが定石。 OCaml 標準ライブラリ探訪 #2 List : スタックと計算量に注意 が参考になりそう。

# 1 :: [];;
- : int list = [1]
# 1 :: 2 :: [];;
- : int list = [1; 2]
# List.length [1; 2];;
- : int = 2
# List.sort compare [1; 3; 2];;
- : int list = [1; 2; 3]
# [1;2;3] @ [4;5;6];;
- : int list = [1; 2; 3; 4; 5; 6]

受け取ったリストに0が含まれているかを判別する contain_zero.ml

# let rec contain_zero lst = match lst with
    [] -> false
  | first :: rest ->
    if first = 0 then true
                 else contain_zero rest

(* test *)
let test1 = contain_zero []           = false
let test2 = contain_zero [0; 1; 2; 3] = true
let test3 = contain_zero [1; 2; 0; 3] = true
let test4 = contain_zero [1; 2; 3; 4] = false;;
                    val contain_zero : int list -> bool = <fun>
val test1 : bool = true
val test2 : bool = true
val test3 : bool = true
val test4 : bool = true

問題 9.4

受け取ったリストの長さを返す。

普通の: length.ml

末尾再帰: length_tail_rec.ml。 この中のlet NAME = EXPRESSION1 in EXPRESSION2が局所定義 (the local definition)。 EXPRESSION1EXPRESSION2の中でだけ使える。

普通は標準ライブラリ list.ml の中に定義されているList.lengthを使えばよい。

問題 9.5

整数のリストのを受け取り、その中の偶数の要素のみを含むリストを返す。

even_tail_rec.ml。 これだと順番が逆になるけど。

ちなみにList.filterを使うとこんな感じ(funを使わなくて済む方法はないのか):

# List.filter (fun x -> 0 = x mod 2) [2; 1; 6; 4; 7];;

順番が保たれる回答: even.ml@を使った。functionも使ってみた。 なお、ここでやっている通り、OCamlではxs @ [x] したら負けlist.mlfilterの実装にある通り、最後にList.revすること。

最後にList.revすることにして、さらにifを後ろに移した回答: even_if.ml。 こうしたほうが、コンパイラが末尾再帰にしやすいとか、よいのだろうか。

問題 9.6

文字列のリストを受け取り、その要素すべてを結合した文字列を返す。 concat.ml

9.6節

レコードのリストgakusei_t listを受け取って、A評価の人の数を数える。 count_A.ml

10.1節

受け取ったリストの「接頭語」のリストを返す。なんでこれが「接頭語」なのか。 prefix.mlList.map(fun l -> first :: l)を渡してみた。:: は特別な演算子なのか、((::) first) と書けない?

問題 10.1, 10.2

挿入ソート。insert sort。ins_sort.ml

参考: http://www.geocities.jp/m_hiroi/func/ocaml04.html パターンマッチングでasを使ってる

10.2節

リストの中の最小値を求める関数。 min_in_list.mlmax_int = 4611686018427387903を使っている。[]に対応できない→例外処理。

10.6節 merge sort

http://www.codecodex.com/wiki/Merge_sort からほとんどコピペで merge.mlを書いた。

末尾再帰

末尾再帰には『プログラミングの基礎』第16章に説明がある accumulator を用いるのが便利である。

問題 16.1

sum_list.ml。 受け取った整数のリストのそこまでの和のリストを返す。 3つの方法で実装した。

階乗 factorial

factorial.mlfact.mlとを ocamlopt -S -cでコンパイルして、アセンブラ出力factorial.sfact.sとを比較すると、 factorial.sjmpなのがわかる。

OCamlではオーバーフローしても例外は発生しないし、Rubyのように自動的に多倍長整数にもならない。

多倍長整数モジュールBig_intをインタラクディブに使うには #load "nums.cma";; とタイプしてnumライブラリをロードする。 open Big_intすればBig_int.mult_int_big_int n aなどのBig_int.を省略できる。 こんなかんじでfactorial_big 200も一瞬で計算できる:

# let factorial n =
  let rec factorial_helper (n, a) =
    if n = 0 then a else factorial_helper (n - 1, a * n)
  in
  factorial_helper (n, 1);;
        val factorial : int -> int = <fun>
# factorial 5;;
- : int = 120
# factorial 100;;
- : int = 0
# #load "nums.cma";;
# open Big_int
let factorial_big n =
  let rec factorial_big_helper a n =
    if n = 0 then a else factorial_big_helper (mult_int_big_int n a) (n-1)
  in
  factorial_big_helper unit_big_int n;;
          val factorial_big : int -> Big_int.big_int = <fun>
# string_of_big_int (factorial_big 5);;
- : string = "120"
# string_of_big_int (factorial_big 100);;
- : string =
"933 ... 000"
# string_of_big_int (factorial_big 200);;
- : string =
"788 ... 000"
# power_int_positive_int 10 42 |> string_of_big_int;;
- : string = "1000000000000000000000000000000000000000000"

fbig.mlBig_intを使った実行形式をつくるコードで、 そのコンパイル方法をこの文章の終わりの方に書いた。

フィボナッチ数

fib.ml

末尾再帰にしたfibonacci.mlなら、 fibonacci 90;;なども一瞬でできる。91以上はオーバーフローする。

漸化式 (recurrence relation)

問題 11.2

a.ml。 一般項はa**(i+1)+1だけど、その自動証明とかに使えるのかな?

パターンマッチング

list.mlにあるように、 match式によるパターンマッチングはfunction文を使うと簡単になる。 function 文は匿名関数とmatch式を組み合わせたもの。 参考: お気楽OCamlプログラミング入門 パターンマッチング

# let rec length_aux1 len = function
    [] -> len
  | head::tail -> length_aux1 (len + 1) tail;;
    val length_aux1 : int -> 'a list -> int = <fun>
# let rec length_aux2 len lst = match lst with
    [] -> len
  | head::tail -> length_aux2 (len + 1) tail;;
    val length_aux2 : int -> 'a list -> int = <fun>
# let length1 lst = length_aux1 0 lst;;
val length1 : 'a list -> int = <fun>
# let length2 lst = length_aux2 0 lst;;
val length2 : 'a list -> int = <fun>
# length1 [];;
- : int = 0
# length1 ["aaa"; "bbb"; "ccc"];;
- : int = 3
# length2 [1; 2; 3; 4; 5];;
- : int = 5

カリー化 (currying) と匿名関数

これまで引数を2つ以上とる関数を使ってきたが、これはカリー化によって表現されていた。 また、カリー化によって表現された関数は引数の部分適用ができる。

次の2つの匿名関数は等価。

# fun x y -> x + y;;
- : int -> int -> int = <fun>
# fun x -> fun y -> x + y;;
- : int -> int -> int = <fun>

参考1: OCamlのお勉強 その5 ~カリー化、高階関数、匿名関数~

参考2: OCamlチュートリアル > 関数型プログラミング

カリー化(もしかしてアンカリー化)と高階関数(汎関数)とList.mapと匿名関数 (anonymous function, nameless function) と。

# let plus a b =
    a + b;;
  val plus : int -> int -> int = <fun>
# plus;;
- : int -> int -> int = <fun>
# plus 2;;
- : int -> int = <fun>
# plus 2 3;;
- : int = 5
# List.map (plus 2) [1; 2; 3];;
- : int list = [3; 4; 5]
# List.map (fun x -> x*x) [-1; 0; 1; 2; 3];;
- : int list = [1; 0; 1; 4; 9]

2つのリストのドット積(内積)

List.fold_left2を使って2つの浮動小数点数リストのドット積を計算する。 List.fold_left2の定義通りの順番に引数を置いておけばよい。

# List.fold_left2;;
- : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b list -> 'c list -> 'a = <fun>
# List.fold_left2 (fun a b c -> a +. b *. c) 0.0 [0.2; 0.3] [-0.3; 0.2];;
- : float = 0.
# let dot_product = List.fold_left2 (fun a b c -> a +. b *. c) 0.0;;
val dot_product : float list -> float list -> float = <fun>
# dot_product [0.707106781186547; 0.707106781186547]
              [0.707106781186547; 0.707106781186547];;
  - : float = 0.999999999999998557

関数を返す関数

高階関数は関数を受け取って、関数を返してもよい。

問題 13.3

# let f1 x = x;;
val f1 : 'a -> 'a = <fun>
# let f2 x y = x;;
val f2 : 'a -> 'b -> 'a = <fun>
# let f3 x y = y;;
val f3 : 'a -> 'b -> 'b = <fun>
# let f4 x f = f x;;
val f4 : 'a -> ('a -> 'b) -> 'b = <fun>
# let f5 f g = let h x = (g (f x)) in h;;
val f5 : ('a -> 'b) -> ('b -> 'c) -> 'a -> 'c = <fun>

問題 13.4

関数を2つ受け取ったら、それらを合成した関数を返す関数compose

# let time2 x = 2 * x;;
val time2 : int -> int = <fun>
# let add3 x = 3 + x;;
val add3 : int -> int = <fun>
# let compose f g = let h x = f (g x) in h;;
val compose : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b = <fun>
# (compose time2 add3) 4;;
- : int = 14

クイックソート

15.2節

quick_sort.ml

quick_sort_partition.mlちょっとだけクイックソート - チラシの裏 よりList.partitionを使って。 さらに、結合 (append, '@') を使わないのquick_sort_no_append.ml。すごい。

問題 15.2

エラトステネスの篩 eratosthenes.mlList.filterを使わないで、first, 2*first, 3*first, ... を落として行くようにすれば速くなるはずだがやり方がわからない。

バリアント型 (variant type)

「どれかひとつ」を表す型。

とりあえずバリアント型を使ってみる

構成子 (Tag) は大文字から始まらなくてはならない。

type <variant> =
  | <Tag> [ of <type> [* <type>]... ]
  | <Tag> [ of <type> [* <type>]... ]
  | ...

17章の例で時刻をタプルに変更してみた:

# type jikoku_t =
    | Gozen of int * int
    | Gogo  of int * int
    | Noon
    | Midnight;;
        type jikoku_t = Gozen of int * int | Gogo of int * int | Noon | Midnight
# Gozen (10,10);;
- : jikoku_t = Gozen (10, 10)
# Noon;;
- : jikoku_t = Noon
# Gogo 10;;
Characters 0-7:
  Gogo 10;;
  ^^^^^^^
Error: The constructor Gogo expects 2 argument(s),
       but is applied here to 1 argument(s)
# Gogo (10,30);;
- : jikoku_t = Gogo (10, 30)

さらにレコードに (record) に変更してみた:

# type jikoku_rec = {hour:int; minute:int};;
type jikoku_rec = { hour : int; minute : int; }
# type jikoku_variant =
    | Gozen of jikoku_rec
    | Gogo  of jikoku_rec
    | Noon
    | Midnight;;
        type jikoku_variant =
    Gozen of jikoku_rec
  | Gogo of jikoku_rec
  | Noon
  | Midnight
# Noon;;
- : jikoku_variant = Noon
# Gogo ({hour=10; minute=10});;
- : jikoku_variant = Gogo {hour = 10; minute = 10}
# Gozen {hour=10; minute=10};;
- : jikoku_variant = Gozen {hour = 10; minute = 10}

バリアント型とタプルとで二分木を実装する

17.3節

sum_tree.ml

問題 17.5

値を全て2倍にした木を返す tree_double.ml

問題 17.6

木構造の全てのエレメントに関数fを施す tree_map.ml

問題 17.7

tree_length.ml

17.4節

search.mlと。

手続き型言語的な使い方(参照型と値の書き換え、ループ、etc.)

22.3節

参照型let sum = ref 0とか、 値の書き換え:=()を返す。)とか。

大学入試センター試験のチェックデジット

dnc.mlではforループを使っている。

ズンドコキヨシ

「ズン」「ドコ」のいずれかをランダムで出力し続けて 「ズン」「ズン」「ズン」「ズン」「ドコ」の配列が出たら 「キ・ヨ・シ!」って出力した後終了って関数ズンドコキヨシズンドコOCamlcnt >= 4にすること)を参考に print_endlineをたくさん使って普通に書き直してみた: zundoko.ml

Random.boolunit -> boolな関数で、 Unix.gettimeofdayunit -> floatな関数で、 それらに引数の()を与えて初めて欲しいものが出てくるのだな。

配列 (array)

22.6節

配列は書き換えを前提にして作られたデータ構造。 Arrayモジュールが使える。

# let a = [| 0.0; 1.1; 0.0; 0.0 |];;
val a : float array = [|0.; 1.1; 0.; 0.|]
# Array.set a 2 2.2;;
- : unit = ()
# a.(3) <- 3.3;;
- : unit = ()
# a;;
- : float array = [|0.; 1.1; 2.2; 3.3|]
# Array.fold_left (+.) 0.0 a;;
- : float = 6.6
# Array.fold_right (+.) a 0.0;;
- : float = 6.6

問題 22.2

整数の配列にフィボナッチ数を入れて返す fib_array.ml

OCamlで state machine をどう書くか

引数が状態の関数をtail callし続ければよいのではないか。

参考1: How to represent a simple finite state machine in OCaml?

参考2: automata in OCaml

参考3: grammarlearning

参考4: Tree automaton

OCamlの記号一覧

もちろん Pervasives に書いてある。

OCamlの記号あれこれ

ここにも http://rigaux.org/language-study/syntax-across-languages-per-language/OCaml.html

Operators for the list

:: は特別な演算子なのか、((::) first) と書けない?

@ は2つのリストをくっつける。list1 @ list2list1の長さに比例した時間がかかる。

Composition operators

Reverse-application operator: x |> f |> g is exactly equivalent to g (f (x)).

Application operator: g @@ f @@ x is exactly equivalent to g (f (x)).

# let minus x y = x - y;;
val minus : int -> int -> int = <fun>
# minus 5 6;;
- : int = -1
# 6 |> minus 5;;
- : int = -1
# minus 5 2 + 4;;
- : int = 7
# minus 5 @@ 2 + 4;;
- : int = -1

実行形式を作る

標準ライブラリをリンクして実行形式を作る

OCamlの標準ライブラリと一緒に配布されてる numライブラリの中には Num, Big_int, Arith_statusの3つのモジュールが入っている。 コマンドライン引数から1つ整数を読み込んでその階乗を標準出力に印刷するプログラム fbig.mlでは、 Big_intを使うためにそのnums.cmaをリンクしている。

$ ocamlc nums.cma fbig.ml -o fbig
$ ./fbig 36
371993326789901217467999448150835200000000

自前モジュールを使って実行形式を作る

OCamlチュートリアル モジュールを参考にした。

$ head -22 Makefile h*.ml*
==> Makefile <==
#-*-Makefile-*- for hello
##
hello: hmodule.cmx hello.cmx
	ocamlopt -o $@ $^
%.cmx: %.ml
	ocamlopt -c $<
%.cmi: %.mli
	ocamlc   -c $<
hmodule.cmx: hmodule.cmi
hello.cmx:   hmodule.cmx
clean:
	rm -f *.cmx *.cmi *.o hello

==> hello.ml <==
Hmodule.hello ()

==> hmodule.ml <==
let message = "Hello!"
let hello () = print_endline message

==> hmodule.mli <==
val hello : unit -> unit
(** Displays a greeting message. *)
$ make
ocamlc   -c hmodule.mli
ocamlopt -c hmodule.ml
ocamlopt -c hello.ml
ocamlopt -o hello hmodule.cmx hello.cmx
$ ./hello
Hello!
$ ocamlopt -o hello hello.cmx hmodule.cmx
File "_none_", line 1:
Error: No implementations provided for the following modules:
         Hmodule referenced from hello.cmx

最後に例示したように、リンクの順序に意味があることに注意が必要。

エントリポイントと評価順序について

OCamlには特にエントリポイントというものはなく、 式が現れた順に評価される。 上のようにリンクの順序に意味があるのも多分そのため。

次のような1行だけのprog.mlが動くのは ファイルの最後でたまたまセミコロンが省略可能だった式が普通に評価されるから。 2行にするならprog2.mlのように1つか2つのセミコロンが必要。

$ head prog.ml prog2.ml
==> prog.ml <==
print_endline "Hello, world!"

==> prog2.ml <==
print_endline "Hello, world!";
print_endline "Hello, universe!"
$ ocaml prog.ml
Hello, world!
$ ocaml prog2.ml
Hello, world!
Hello, universe!

OCamlMakefile

OCamlMakefileは 複雑なOCamlプロジェクトのコンパイル作業を簡単化するツール。 ホームページGitHubから入手できる。

上のhello用のMakefileは次の通りで、 makemake bcと等価でバイトコードの実行ファイルを作成), make nc(ネイティブコードの実行ファイルを作成), make cleanなどができる。

#-*-Makefile-*- for hello-with-OCamlMakefile
##
RESULT = hello
SOURCES = hmodule.mli hmodule.ml hello.ml
OCAMLMAKEFILE = OCamlMakefile
include $(OCAMLMAKEFILE)

fbig.ml用はLIBSを使う。

#-*-Makefile-*- for fbig-with-OCamlMakefile
##
RESULT = fbig
LIBS = nums
SOURCES = fbig.ml
OCAMLMAKEFILE = OCamlMakefile
include $(OCAMLMAKEFILE)
make clean && make bc && /usr/bin/time ./fbig 100000 > /dev/null
make clean && make nc && /usr/bin/time ./fbig 100000 > /dev/null
make clean && ocamlopt.opt nums.cmxa -o fbig fbig.ml && /usr/bin/time ./fbig 100000 > /dev/null

の3つで、速度がたいして違わないのはどうしたわけなんだ。

OCamlMakefileをFindlibとともに使う

Findlib(コマンド名はocamlfind) を使うとライブラリのありかを探してくれるらしい。

OCaml関係の拡張子一覧

詳しくは Native-code compilation (ocamlopt)Batch compilation (ocamlc) などを参照せよ。

  • .ml OCamlソース
  • .mli インターフェース。例えば、list.mlに対して、 外部に公開する関数を羅列しているのがlist.mli
  • .cmi コンパイルされたインターフェース情報。
  • .cmo バイトコードのオブジェクトファイル。ocamlc -c foo.mlでできる。
  • .cmx ネイティブコードのオブジェクトファイル。ocamlopt -c foo.mlでできる。
  • .cma ライブラリ。バイトコード。
  • .cmxa ライブラリ。ネイティブコード。
  • .cmxs OCaml plugin file???
  • .cmt ocamlc -bin-annot foo.mlでできるやつ
  • .o ネイティブオブジェクトコード。ocamlopt -c foo.mlでできる。.cmxがあるので、利用されることはほぼない。
  • .s アセンブラ出力。ocamlopt -S -c factorial.mlでできる。
  • .mll ocamllexのソースコード。
  • .mly ocamllexのソースコード。

トップレベルシステムであるocamlコマンドのの引数には、 そのまま**.cmoオブジェクトファイルや.cmaライブラリを与えることもできる。 また、トップレベル内では#load "foo.cmo";;.cmoオブジェクトファイルや.cma**ライブラリを、 #use "bar.ml";;でソースファイルを読み込むことができる。 #load#useなどはトップレベル環境でのみ使用できる。 詳細はToplevel system (ocaml)を見よ。

感想

  • やっと関数型言語をひととおり学習できた。手続き型言語やRubyの知識があって、 Eelangでパターンマッチングをいじったことがあって、 Schemeで何度も挫折していたので、なんとか浅井健一著『プログラミングの基礎』を最後まで…
  • これを学部2年生でやるのはすごい。
  • インストールの敷居が高い。UTF-8で漢字の入出力に対応させるのがわりと面倒。
  • ところどころで「停止性」について言及しているが、いまいちピンとこない。
  • 末尾再帰とか末尾最適化とかは 必須ではないし、そんなにこだわらなくてよいみたい。 『プログラミングの基礎』では言及なし。
  • コンマやLispのような括弧がないので、 関数の引数をfibonacci_helper next (next+current) (n-1)などと書かなければいけないときに括弧を忘れがち。

付録

Macで./configure -x11include /opt/X11/include -x11lib /opt/X11/libした時の最後

[WARNING] BFD library not found, 'objinfo' will be unable to display info on .cmxs files.
Assembler supports CFI

** Configuration summary **

Directories where OCaml will be installed:
        binaries.................. /usr/local/bin
        standard library.......... /usr/local/lib/ocaml
        manual pages.............. /usr/local/man (with extension .1)
Configuration for the bytecode compiler:
        C compiler used........... gcc
        options for compiling..... -O  -Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT
        options for linking.......     -lcurses -lpthread
        shared libraries are supported
        options for compiling..... -O  -O  -Wall -D_FILE_OFFSET_BITS=64 -D_REENTRANT
        command for building...... gcc -bundle -flat_namespace -undefined suppress -Wl,-no_compact_unwind -o lib.so /a/path objs
Configuration for the native-code compiler:
        hardware architecture..... amd64
        OS variant................ macosx
        C compiler used........... gcc
        options for compiling..... -O  -D_FILE_OFFSET_BITS=64 -D_REENTRANT
        options for linking.......
        assembler ................ clang -arch x86_64 -c
        preprocessed assembler ... clang -arch x86_64 -c
        assembler supports CFI ... yes
        with frame pointers....... no
        naked pointers forbidden.. no
        native dynlink ........... true
        profiling with gprof ..... supported
Source-level replay debugger: supported
Additional libraries supported:
        unix str num dynlink bigarray systhreads threads graph
Configuration for the "num" library:
        target architecture ...... amd64 (asm level 1)
Configuration for the "graph" library:
        options for compiling .... -I/opt/X11/include
        options for linking ...... -L/opt/X11/lib -lX11

** OCaml configuration completed successfully **
(* a : int -> int *)
(* 漸化式の計算を行う *)
let a n =
let rec a_helper a n =
if n = 0 then a else a_helper (2*a-1) (n-1)
in
a_helper 3 n
(* tests *)
let test0 = a 0 = 3
let test1 = a 1 = 5
let test2 = a 2 = 9
let test3 = a 3 = 17
let test4 = a 4 = 33
(* 目的:文字列のリストを受け取り、その要素すべてを結合した文字列を返す *)
(* concat : string list -> string *)
let concat lst =
let rec concat_helper lst a =
match lst with
[] -> a
| head :: tail -> concat_helper tail (a^head)
in
concat_helper lst ""
(* test *)
let test1 = concat [] = ""
let test2 = concat ["aaa"] = "aaa"
let test3 = concat ["aa"; "bb"] = "aabb"
let test4 = concat ["春"; "夏"; "秋"; "冬"] = "春夏秋冬"
(* int list は
- [] 空リスト、あるいは
- first :: rest 最初の要素が first、残りのリストが rest
(rest が自己参照のケース)
という形 *)
(* 目的:受け取ったリストに 0 が含まれているかを真偽値で返す *)
(* contain_zero : int list -> bool *)
let rec contain_zero lst = match lst with
[] -> false
| first :: rest ->
if first = 0 then true
else contain_zero rest
(* test *)
let test1 = contain_zero [] = false
let test2 = contain_zero [0; 1; 2; 3] = true
let test3 = contain_zero [1; 2; 0; 3] = true
let test4 = contain_zero [1; 2; 3; 4] = false
(* tsuuchi : gakusei_t list -> int *)
(* 目的:gakusei_t listを受け取って、A評価の人の数を数える *)
type gakusei_t = {
name : string;
tensuu : int;
seiseki : string;
}
let count_A lst =
let rec count_A_helper n_of_A = function
| [] -> n_of_A
| {name=n; tensuu=t; seiseki=s} :: rest -> count_A_helper (if s="A" then n_of_A+1 else n_of_A) rest
in
count_A_helper 0 lst
(* tests *)
let list0 = []
let list1 = [{name="花子"; tensuu=100; seiseki="A"};
{name="太郎"; tensuu= 77; seiseki="B"}]
let list2 = [{name="花子"; tensuu=100; seiseki="A"};
{name="太郎"; tensuu= 77; seiseki="B"};
{name="もも"; tensuu= 90; seiseki="A"}]
let test0 = count_A list0 = 0
let test1 = count_A list1 = 1
let test2 = count_A list2 = 2
(* dnc : string -> bool *)
(* 大学入試センター試験の受験番号のチェックディジットが正しいかどうかを判定する *)
let dnc s =
let sum = ref 0 in
for i = 1 to 10 do
sum := !sum + i * (Char.code s.[i-1] - 48)
done;
"ABCHKMRUXYZ".[!sum mod 11] = s.[10]
(* tests *)
let test1 = dnc "1114019999K"
let test2 = not (dnc "1114019999A")
(* eratosthenes.ml *)
(* 目的:2 から n までの自然数を受け取り 2 から n までの素数を返す *)
(* sieve : int list -> int list *)
let rec sieve = function
| [] -> []
| first :: rest -> first :: sieve (List.filter (fun x -> x mod first <> 0) rest)
(* 再帰のたびに lst の長さが小さくなっているので、いずれ [] になり停止する *)
(* テスト *)
let test1 = sieve [2; 3; 4; 5; 6; 7; 8; 9; 10] = [2; 3; 5; 7]
(* 目的:2 から受け取った自然数 n までの奇数の自然数のリストを返す *)
(* two_to_n : int -> int list *)
let two_to_n n =
let lst = ref [2] in
for i = 1 to n/2-1 do
lst := 2*i+1 :: !lst
done;
List.rev !lst
(* テスト *)
let test2 = two_to_n 10 = [2; 3; 5; 7; 9]
(* 目的:2から受け取った自然数nまでの奇数の自然数のリストを返す.再起で. *)
(* two_to_n : int -> int list *)
let two_to_n_loop n =
let rec loop i =
if i <= n then
i :: loop (i + 2)
else
[]
in
2 :: (loop 3)
(* テスト *)
let test3 = two_to_n_loop 10 = [2; 3; 5; 7; 9]
(* 目的:2 から受け取った自然数 n までの素数を返す *)
(* prime : int -> int list *)
let prime n = sieve (two_to_n n)
(* テスト *)
let test4 = prime 12 = [2; 3; 5; 7; 11]
(* 目的:整数のリストのを受け取り、その中の偶数の要素のみを含むリストを返す。*)
(* even_tail_rec : int list -> int *)
let even lst =
let rec even_helper a = function
[] -> a
| head :: tail -> if 0 = head mod 2
then even_helper (a @ [head]) tail
else even_helper a tail
in
even_helper [] lst
(* test *)
let test1 = even [] = []
let test2 = even [1] = []
let test3 = even [2] = [2]
let test4 = even [2; 1; 6; 4; 7] = [2; 6; 4]
let test5 = even [0; 1; 2; 3] = [0; 2]
let test6 = even [-1; 1; 3] = []
(* 目的:整数のリストのを受け取り、その中の偶数の要素のみを含むリストを返す。*)
(* even_tail_rec : int list -> int *)
let even lst =
let rec even_helper a = function
[] -> List.rev a
| head :: tail -> even_helper (if 0 = head mod 2 then (head :: a) else a) tail
in
even_helper [] lst
(* test *)
let test1 = even [] = []
let test2 = even [1] = []
let test3 = even [2] = [2]
let test4 = even [2; 1; 6; 4; 7] = [2; 6; 4]
let test5 = even [0; 1; 2; 3] = [0; 2]
let test6 = even [-1; 1; 3] = []
(* 目的:整数のリストのを受け取り、その中の偶数の要素のみを含むリストを返す。これだと順番が逆になるけど。*)
(* even_tail_rec : int list -> int *)
let even_tail_rec lst =
let rec even_tail_rec_helper lst a =
match lst with
[] -> a
| head :: tail -> if 0 = head mod 2
then even_tail_rec_helper tail (head :: a)
else even_tail_rec_helper tail a
in
even_tail_rec_helper lst []
(* test *)
let test1 = even_tail_rec [] = []
let test2 = even_tail_rec [1] = []
let test3 = even_tail_rec [2] = [2]
let test4 = even_tail_rec [2; 1; 6; 4; 7] = [4; 6; 2]
let test5 = even_tail_rec [0; 1; 2; 3] = [2; 0]
let test6 = even_tail_rec [-1; 1; 3] = []
(* fact : int -> int *)
(* 階乗の計算を行う *)
let rec fact n =
if n = 0 then 1 else n * fact (n-1)
(* tests
let test0 = fact 0 = 1
let test1 = fact 1 = 1
let test2 = fact 2 = 2
let test3 = fact 3 = 6
let test4 = fact 4 = 24
*)
(* factorial : int -> int *)
(* 階乗の計算を行う *)
let factorial n =
let rec factorial_helper (n, a) =
if n = 0 then a else factorial_helper (n - 1, a * n)
in
factorial_helper (n, 1)
(* tests
let test0 = factorial 0 = 1
let test1 = factorial 1 = 1
let test2 = factorial 2 = 2
let test3 = factorial 3 = 6
let test4 = factorial 4 = 24
*)
(* factorial_big : int -> big_int *)
(* 大きな階乗の計算を行う *)
(* #load "nums.cma";; してから使う。 *)
open Big_int
let factorial_big n =
let rec factorial_big_helper a n =
if n = 0 then a else factorial_big_helper (mult_int_big_int n a) (n-1)
in
factorial_big_helper unit_big_int n
let test4 = string_of_big_int (factorial_big 4) = "24"
let test5 = string_of_big_int (factorial_big 5) = "120"
(* fbig reads one integer command-line argument,
then prints the factorial of the integer *)
open Big_int
let factorial_big n =
let rec factorial_big_helper a n =
if n = 0 then a else factorial_big_helper (mult_int_big_int n a) (n-1)
in
factorial_big_helper unit_big_int n
let str = Sys.argv.(1)
let () =
print_endline (string_of_big_int (factorial_big (int_of_string str)))
(*
Local variables:
compile-command: "ocamlc nums.cma fbig.ml -o fbig && ./fbig 300"
End:
*)
(* fib : int -> int *)
(* フィボナッチ数の計算を行う *)
let rec fib i = match i with
| 0 -> 0
| 1 -> 1
| _ -> fib (i-2) + fib (i-1)
let test0 = fib 0 = 0
let test1 = fib 1 = 1
let test2 = fib 2 = 1
let test3 = fib 3 = 2
let test4 = fib 4 = 3
(* fib_array : int array -> int array *)
(* 整数の配列にフィボナッチ数を入れて返す *)
let rec fib_array a = match (Array.length a) with
| 0 -> a
| 1 -> (a.(0)<-0; a)
| 2 -> (a.(0)<-0; a.(1)<-1; a)
| _ as n -> (a.(0)<-0; a.(1)<-1;
for i = 2 to n-1 do
a.(i) <- a.(i-2) + a.(i-1)
done;
a)
(* test *)
let test0 = fib_array [||] = [||]
let test1 = fib_array [|1|] = [|0|]
let test2 = fib_array [|1;0|] = [|0;1|]
let test3 = fib_array [|1;0;3|] = [|0;1;1|]
let test4 = fib_array [|1;0;3;4|] = [|0;1;1;2|]
let test5 = fib_array [|1;0;3;4;5|] = [|0;1;1;2;3|]
(* fibonacci : int -> int *)
(* フィボナッチ数の計算を末尾再帰で行う *)
let rec fibonacci n =
let rec fibonacci_helper current next n =
if 0 = n
then current
else fibonacci_helper next (next+current) (n-1)
in
fibonacci_helper 0 1 n
(* test *)
let test0 = fibonacci 0 = 0
let test1 = fibonacci 1 = 1
let test2 = fibonacci 2 = 1
let test3 = fibonacci 3 = 2
let test4 = fibonacci 4 = 3
let test90 = fibonacci 90 = 2880067194370816120
(* gcd: int -> int -> int
greatest common divisor with Euclidean algorithm *)
let rec gcd a b =
if a = 0
then
b
else
if b = 0
then
a
else
if a > b
then
gcd b (a mod b)
else
gcd a (b mod a)
(* test *)
let test0 = gcd 105 105 = 105
let test1 = gcd 252 105 = 21
let test2 = gcd 105 252 = 21
let test7 = gcd 7 7 = 7
Hmodule.hello ()
let message = "Hello!"
let hello () = print_endline message
val hello : unit -> unit
(** Displays a greeting message. *)
(* 目的:整数のリストをinsert sortで昇順に並べる *)
(* 参考:http://www.geocities.jp/m_hiroi/func/ocaml04.html *)
(* 自分で書いたダメなやつ。y::(insert x ys)の発想がなかった。 *)
let rec insetNG x a = function
| [] -> List.rev (x::a)
| first :: rest -> if x < first
then List.rev (first::x::a) @ rest
else insetNG x (first::a) rest
let rec insert x = function
| [] -> [x]
| (y::ys) as a -> if x < y then x::a else y::(insert x ys)
let insert_test1 = insert 1 [] = [1]
let insert_test2 = insert 5 [1] = [1; 5]
let insert_test3 = insert 5 [6; 7] = [5; 6; 7]
let insert_test4 = insert 5 [2; 3; 6; 7] = [2; 3; 5; 6; 7]
(* lstがだいたい昇順になっていると速い。末尾再帰ではない。 *)
let ins_sort = function
| [] -> []
| first :: rest -> insert first (ins_sort rest)
let test1 = ins_sort [] = []
let test2 = ins_sort [4; 2; 3] = [2; 3; 4]
let test3 = ins_sort [5; 5; 4; 9; 8; 2; 3] = [2; 3; 4; 5; 5; 8; 9]
(* lstがだいたい降順になっていると速い。 末尾再帰になっていると思う。 *)
let ins_sort_tail lst =
let rec ins_sort_helper b = function
| [] -> b
| first :: rest -> ins_sort_helper (insert first b) rest
in
ins_sort_helper [] lst
(* テスト *)
let tail1 = ins_sort_tail [] = []
let tail2 = ins_sort_tail [4; 2; 3] = [2; 3; 4]
let tail3 = ins_sort_tail [5; 5; 4; 9; 8; 2; 3] = [2; 3; 4; 5; 5; 8; 9]
(* list は
- [] 空リスト、あるいは
- head :: tail 最初の要素が head、残りのリストが tail
(tail が自己参照のケース)
という形 *)
(* 目的:受け取ったリストの長さを返す *)
(* length : 'a list -> int *)
let rec length lst = match lst with
[] -> 0
| head :: tail -> 1 + length tail
(* test *)
let test1 = length [] = 0
let test2 = length ["aaa"] = 1
let test3 = length ["aa"; "bb"] = 2
let test4 = length [0; 1; 2; 3] = 4
(* 目的:受け取ったリストの長さを返す *)
(* length_tail_rec : 'a list -> int *)
let length_tail_rec lst =
let rec length_tail_rec_helper lst a =
match lst with
[] -> a
| head :: tail -> length_tail_rec_helper tail (a+1)
in
length_tail_rec_helper lst 0
(* test *)
let test1 = length_tail_rec [] = 0
let test2 = length_tail_rec ["aaa"] = 1
let test3 = length_tail_rec ["aa"; "bb"] = 2
let test4 = length_tail_rec [0; 1; 2; 3] = 4
#-*-Makefile-*- for hello
##
hello: hmodule.cmx hello.cmx
ocamlopt -o $@ $^
%.cmx: %.ml
ocamlopt -c $<
%.cmi: %.mli
ocamlc -c $<
hmodule.cmx: hmodule.cmi
hello.cmx: hmodule.cmx
clean:
rm -f *.cmx *.cmi *.cmt *.cmo *.o *.s a.out hello fbig zundoko
(* 目的:2つの昇順のリストをマージする *)
(* これと同じものが標準ライブラリのList.mergeとしてある *)
let rec merge leb lst1 lst2 = match (lst1, lst2) with
| ([], []) -> []
| (first1::rest1, []) -> lst1
| ([], first2::rest2) -> lst2
| (first1::rest1, first2::rest2) ->
if leb first1 first2
then first1 :: merge leb rest1 lst2
else first2 :: merge leb lst1 rest2
(* テスト *)
let test1 = merge (<) [] [] = []
let test2 = merge (<) [] [1; 2] = [1; 2]
let test3 = merge (<) [1; 2] [] = [1; 2]
let test4 = merge (<) [1; 3] [2; 4] = [1; 2; 3; 4]
let test5 = merge (<) [2; 4] [1; 3] = [1; 2; 3; 4]
let test6 = merge (<) [1; 4] [1; 3] = [1; 1; 3; 4]
(* halve a list into two lists, such that all the even indices from the
original list make up the first list, and the odd indices make up the second list. *)
let rec halve = function
| [] -> [],[]
| [x] -> [x],[]
| x::y::tail ->
let a,b = halve tail in
x::a, y::b
let rec merge_sort leb = function
| []
| [_] as list -> list
| list -> let l1, l2 = halve list in
merge leb (merge_sort leb l1) (merge_sort leb l2)
let t1 = merge_sort (<) [] = []
let t2 = merge_sort (<) [4; 2; 3] = [2; 3; 4]
let t3 = merge_sort (<) [5; 5; 4; 9; 8; 2; 3] = [2; 3; 4; 5; 5; 8; 9]
let t4 = merge_sort (>) [5; 5; 4; 9; 8; 2; 3] = [9; 8; 5; 5; 4; 3; 2]
(* 目的:受け取った整数のリストの中の最小の整数を返す *)
(* min_in_list : int list -> int *)
let min_in_list lst =
let rec min_in_list_helper a = function
| [] -> a
| head :: tail -> min_in_list_helper (if a < head then a else head) tail
in
min_in_list_helper max_int lst
(* test *)
let test1 = min_in_list [] = max_int
let test2 = min_in_list [1] = 1
let test3 = min_in_list [0; 1; 2; 3] = 0
let test4 = min_in_list [5; 2; 3; 4] = 2
let test5 = min_in_list [5; 3; 3; 4] = 3
let test6 = min_in_list [max_int; max_int; max_int]
= max_int
(* 目的:受け取った lst の接頭語のリストを返す *)
(* prefix : 'a list -> ('a list) list *)
let rec prefix = function
| [] -> []
| first :: rest -> [first] :: List.map (fun l -> first :: l) (prefix rest)
(* `::` は特別な演算子なのか、`((::) first)` と書けない。 *)
(* テスト *)
let test5 = prefix [] = []
let test6 = prefix [1] = [[1]]
let test7 = prefix [1; 2] = [[1]; [1; 2]]
let test8 = prefix [1; 2; 3; 4] = [[1]; [1; 2]; [1; 2; 3]; [1; 2; 3; 4]]
print_endline "Hello, world!"
print_endline "Hello, world!";
print_endline "Hello, universe!"
(* 目的:リストをleb順に並べる *)
(* quick_sort : ('a -> 'a -> bool) -> 'a list -> 'a list *)
let rec quick_sort leb = function
| [] -> []
| first :: rest ->
quick_sort leb (List.filter (fun x -> not(leb first x)) rest)
@ [first]
@ quick_sort leb (List.filter (leb first) rest)
(* テスト *)
let test1 = quick_sort (<) [] = []
let test2 = quick_sort (<) [4; 2; 3] = [2; 3; 4]
let test3 = quick_sort (<) [5; 5; 4; 9; 8; 2; 3] = [2; 3; 4; 5; 5; 8; 9]
let test4 = quick_sort (>) [5; 5; 4; 9; 8; 2; 3] = [9; 8; 5; 5; 4; 3; 2]
(* 目的:リストをleb順に並べる *)
(* quick_sort : ('a -> 'a -> bool) -> 'a list -> 'a list *)
let rec quicksort aux leb = function
| [] -> aux
| x :: xs ->
let (lge, llt) = List.partition (leb x) xs in
quicksort (x :: quicksort aux leb lge) leb llt
let quicksort leb l = quicksort [] leb l
(* 3つの引数を取るquicksortと2つの引数を取るquicksortとがあってよいのか??? *)
(* テスト *)
let test1 = quicksort (<) [] = []
let test2 = quicksort (<) [4; 2; 3] = [2; 3; 4]
let test3 = quicksort (<) [5; 5; 4; 9; 8; 2; 3] = [2; 3; 4; 5; 5; 8; 9]
let test4 = quicksort (>) [5; 5; 4; 9; 8; 2; 3] = [9; 8; 5; 5; 4; 3; 2]
(* 目的:リストをleb順に並べる *)
(* 参考:ちょっとだけクイックソート - チラシの裏 http://fetburner.hatenablog.com/entry/2014/09/21/172925 *)
(* quick_sort : ('a -> 'a -> bool) -> 'a list -> 'a list *)
let rec quick_sort leb = function
| [] -> []
| first :: rest ->
let (lge, llt) = List.partition (leb first) rest in
quick_sort leb llt @ first :: quick_sort leb lge (* :: has a higher priority than @ *)
(* テスト *)
let test1 = quick_sort (<) [] = []
let test2 = quick_sort (<) [4; 2; 3] = [2; 3; 4]
let test3 = quick_sort (<) [5; 5; 4; 9; 8; 2; 3] = [2; 3; 4; 5; 5; 8; 9]
let test4 = quick_sort (>) [5; 5; 4; 9; 8; 2; 3] = [9; 8; 5; 5; 4; 3; 2]
(* 2分木を表す型 *)
type tree_t =
| Empty
| Node of tree_t * int * tree_t
(* 2分探索木の例 *)
let tree0 = Empty
let tree1 = Node (Empty, 7, Empty)
let tree2 = Node (Empty, 3, tree1)
let tree3 = Node (Empty, 24, Empty)
let tree4 = Node (tree2, 17, tree3)
(* 目的:木 tree の中に整数 m があるか判定する *)
(* search : tree_t -> int -> bool *)
let rec search tree m = match tree with
| Empty -> false
| Node (l, n, r) ->
if m < n then search l m
else if n < m then search r m
else (* m = n *) true
(* テスト *)
let test0 = search tree0 0 = false
let test1 = search tree4 17 = true
let test2 = search tree4 7 = true
let test3 = search tree4 5 = false
let test4 = search tree4 20 = false
let test5 = search tree4 3 = true
let test6 = search tree4 24 = true
(* search tree4 Empty -> error *)
(* seiseki : string * int -> string *)
(* 目的:名前と成績(100点満点)の組を受け取ったら「○○さんの評価は△点です」という文字列を返す関数 *)
let seiseki pair = match pair with
(name, point) -> Printf.sprintf ("%sさんの評価は%3d点です") name point;;
(* tests *)
let test1 = seiseki ("花子", 100) = "花子さんの評価は100点です"
let test2 = seiseki ("太郎", 99) = "太郎さんの評価は 99点です"
/* -*-CSS-*-
* style.css for README.html of feram
* Time-stamp: <2013-11-30 12:19:00 takeshi>
* Author: Takeshi NISHIMATSU
*/
body {
color: black;
font-family: verdana, arial, helvetica, sans-serif;
}
h1, h2, h3, h4, h6 {
font-family: verdana, arial, helvetica, sans-serif;
}
h1 {
color: #dd0000;
background-color: #fff0f0;
font-size: 240%;
}
h2 {
border-top: red 5px solid;
border-bottom: red 1px solid;
padding-left: 8px;
background-color: #fff0f0;
}
h3 {
border-top: red 2px solid;
border-bottom: red 1px solid;
padding-left: 4px;
}
h4 {
border-top: red 1px solid;
padding-left: 4px;
background-color: #fff0f0;
}
h5 {
font-size: larger;
font-family: courier, verdana, arial, helvetica, sans-serif;
padding-top: 10px;
color: darkred;
}
pre {
font-family: monospace, courier, verdana, arial, helvetica, sans-serif;
padding-right: 0.5em;
padding-left: 0.5em;
padding-top: 0.1ex;
padding-bottom: 0.1ex;
margin-left: 0.5em;
margin-right: 1.0em;
white-space: pre;
color: darkred;
background-color: #f3f3f3;
}
div.figure img {
width:50%;
margin: auto;
display: block;
}
div.figure div.figcaption {
width: 60%;
margin: auto;
display: block;
}
div.navi {
text-align: right;
margin-right: 1.0em;
}
div.contents {
margin-left: 10%;
}
figure img{
width: 50%;
margin: auto;
margin-top: 3.0em;
display: block;
}
figure figcaption{
width: 60%;
margin: auto;
margin-bottom: 3.0em;
display: block;
}
table {
border: blue 2px solid;
text-align: center;
margin: auto;
}
(* 目的:受け取った整数のリストのそこまでの和のリストを返す *)
(* sum_list : int list -> int list *)
let sum_list lst =
let rec sum_list_helper a = function
| [] -> []
| head :: tail -> (head+a) :: sum_list_helper (head+a) tail
in
sum_list_helper 0 lst
(* test *)
let test4 = sum_list [0; 1; 2; 3] = [0; 1; 3; 6]
(* 別解。末尾再帰になっている *)
let sum_list_rec lst =
let rec sum_list_rec_helper a alist = function
| [] -> List.rev alist
| head :: tail -> sum_list_rec_helper (head+a) ((head+a)::alist) tail
in
sum_list_rec_helper 0 [] lst
(* test *)
let rec4 = sum_list_rec [0; 1; 2; 3] = [0; 1; 3; 6]
(* sum_list_recではaとa_listの先頭とが同じ内容で冗長だが、次のように書くと複雑 *)
let sum_list_complicated lst =
let rec sum_list_complicated_helper alist list = match alist, list with
| _ ,[] -> List.rev alist
| [] ,head::tail -> sum_list_complicated_helper [head] tail
| a::_,head::tail -> sum_list_complicated_helper ((head+a)::alist) tail
in
sum_list_complicated_helper [] lst
(* test *)
let complicated4 = sum_list_complicated [0; 1; 2; 3] = [0; 1; 3; 6]
(* simplified *)
let sum_list_simple lst =
let rec sum_list_simple_helper alist = function
| [] -> List.tl (List.rev alist)
| head::tail -> sum_list_simple_helper ((head+List.hd alist)::alist) tail
in
sum_list_simple_helper [0] lst
(* test *)
let simple0 = sum_list_simple [] = []
let simple3 = sum_list_simple [1; 2; 3] = [1; 3; 6]
let simple4 = sum_list_simple [0; 1; 2; 3] = [0; 1; 3; 6]
(* 2分木を表す型 *)
type tree_t =
| Empty
| Node of tree_t * int * tree_t
(* 2分木の例 *)
let tree0 = Empty
let tree1 = Node (Empty, 3, Empty)
let tree2 = Node (Empty, 7, tree1)
let tree3 = Node (Empty, 24, Empty)
let tree4 = Node (tree2, 17, tree3)
(* 目的:木の中の整数の合計を返す *)
(* sum_tree : tree_t -> int *)
let rec sum_tree tree = match tree with
| Empty -> 0
| Node (l, n, r) -> sum_tree l + n + sum_tree r
(* テスト *)
let test0 = sum_tree tree0 = 0
let test1 = sum_tree tree1 = 3
let test2 = sum_tree tree2 = 10
let test3 = sum_tree tree3 = 24
let test4 = sum_tree tree4 = 51
(* 2分木を表す型 *)
type tree_t =
| Empty
| Node of tree_t * int * tree_t
(* 2分木の例 *)
let tree0 = Empty
let tree1 = Node (Empty, 3, Empty)
let tree2 = Node (Empty, 7, tree1)
let tree3 = Node (Empty, 24, Empty)
let tree4 = Node (tree2, 17, tree3)
(* 目的:木の深さを返す *)
(* tree_depth : tree_t -> int *)
let rec tree_depth tree = match tree with
| Empty -> 0
| Node (l, n, r) -> 1 + max (tree_depth l) (tree_depth r)
(* テスト *)
let test0 = tree_depth tree0 = 0
let test1 = tree_depth tree1 = 1
let test2 = tree_depth tree2 = 2
let test3 = tree_depth tree3 = 1
let test4 = tree_depth tree4 = 3
(* 2分木を表す型 *)
type tree_t =
| Empty
| Node of tree_t * int * tree_t
(* 2分木の例 *)
let tree0 = Empty
let tree1 = Node (Empty, 3, Empty)
let tree2 = Node (Empty, 7, tree1)
let tree3 = Node (Empty, 24, Empty)
let tree4 = Node (tree2, 17, tree3)
(* 目的:木の中の整数の合計を返す *)
(* sum_tree : tree_t -> int *)
let rec sum_tree tree = match tree with
| Empty -> 0
| Node (l, n, r) -> sum_tree l + n + sum_tree r
(* 目的:値を全て2倍にした木を返す *)
(* tree_double : tree_t -> tree_t *)
let rec tree_double tree = match tree with
| Empty -> Empty
| Node (l, n, r) -> Node (tree_double l, 2*n, tree_double r)
(* テスト *)
let test0 = sum_tree (tree_double tree0) = 0
let test1 = sum_tree (tree_double tree1) = 6
let test2 = sum_tree (tree_double tree2) = 20
let test3 = sum_tree (tree_double tree3) = 48
let test4 = sum_tree (tree_double tree4) = 102
(* 2分木を表す型 *)
type tree_t =
| Empty
| Node of tree_t * int * tree_t
(* 2分木の例 *)
let tree0 = Empty
let tree1 = Node (Empty, 3, Empty)
let tree2 = Node (Empty, 7, tree1)
let tree3 = Node (Empty, 24, Empty)
let tree4 = Node (tree2, 17, tree3)
(* 目的:木の中の整数の合計を返す *)
(* tree_length : tree_t -> int *)
let rec tree_length tree = match tree with
| Empty -> 0
| Node (l, n, r) -> tree_length l + 1 + tree_length r
(* テスト *)
let test0 = tree_length tree0 = 0
let test1 = tree_length tree1 = 1
let test2 = tree_length tree2 = 2
let test3 = tree_length tree3 = 1
let test4 = tree_length tree4 = 4
(* 2分木を表す型 *)
type tree_t =
| Empty
| Node of tree_t * int * tree_t
(* 2分木の例 *)
let tree0 = Empty
let tree1 = Node (Empty, 3, Empty)
let tree2 = Node (Empty, 7, tree1)
let tree3 = Node (Empty, 24, Empty)
let tree4 = Node (tree2, 17, tree3)
let tttt1 = Node (Empty, 9, Empty)
let tttt2 = Node (Empty, 49, tttt1)
let tttt3 = Node (Empty, 576, Empty)
let tttt4 = Node (tttt2, 289, tttt3)
(* 目的:木構造の全てのエレメントに関数fを施す *)
(* tree_map : tree_t (int -> int) -> tree_t *)
let rec tree_map tree f = match tree with
| Empty -> Empty
| Node (l, n, r) -> Node (tree_map l f, (f n), tree_map r f)
(* テスト *)
let test0 = tree_map tree0 (fun x -> x*x) = tree0
let test1 = tree_map tree1 (fun x -> x*x) = tttt1
let test2 = tree_map tree2 (fun x -> x*x) = tttt2
let test3 = tree_map tree3 (fun x -> x*x) = tttt3
let test4 = tree_map tree4 (fun x -> x*x) = tttt4
(* tsurukame : int -> int -> int *)
(* 目的:鶴亀算を行う *)
let tsurukame animals legs = (4 * animals - legs) / 2
(* tests *)
let test1 = tsurukame 5 16 = 2
let test2 = tsurukame 5 14 = 3
let test3 = tsurukame 4 16 = 0
(* tsuuchi : gakusei_t -> gakusei_t *)
(* 目的:tensuu(100点満点)から評価を決める *)
type gakusei_t = {
name : string;
tensuu : int;
seiseki : string;
}
let tsuuchi gakusei = match gakusei with
{name=n; tensuu=t; seiseki=s} ->
{name=n; tensuu=t;
seiseki= if t>=80 then "A"
else if t>=70 then "B"
else if t>=60 then "C" else "D"}
(* tests *)
let test1 = tsuuchi {name="花子"; tensuu=100; seiseki=""} = {name="花子"; tensuu=100; seiseki="A"}
let test2 = tsuuchi {name="太郎"; tensuu= 77; seiseki=""} = {name="太郎"; tensuu= 77; seiseki="B"}
(* zundoko.ml
Ref1: http://qiita.com/shunsugai@github/items/971a15461de29563bf90
Ref2: http://nnwww.hatenablog.com/entry/2016/03/15/051702
*)
let rec sing cnt gen =
if gen () then
(print_endline "ドコ";
if cnt >= 4 then
print_endline "キ・ヨ・シ!"
else
sing 0 gen)
else
(print_endline "ズン";
sing (cnt + 1) gen)
let () = Random.init (int_of_float (10000.0 *. (Unix.gettimeofday())))
let () = sing 0 Random.bool
(*
Local variables:
compile-command: "ocamlc unix.cma zundoko.ml -o zundoko && ./zundoko"
End:
*)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment