1. relsa
  2. le4-ml

Commits

relsa  committed 98b357a

First commit.

  • Participants
  • Branches master

Comments (0)

Files changed (39)

File .gitignore

View file
  • Ignore whitespace
+*~
+*.swp
+

File ExOcaml/Ex2_1.ml

View file
  • Ignore whitespace
+float_of_int 3 +. 2.5;;
+(*
+  評価結果 5.5
+  float_of_int 3 でint型の3がfloat型3.0にキャストされ,加算される.
+*)
+
+int_of_float 0.7;;
+(*
+  評価結果 0
+  int_of_floatは小数点以下を切り捨ててfloat->intのキャストを行う.
+*)
+
+
+if "11" > "100" then "foo" else "bar";;
+(*
+  評価結果 "foo"
+  文字列の先頭から1文字ずつを比較していく.
+  今回1文字目は'1'で一致しているので,2文字目を参照する.
+  2文字目は'1'と'0'だが,'1'の方がchar型として値が大きいので,
+  条件式はtrueとなり,if文は"foo"を返す.
+*)
+
+char_of_int ((int_of_char 'A') + 20);;
+(*
+  評価結果 'U'
+  int_of_char 'A' はint型の数値65を返す.
+  これはASCII文字コードに依る.
+  それに20を足した値85をchar_of_intでchar型にキャストすると
+  対応する'U'が返される.
+*)
+
+int_of_string "0xff";;
+(*
+  評価結果 255
+  文字列"0xff"をint型にキャストしている.
+  16進数0xffが10進数に直され表示される.
+*)
+
+5.0 ** 2.0;;
+(*
+  評価結果 25.
+  5^2 = 25
+  float型同士の演算なので結果はfloat型の25.0になる.
+*)

File ExOcaml/Ex2_2.ml

View file
  • Ignore whitespace
+(*
+  if true && false then 2;;
+
+  else節が省略されているため,
+  else節の返す型はunit型とみなされる.
+  また,then節の返り値2はint型である.
+  返り値の型が一致していないので型エラーを返す.
+*)
+
+(*
+  8*-2;;
+
+  文法エラー.
+  演算子*-は存在しない.
+*)
+
+(*
+  int_of_string "0xfg";;
+
+  gが16進数の範囲に入っていないため,
+  例外を発生させる.
+*)
+
+(*
+  int_of_float -0.7;;
+
+  関数適用は単行演算子よりも優先度が高いので,
+  型エラーが発生する.
+*)
+  

File ExOcaml/Ex2_3.ml

View file
  • Ignore whitespace
+(* 1
+   not true && false -> true *)
+not (true && false);;
+(* 単項演算子は二項演算子より優先度が高い. *)
+
+(* 2
+   float_of_int int_of_float 5.0 -> 5.0 *)
+float_of_int (int_of_float 5.0);;
+(* float_of_intが先に適用されて,文法エラーとなる.*)
+
+(* 3
+   sin 3.14 /. 2.0 ** 2.0 +. cos 3.14 /. 2.0 ** 2.0 -> 1.0 *)
+sin (3.14 /. 2.0) ** 2.0 +. cos (3.14 /. 2.0) ** 2.0;;
+(* べき乗演算子の方が,
+   除算演算子より優先順位が高い.*)
+
+(* 4
+   sqrt 3 * 3 + 4 * 4 -> 5*)
+int_of_float (sqrt (float_of_int (3 * 3 + 4 * 4)));;
+(* sqrtはfloat->floatの関数であるので,型変換が必要である.
+   また,関数適用は中置演算子より優先度が高いため,
+   float_of_intの引数にも括弧をつける必要がある.*)

File ExOcaml/Ex2_4.ml

View file
  • Ignore whitespace
+(* for run this program *)
+let b1 = true
+and b2 = true;;
+
+(* b1 && b2 *)
+if b1 then
+  b2
+else
+  false
+;;
+
+(* b1 || b2 *)
+if b1 then
+  true
+else
+  b2
+;;

File ExOcaml/Ex2_5.ml

View file
  • Ignore whitespace
+(* a_2', ____, _'_'_
+   が変数として有効である.*)
+let a_2' = 0 and
+    ____ = 0 and
+    _'_'_ = 0
+;;
+
+(* 以下は変数として無効.*)
+
+(*
+  let Cat = 0 (* 最初が大文字 *) and
+  7eleven = 711 (* 最初が数字 *) and
+  'ab2_ = 0 (* 最初が' *) and
+  _ = 0 (* 特別な意味を持つ,代入はできるが参照できない *)
+  ;;
+*)

File ExOcaml/Ex2_6.ml

View file
  • Ignore whitespace
+let round_off (x : float) (dplace : int) = 
+  let exp = float (dplace - 1) in
+  let tmp = floor (x *. 10. ** exp +. 0.5) in
+  tmp *. 0.1 ** exp
+;;
+(*
+  小数第n位で四捨五入する関数.
+  x: 対象となる数,dplace: 小数第何位で四捨五入するかを示す整数
+
+  以下に定義する関数で用いる.
+  [実行例]
+  正しく四捨五入できていることを確かめる.
+  # round_off 1.25 1;;
+  - : float = 1.
+  # round_off 1.25 2;;
+  - : float = 1.3
+*)
+
+
+(* 1 *)
+let exchange_USD_to_JPY (usd : float) = 
+  let rate = 111.12 in
+  let jpy = usd *. rate in
+  int_of_float (round_off jpy 1)
+;;
+(*
+  USDからJPYへの両替をする関数
+  [実行例]
+  # exchange_USD_to_JPY 1.;;
+  - : int = 111
+  # exchange_USD_to_JPY 5.;;
+  - : int = 556 (555.6の四捨五入)
+*)
+
+
+(* 2 *)
+let exchange_JPY_to_USD (jpy : int) =
+  let rate = 111.12 in
+  let usd = float jpy /. rate in
+  round_off usd 2
+;;
+(*
+  JPYからUSDへの両替をする関数
+  [実行例]
+  # exchange_JPY_to_USD 112;;
+  - : float = 1.
+  # exchange_JPY_to_USD 600;;
+  - : float = 5.4
+ *)
+
+
+(* 3 *)
+let announce_ex_USD_to_JPY (usd : float) =
+  
+  let jpy = exchange_USD_to_JPY usd in
+  string_of_float usd ^ " dollars are " ^ string_of_int jpy ^ " yen."
+;;
+(*
+  USDを受け取ってJPYに両替し,文字列を返す関数
+  [実行例]
+  # announce_ex_USD_to_JPY 1.;;
+  - : string = "1. dollars are 111 yen."
+# 
+*)
+
+
+(* 4 *)
+let capitalize (c : char) =
+  let code = int_of_char c in
+
+  (* 'a'は97,'z'は122に相当.
+     32を引けば大文字になる. *)
+  if 97 <= code && code <= 122 then
+    char_of_int (code - 32)
+  else
+    c
+;;
+(*
+  アルファベットの小文字を大文字にする関数
+  [実行例]
+  # capitalize 'a';;
+  - : char = 'A'
+  # capitalize 'z';;
+  - : char = 'Z'
+  # capitalize '1';;
+  - : char = '1'
+*)

File ExOcaml/Ex3_1.ml

View file
  • Ignore whitespace
+(* 1 *)
+let x = 1 in     (* x:1 *)
+let x = 3 in     (* x:3 *)
+let x = x + 2 in (* x:5 *)
+x * x
+;;
+(* 5 * 5 = 25 *)
+
+
+(* 2 *)
+let x = 2 
+and y = 3 in      (* x:2, y:3 *)
+(let y = x and
+     x = y + 2 in (* x:5, y:2 *)
+ x * y)           (* x:2, y:3 *)
++ y
+;;
+(* (5 * 2) + 3 = 13 *)
+
+
+(* 3 *)
+let x = 2 in     (* x:2 *)
+let y = 3 in     (* x:2, y:3 *)
+let y = x in     (* x:2, y:2 *)
+let z = y + 2 in (* x:2, y:2, z:4 *)
+x * y * z
+;;
+(* 2 * 2 * 4 *)

File ExOcaml/Ex3_11.ml

View file
  • Ignore whitespace
+(* 1 *)
+let rec gcd (n, m) =
+  let rest = n mod m in
+  if rest = 0 then
+    m
+  else
+    gcd (m, rest)
+;;
+(*
+  ユークリッド互除法により再帰的に実装した.
+  m <= n を仮定している.
+  [実行例]
+  # gcd (555, 333);;
+  - : int = 111
+*)
+
+
+(* 2 *)
+let rec comb (n, m) =
+  if m = 0 || n = m then
+    1
+  else
+    comb (n - 1, m) + comb (n - 1, m - 1)
+;;
+(*
+  再帰関数である.
+  0 <= m <= n を仮定している
+  [実行例]
+  # comb (10, 3);;
+  - : int = 120
+*)  
+
+
+(* 3 *)
+let fib_iter n =
+  let rec iter (next, curr, cnt) =
+    if cnt = 0 then
+      curr
+    else
+      iter (next + curr, next, cnt - 1) in
+  iter (1, 0, n)
+;;
+(* 
+   末尾再帰関数である.
+   局所関数iterは,フィボナッチ数next, currと
+   残りの反復回数cntを保持し,更新する.
+   [実行例]
+   # fib_iter 10;;
+   - : int = 55
+*)   
+
+
+(* 4 *)
+let max_ascii (s : string) =
+  let len = String.length s in
+  let rec iter (ret, i) =
+    if i = len then
+      ret
+    else
+      let c = s.[i] in
+      if c > ret then
+	iter (c, i + 1)
+      else
+	iter (ret, i + 1) in
+  iter (s.[0], 0)
+;;
+(*
+  末尾再帰で実装した.
+  局所関数iterはその時点での暫定返り値retと
+  注目文字のインデックスiを保持,更新する.
+  iterにs.[0], 0を与えてやると,max_asciiは動作する.
+
+  [実行例]
+  # max_ascii "objectivecaml";;
+  - : char = 'v'  
+  # max_ascii "anz";;
+  - : char = 'z'
+*)
+

File ExOcaml/Ex3_2.ml

View file
  • Ignore whitespace
+(* 1
+   let x = e1 and y = e2
+   2つの代入式は並列的な関係にある.
+   ゆえに,e2の中にxが含まれていたとしても,
+   それはe1ではなく,1つ外のスコープのxを指す.
+*)
+let x = 1;;
+let x = 3 and
+    y = x;;
+y;; (* -> 1 *)
+
+
+
+(* 2
+   let x = e1 let y = e2
+   2つの代入式は直列的な関係にある.
+   e2の中にxが含まれていたら,
+   それはe1を指す.
+*)
+
+let x = 1;;
+let x = 3;;
+let y = x;;
+y;; (* -> 3 *)

File ExOcaml/Ex3_3.ml

View file
  • Ignore whitespace
+let geo_mean (x, y) = sqrt(x *. y);;
+(* 実数値のペア(x, y)を受け取り,
+   xとyの相乗平均を返す. 
+
+   [実行例]
+   # geo_mean (5., 3.);;
+   - : float = 3.87298334620741702
+*)

File ExOcaml/Ex3_4.ml

View file
  • Ignore whitespace
+let prodMatVec (mat, vec) =
+  let ((a, b), (c, d)) = mat and
+      (v1, v2) = vec in
+  (a *. v1 +. b *. v2, c *. v1 +. d *. v2)
+;;
+
+(*
+  2*2実数行列 mat = a b
+                    c d と
+  縦ベクトル = v1
+               v2 をそれぞれ
+  ((a, b), (c, d)), (v1, v2)の形で受け取り,積を計算する.
+
+  [実行例]
+  # prodMatVec(((1., 0.), (0., 1.)), (3., 4.));;
+  - : float * float = (3., 4.)
+  # prodMatVec(((3., 2.), (1., 5.)), (3., 4.));;
+  - : float * float = (17., 23.)
+*)  

File ExOcaml/Ex3_5.ml

View file
  • Ignore whitespace
+(* 型float * float * float * floatは,
+   float型の要素を4つ持った組である.
+   例えば,以下のvはこの型を持つ. *)
+let v = (1., 2., 3., 4.);;
+(* また,以下のように要素を取り出せる.*)
+let (v1, v2, v3, v4) = v;;
+
+
+(* 型(float * float) * (float * float)は
+   float型のペアを要素に持つペアである.
+   例えば,以下のwはこの型を持つ.*)
+let w = ((5., 6.), (7., 8.));;
+(* また,以下のように要素を取り出せる.*)
+let ((w1, w2), (w3, w4)) = w;;
+
+(*
+  [実行結果]
+  # #use "Ex3_5.ml";;
+  val v : float * float * float * float = (1., 2., 3., 4.)
+  val v1 : float = 1.
+  val v2 : float = 2.
+  val v3 : float = 3.
+  val v4 : float = 4.
+  val w : (float * float) * (float * float) = ((5., 6.), (7., 8.))
+  val w1 : float = 5.
+  val w2 : float = 6.
+  val w3 : float = 7.
+  val w4 : float = 8.
+*)

File ExOcaml/Ex3_7.ml

View file
  • Ignore whitespace
+(* 1 *)
+let rec pow (x, n) =
+  if n = 0 then
+    1.
+  else
+    x *. pow (x, n - 1)
+;;
+(* x**n = x * x**(n-1)として
+   再帰的にべき乗計算を行っている.
+   n = 0のとき1.を返す.*)
+
+(* 2 *)
+let rec better_pow (x, n) =
+  if n = 0 then
+    1.
+  else if n mod 2 = 1 then
+    x *. better_pow (x, n - 1)
+  else
+    better_pow (x *. x, n / 2)
+;;
+(* n = 0ならば1.を返し,
+   nが奇数ならばx**n = x * x**(n-1)として計算する.
+   nが偶数の時,x**n = (x**2)**(n/2)として計算を行なっている.
+   この処理により,再帰呼び出しの数は従来より減少し,
+   O(logn)の計算量で済む. *)

File ExOcaml/Ex3_8.ml

View file
  • Ignore whitespace
+let powi (b, e) =
+  let rec iter (prod, times) =
+    if times = 0 then
+      prod
+    else
+      iter (b *. prod, times - 1) in
+  iter(1., e)
+;;
+
+(* 
+   局所関数iterが反復的に動作する.
+   引数prodは積を,timesは残りの反復数を示している.
+   そのため,prod, timesの初期値はそれぞれ1., 指数eとなる.
+   反復の度にtimesを1減少させ,prodに基数bを掛け,
+   timesが0となったとき,iterはこれまでの積prodを返す.
+   
+   [実行例]
+   # powi (2., 10);;
+   powi <-- (2., 10)
+   powi --> 1024.
+   - : float = 1024.
+*)
+
+(* 変数3つ版 powi(x, 1, e)で呼び出し    *)
+(* ------------------------------------ *)
+(* let rec powi (x, prod, times) =      *)
+(*   if times = 0 then                  *)
+(*     prod                             *)
+(*   else                               *)
+(*     powi (x, x *. prod, times - 1);; *)

File ExOcaml/Ex3_9.ml

View file
  • Ignore whitespace
+(* OCamlは評価戦略として値呼び出しを採用している.
+   そのため,関数そのものが展開される前に,
+   まず引数が計算される.
+   今回の場合,関数condが展開される前に,
+   その引数であるfact (n-1)が計算されることになる.
+   cond中のif文による終了判定が行われないので,
+   factが無限に呼び出され,スタックオーバフローを起こす.*)
+
+(* 動かない *)
+let cond (b, e1, e2) : int = if b then e1 else e2;;
+let rec fact n = cond ((n = 1), 1, n * fact (n-1));;

File ExOcaml/Ex4_1.ml

View file
  • Ignore whitespace
+let integral f a b =
+  let n = 100000 in
+  let sigma = (b -. a) /. float n in
+  let rec iter sum i =
+    let f_i = float i in
+    let trapezoid =
+      (f (a +. (f_i -. 1.) *. sigma) +. f (a +. f_i *. sigma)) *. sigma /. 2. in
+    if i = n + 1 then
+      sum
+    else
+      iter (sum +. trapezoid) (i+1) in
+  iter 0. 1
+;;
+
+(* 積分を計算する関数 *)
+(* f: 適用する関数  *)
+(* a, b: 積分範囲(a < b) *)
+(* -------------------------------- *)
+(* 今回は領域を100000分割し、台形近似を行った。 *)
+(* 局所関数iterで台形の加算を行っている。 *)
+(* 台形の和はsumに、繰り返し回数はiに保たれる。 *)
+(* integralはiterに初期値sum = 0., i = 1を与えて呼び出している。 *)
+
+(* -------------------------------- *)
+(* [実行例] *)
+
+(* # integral sin 0. 3.141592;; *)
+(* - : float = 1.99999999983527399 *)
+(* 実際に計算すると答えは2.0になる。 *)
+(* この関数は十分な精度で積分近似できている。 *)
+
+(* # integral (fun x -> x *. x) 0. 1.;; *)
+(* - : float = 0.333333333350000149 *)
+(* 実際に計算すると答えは0.33333..になる。 *)
+(* この関数は十分な精度で積分近似できている。 *)

File ExOcaml/Ex4_4.ml

View file
  • Ignore whitespace
+let uncurry f (x, y) = f x y;;
+
+(* [説明] *)
+
+(* カリー化された2変数関数の型は *)
+(* 'a -> 'b -> 'c *)
+(* である。 *)
+(* よって、uncurry関数の型は *)
+(* ('a -> 'b -> 'c) -> 'b * 'c -> c *)
+(* と考えられる。 *)
+(* 上のような定義にすると、 *)
+(* カリー化された関数と引数のペアを受取り、 *)
+(* 受け取った引数に、受け取った関数を適用する関数となる。 *)
+(* これを部分適用させると受け取った関数を *)
+(* uncurry化することができる。 *)
+
+
+(* [実行例] *)
+
+(* # curried_avg;;                                         *)
+(* - : float -> float -> float = <fun>                     *)
+(* # let uncurry f (x, y) = f x y;;                        *)
+(* val uncurry : ('a -> 'b -> 'c) -> 'a * 'b -> 'c = <fun> *)
+(* # let avg = uncurry curried_avg in avg (4., 5.3);;      *)
+(* - : float = 4.65                                        *)
+(* # uncurry curried_avg;;                                 *)
+(* - : float * float -> float = <fun>                      *)

File ExOcaml/Ex4_5.ml

View file
  • Ignore whitespace
+let rec repeat f n x =
+  if n > 0 then
+    repeat f (n - 1) (f x)
+  else
+    x
+;;
+
+let fib n =
+  let (fibn, _) = 
+    repeat (fun (x, y) -> (y, x + y)) n (0, 1) in
+  fibn
+;;
+
+(* [説明] *)
+
+(* fib 0の値は0とする。 *)
+(* ペア(0, 1)に、 *)
+(* 関数fun (x, y) -> (y, x + y)を繰り返し適用することで、 *)
+(* ペアの頭にはその時点でのフィボナッチ数が格納される。 *)
+(* それをマッチングし、取り出すことでフィボナッチ数を求める関数を実装できる。 *)
+
+(* --------------- *)
+
+(* [実行例]     *)
+
+(* # fib 0;;    *)
+(* - : int = 0  *)
+(* # fib 5;;    *)
+(* - : int = 5  *)
+(* # fib 10;;   *)
+(* - : int = 55 *)

File ExOcaml/Ex4_7.ml

View file
  • Ignore whitespace
+let s x y z = x z (y z);;
+let k x y = x;;
+
+(* s k k 1;;                  *)
+(* は以下のように展開される。 *)
+(* s k k 1                    *)
+(* k 1 (k 1)                  *)
+(* k 1 <fun>                  *)
+(* 1                          *)
+
+(* 型に注目すると以下のとおり。                                      *)
+(* s k k 1                                                           *)
+(* (('a -> 'b -> 'c) -> ('a -> 'b) -> 'a -> 'c) k k 1                *)
+(* (('a -> 'b -> 'c) -> ('a -> 'b) -> 'a -> 'c) ('u -> 'v -> 'w) k 1 *)
+(* (('u -> 'v) -> 'u -> 'u) k 1                                      *)
+(* (('u -> 'v) -> 'u -> 'u) ('x -> 'y -> 'x) 1                       *)
+(* ('x -> 'x) 1                                                      *)
+(* ('x -> 'x) int                                                    *)
+(* int                                                               *)
+
+
+(* また、fun x y -> y と同様に働く関数は以下。 *)
+
+k (s k k);;
+
+(* この関数の型は'a -> 'b -> 'bになると考えられる。  *)
+(* 上より、s k k の型は'a -> 'aである。              *)
+(* k (s k k)は型に注目すると以下のように展開される。 *)
+(* --------------------------- *)
+(* k (s k k)                   *)
+(* ('a -> 'b -> 'a) (s k k)    *)
+(* ('a -> 'b -> 'a) ('x -> 'x) *)
+(* 'b -> ('x -> 'x)            *)
+(* 'b -> 'x -> 'x              *)
+
+
+
+
+
+
+

File ExOcaml/Ex5_3.ml

View file
  • Ignore whitespace
+(* 1 *)
+let rec downto0 n =
+  if n = 0 then
+    [0]
+  else
+    n :: downto0 (n - 1)
+;;
+
+(* [説明] *)
+(* 再帰的にnから0までconsしていくだけである。 *)
+
+(* [実行例] *)
+(* # downto0 10;;                                    *)
+(* - : int list = [10; 9; 8; 7; 6; 5; 4; 3; 2; 1; 0] *)
+
+
+let patterns = [
+  (1000, "M");
+  (900, "CM");
+  (500, "D");
+  (400, "CD");
+  (100, "C");
+  (90, "XC");
+  (50, "L");
+  (40, "XL");
+  (10, "X");
+  (9, "IX");
+  (5, "V");
+  (4, "IV");
+  (1, "I")
+] (* 実行用 *)
+
+(* 2 *)
+let roman pat n =
+  let rec iter p n s =
+    if n > 0 then
+      let (num, r_num) = List.hd p in
+      let q = n / num in
+      if q = 0 then
+	iter (List.tl p) n s
+      else
+	iter p (n - num) (s ^ r_num)
+    else
+      s
+  in
+  iter pat n ""
+;;
+
+(* [説明] *)
+(* 局所関数iterを実装することでromanを反復的に実装した。                *)
+(* iterはローマ数字表現パターンが格納されたリストp,                     *)
+(* 整数値n, 返り値となる文字列sを保持する。                             *)
+(* n = 0ならばsを返す。                                                 *)
+(* n > 0ならば、pの先頭のパターンとマッチングを行う。                   *)
+(* 該当する場合、sにローマ数字を結合し、nから該当した数を引き反復する。 *)
+(* 該当しない場合、リストからそのパターンを削除し、反復する。           *)
+(* パターンは数の大きい順に並んでいるため、整合性は保たれる。           *)
+
+(* [実行例] *)
+(* # roman patterns 2013;; *)
+(* - : string = "MMXIII"   *)
+(* # roman patterns 1192;; *)
+(* - : string = "MCXCII"   *)
+
+
+(* 3 *)
+let concat list = List.fold_right List.append list [];;
+
+(* [説明] *)
+(* fold_rightを用いた。                           *)
+(* 末尾の要素からappendが実行され、畳み込まれる。 *)
+
+(* [実行例] *)
+(* # concat [[0; 1; 2]; [3; 4]; [5]];;      *)
+(* - : int list = [0; 1; 2; 3; 4; 5]        *)
+(* # concat [[[0]; [1; 2]]; [[3]]];;        *)
+(* - : int list list = [[0]; [1; 2]; [3]]   *)
+
+
+(* 4 *)
+let zip l1 l2 =
+  let rec iter l1 l2 ret = 
+    match (l1, l2) with
+      ([], _) -> ret
+    | (_, []) -> ret
+    | (h1 :: r1, h2 :: r2) -> iter r1 r2 ((h1, h2) :: ret) in
+  List.rev (iter l1 l2 [])
+;;
+
+(* [説明] *)
+(* 局所関数iterを実装することで反復的に実装した。                   *)
+(* iterはパターンマッチを行う。                                     *)
+(* 引数のリストのうち、いずれかが空になったら結果を返す。           *)
+(* いずれも空でなかったら、それぞれの先頭要素のペアを結果に結合し、 *)
+(* 残りのリストについて反復を行う。                                 *)
+(* iterが結果として返すリストは逆順になっているので、               *)
+(* 最後にrevをかけて反転させる。                                    *)
+
+(* [実行例] *)
+(* #  zip ["yaruki"; "sonoki"; "daisuki"] [1; 2; 3; 4; 5];;                 *)
+(* - : (string * int) list = [("yaruki", 1); ("sonoki", 2); ("daisuki", 3)] *)
+
+(* 5 *)
+let filter prod list =
+  let rec iter l ret =
+    if l = [] then
+      ret
+    else
+      if prod (List.hd l) then
+	iter (List.tl l)  ((List.hd l) :: ret)
+      else
+	iter (List.tl l) ret
+  in
+  List.rev (iter list [])
+;;
+
+(* [説明] *)
+(* 局所関数iterを実装することで反復的に実装した。 *)
+(* リストの先頭から順に見ていき、                 *)
+(* 条件を満たしていれば、結果にconsし、           *)
+(* 満たしていなければ、読み飛ばしている。         *)
+
+(* [実行例] *)
+(* # filter (fun x -> x > 0) [-5; -3; 0; 3; 5];; *)
+(* - : int list = [3; 5]                         *)

File ExOcaml/Ex5_6.ml

View file
  • Ignore whitespace
+let rec quicker l sorted = 
+  match l with
+    [] -> sorted
+  | x :: xs -> 
+    let rec partition left right =
+      function
+        [] -> quicker left (x :: (quicker right sorted))
+      | y :: ys ->
+	if x < y then
+	  partition left (y :: right) ys
+	else
+	  partition (y :: left) right ys
+    in
+    partition [] [] xs
+;;
+
+
+(* [説明] *)
+(* 関数quickerは、未ソートリストlが空になったら、     *)
+(* ソート済リストsortedを返す。                       *)
+(* 局所関数partitionは、lの先頭要素をpivotとし、      *)
+(* pivotより値の小さい要素のリストleftと              *)
+(* 値の大きい要素のリストrightに分ける。              *)
+(* 未ソートリストrightを先にquickerでソートしてやり、 *)
+(* ソートされたrightの先頭にpivotを追加する。         *)
+(* rightはpivotよりも大きい要素のリストだったので、   *)
+(* これもまたソート済みリストとなる。                 *)
+(* ソートされたpivot :: rightをsortedとみなし、       *)
+(* leftに対しquickerを走らせるとソートが完了する。    *)
+
+(* [実行例] *)
+(* # quicker [] [];;           *)
+(* - : 'a list = []            *)
+(* # quicker [1] [];;          *)
+(* - : int list = [1]          *)
+(* # quicker [1; 2; 3; 4] [];; *)
+(* - : int list = [1; 2; 3; 4] *)
+(* # quicker [2; 4; 3; 1] [];; *)
+(* - : int list = [1; 2; 3; 4] *)
+(* # quicker [4; 3; 2; 1] [];; *)
+(* - : int list = [1; 2; 3; 4] *)

File ExOcaml/Ex6_10.ml

View file
  • Ignore whitespace
+type ('a, 'b) sum = Left of 'a | Right of 'b;;
+
+(* 1 *)
+let fun1 (x, y) (* 引数は'a * 'y型 *) =
+  match y with
+  | Left i -> Left (x, i)
+  | Right i -> Right (x, i)
+;;
+
+
+(* 2 *)
+let fun2 (x, y) =
+  match (x, y) with
+  | (Left x', Left y') -> Left (Left (x', y'))
+  | (Left x', Right y') -> Right (Left (x', y'))
+  | (Right x', Left y') -> Right (Right (x', y'))
+  | (Right x', Right y') -> Left (Right (x', y'))
+;;
+
+(* 3 *)
+let fun3 (f, g) h  =
+  match h with
+  | Left h' -> f (h')
+  | Right h' -> g (h')
+;;

File ExOcaml/Ex6_2.ml

View file
  • Ignore whitespace
+(* natの定義 *)
+type nat = Zero | OneMoreThan of nat;;
+
+(* 準備 *)
+let rec add m n =
+  match m with
+  | Zero -> n
+  | OneMoreThan m' -> OneMoreThan (add m' n)
+;;
+
+
+
+let int_of_nat n =
+  let rec count n i =
+    match n with
+    | Zero -> i
+    | OneMoreThan n' -> count n' (i + 1)
+  in
+  count n 0
+;;
+(* [説明] *)
+(* nat型をint型に変換する関数。                                     *)
+(* 局所関数countが、nat型引数nに含まれるOneMoreThanの回数を数える。 *)
+
+(* [実行例] *)
+(* # int_of_nat Zero;;                             *)
+(* - : int = 0                                     *)
+(* # int_of_nat (OneMoreThan (OneMoreThan Zero));; *)
+(* - : int = 2                                     *)
+
+
+let rec mul m n =
+  match (m, n) with
+  | (Zero, _) -> Zero
+  | (_, Zero) -> Zero
+  | (OneMoreThan m', n') -> add n' (mul m' n')
+;;
+(* [説明] *)
+(* nat型の掛け算をする関数。                     *)
+(* 0 * n = 0                                     *)
+(* m * 0 = 0とし、                               *)
+(* それ以外の場合、n + (m - 1) * nを計算する。 *)
+
+(* [実行例] *)
+(* # let three = (OneMoreThan (OneMoreThan (OneMoreThan Zero))) and *)
+(*       two = (OneMoreThan (OneMoreThan Zero)) in                  *)
+(*   mul three two;;                                                *)
+(* - : nat =                                                        *)
+(*       OneMoreThan                                                *)
+(*        (OneMoreThan                                              *)
+(* 	   (OneMoreThan                                             *)
+(* 	    (OneMoreThan                                            *)
+(* 	     (OneMoreThan                                           *)
+(*            (OneMoreThan Zero)))))                                *)
+(* 3 * 2 = 6が正しく計算されている。                                *)
+
+
+let rec monus m n =
+  match (m, n) with
+  | (Zero, _) -> Zero
+  | (m', Zero) -> m'
+  | (OneMoreThan m', OneMoreThan n') -> monus m' n'
+;;
+
+(* [説明] *)
+(* nat型の引き算をする関数。                     *)
+(* 0 - n = 0                                     *)
+(* n - 0 = 0とし、                               *)
+(* それ以外の場合、(m - 1) - (n - 1)を計算する。 *)
+
+(* [実行例] *)
+(* # let three = (OneMoreThan (OneMoreThan (OneMoreThan Zero))) and *)
+(*       two = (OneMoreThan (OneMoreThan Zero)) in                  *)
+(*   monus three two;;                                              *)
+(* - : nat = OneMoreThan Zero                                       *)
+(* 3 - 2 = 1が正しく計算されている。                                *)

File ExOcaml/Ex6_6.ml

View file
  • Ignore whitespace
+type 'a tree = Lf | Br of 'a * 'a tree * 'a tree;;
+
+let inttree = Br (0,
+		  Br (1, Br (2, Lf, Lf), Br (3, Lf, Lf)),
+		  Br (4, Br (5, Lf, Lf), Br (6, Lf, Lf)));;
+let rec reflect comptree =
+  match comptree with
+  | Lf -> Lf
+  | Br (n, s1, s2) -> Br (n, reflect s2, reflect s1)
+;;
+(* [説明] *)
+(* 葉ならそのまま葉を返し、                                      *)
+(* 節点なら、枝を入れ替えて各枝に対しreflectを再帰呼び出しする。 *)
+
+(* [実行例] *)
+(* # reflect inttree;;                               *)
+(* - : int tree =                                    *)
+(*       Br (0,                                      *)
+(* 	  Br (4, Br (6, Lf, Lf), Br (5, Lf, Lf)),    *)
+(*           Br (1, Br (3, Lf, Lf), Br (2, Lf, Lf))) *)
+
+(* また、任意の二分木tについて以下の恒等式が成り立つ *)
+(* preorder (reflect t) = reverse (outorder t)       *)
+(* inorder  (reflect t) = reverse (inorder t)        *)
+(* outorder (reflect t) = reverse (preorder t)       *)

File ExOcaml/Ex6_9.ml

View file
  • Ignore whitespace
+(* 'a seq型の定義 *)
+type 'a seq = Cons of 'a * (unit -> 'a seq);;
+
+(* 以下、seq操作関数 *)
+let rec from n = Cons (n, fun () -> from (n + 1));;
+
+let head (Cons (x, _)) = x;;
+let tail (Cons (_, f)) = f ();;
+
+let rec take n s =
+  if n = 0 then
+    []
+  else
+    head s :: take (n - 1) (tail s)
+;;
+
+let rec nthseq n (Cons (x, f)) =
+  if n = 1 then
+    x
+  else
+    nthseq (n - 1) (f ())
+;;
+(* ----------- *)
+
+
+let rec sieve (Cons (x, f)) =
+  let rec sift n s =
+    if head s mod n = 0 then
+      sift n (tail s)
+    else
+      Cons (head s, fun () -> sift n (tail s))
+  in
+  Cons (x, fun () -> sieve (sift x (f ()) ));;
+(* [説明] *)
+(* エラトステネスの篩を実装した。                           *)
+(* 内部関数siftは整数nとシーケンスsを受取り、               *)
+(* sからnの倍数を排除したシーケンスを返す。                 *)
+(* sの先頭要素がnで割り切れる場合、                         *)
+(* その数を破棄してシーケンスの続きに再度siftを適用する。   *)
+(* sの先頭要素がnで割り切れない場合、                       *)
+(* その数をConsで結合し、シーケンスの続きにsiftを適用する。 *)
+
+(* [実行例] *)
+(* # let primes = sieve (from 2);;                     *)
+(* val primes : int seq = Cons (2, <fun>)              *)
+(* # take 10 primes;;                                  *)
+(* - : int list = [2; 3; 5; 7; 11; 13; 17; 19; 23; 29] *)
+
+(* ----- 学生番号下4桁 + 3000 番目の素数 -----         *)
+(* # nthseq (8500 + 3000) primes;;                     *)
+(* - : int = 122251                                    *)

File ExOcaml/Ex7_2.ml

View file
  • Ignore whitespace
+let incr r =
+  r := !r + 1
+;;
+(* [説明] *)
+(* 参照rに、rに格納された値+1を格納しなおしている。 *)
+
+(* [実行例] *)
+(* # let x = ref 3;;                *)
+(* val x : int ref = {contents = 3} *)
+(* # x;;                            *)
+(* - : int ref = {contents = 3}     *)
+(* # incr x;;                       *)
+(* - : unit = ()                    *)
+(* # x;;                            *)
+(* - : int ref = {contents = 4}     *)

File ExOcaml/Ex7_4.ml

View file
  • Ignore whitespace
+let fact_imp n =
+  let i = ref n and
+      res = ref 1 in
+  while !i > 0 do
+    res := !res * !i;
+    i := !i - 1;
+  done;
+  !res
+;;
+
+(* [実行例] *)
+(* # fact_imp 5;;    *)
+(* - : int = 120     *)
+(* # fact_imp 10;;   *)
+(* - : int = 3628800 *)

File ExOcaml/Ex7_6.ml

View file
  • Ignore whitespace
+(* let x = ref [];; *)
+(* の型は'_a list refとなる。 *)
+(* これは多相型ではなく未確定単層型である。 *)
+(* なので、1をconsした時点で *)
+(* このリストはint list型に固定され、 *)
+(* bool型要素trueのconsを許さない。 *)

File ExOcaml/Ex7_8.ml

View file
  • Ignore whitespace
+let rec change = function
+  | (_, 0) -> [] (* 両替残金が0 *)
+  | ((c :: rest) as coins, total) ->
+    if c > total then
+      change (rest, total) (* 一番大きい硬貨を除いてリトライ  *)
+    else
+      begin
+	try
+	  c :: change (coins, total - c) (* 硬貨を選択して残金を減らす *)
+	with
+	| Failure "change" -> (* 例外をcatch *)
+	  change (rest, total) (* 一番大きい硬貨を除いてリトライ *)
+      end
+  | _ -> raise (Failure "change") (* 例外をraise *)
+;;
+
+(* [実行例] *)
+(* 例外が発生しない例                   *)
+(* # change ([5; 2], 32);;              *)
+(* - : int list = [5; 5; 5; 5; 5; 5; 2] *)
+
+(* 例外が発生する例               *)
+(* # change ([5; 2], 16);;        *)
+(* - : int list = [5; 5; 2; 2; 2] *)
+

File Interpreter/Makefile

View file
  • Ignore whitespace
+OCAMLC=ocamlc
+OCAMLOPT=ocamlopt
+OCAMLDEP=ocamldep
+OCAMLYACC=ocamlyacc
+OCAMLLEX=ocamllex
+INCLUDES=                 # all relevant -I options here
+OCAMLFLAGS=$(INCLUDES)    # add other options for ocamlc here
+OCAMLOPTFLAGS=$(INCLUDES) # add other options for ocamlopt here
+
+PROGNAME=miniml
+
+# The list of object files for prog1
+OBJS=syntax.cmo parser.cmo lexer.cmo environment.cmo eval.cmo main.cmo
+
+DEPEND += lexer.ml parser.ml
+
+all: $(DEPEND) $(OBJS)
+	$(OCAMLC) -o $(PROGNAME) $(OCAMLFLAGS) $(OBJS)
+
+# Common rules
+.SUFFIXES: .ml .mli .cmo .cmi .cmx
+
+.ml.cmo:
+	$(OCAMLC) $(OCAMLFLAGS) -c $<
+
+.mli.cmi:
+	$(OCAMLC) $(OCAMLFLAGS) -c $<
+
+.ml.cmx:
+	$(OCAMLOPT) $(OCAMLOPTFLAGS) -c $<
+
+parser.ml parser.mli: parser.mly	
+	@rm -f $@
+	$(OCAMLYACC) -v $<
+	@chmod -w $@
+
+lexer.ml: lexer.mll
+	@rm -f $@
+	$(OCAMLLEX) $<
+	@chmod -w $@
+
+# Clean up
+clean:
+	rm -f $(PROGNAME)
+	rm -f *.cm[iox] *.o *~ parser.ml parser.mli parser.output lexer.ml .depend
+
+# Dependencies
+depend:: $(DEPEND)
+	$(OCAMLDEP) $(INCLUDES) -native *.mli *.ml > .depend
+
+-include .depend

File Interpreter/environment.ml

View file
  • Ignore whitespace
+type 'a t = (Syntax.id * 'a) list
+
+exception Not_bound
+
+let empty = []
+let extend x v env = (x,v)::env
+
+let rec lookup x env = 
+  try List.assoc x env with Not_found -> raise Not_bound
+
+let rec map f = function
+    [] -> []
+  | (id, v)::rest -> (id, f v) :: map f rest
+
+let rec fold_right f env a = 
+  match env with
+      [] -> a
+    | (_, v)::rest -> f v (fold_right f rest a)

File Interpreter/environment.mli

View file
  • Ignore whitespace
+type 'a t
+
+exception Not_bound
+
+val empty : 'a t
+val extend : Syntax.id -> 'a -> 'a t -> 'a t
+val lookup : Syntax.id -> 'a t -> 'a
+val map : ('a -> 'b) -> 'a t -> 'b t
+val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b

File Interpreter/eval.ml

View file
  • Ignore whitespace
+open Syntax 
+
+type exval = 
+    IntV of int
+  | BoolV of bool
+and dnval = exval
+
+exception Error of string
+
+let err s = raise (Error s)
+
+(* pretty printing *)
+let rec string_of_exval = function
+    IntV i -> string_of_int i
+  | BoolV b -> string_of_bool b
+
+let pp_val v = print_string (string_of_exval v)
+
+let rec apply_prim op arg1 arg2 = match op, arg1, arg2 with
+    Plus, IntV i1, IntV i2 -> IntV (i1 + i2)
+  | Plus, _, _ -> err ("Both arguments must be integer: +")
+  | Mult, IntV i1, IntV i2 -> IntV (i1 * i2)
+  | Mult, _, _ -> err ("Both arguments must be integer: *")
+  | Lt, IntV i1, IntV i2 -> BoolV (i1 < i2)
+  | Lt, _, _ -> err ("Both arguments must be integer: <")
+
+let rec eval_exp env = function
+    Var x -> 
+      (try Environment.lookup x env with 
+        Environment.Not_bound -> err ("Variable not bound: " ^ x))
+  | ILit i -> IntV i
+  | BLit b -> BoolV b
+  | BinOp (op, exp1, exp2) -> 
+      let arg1 = eval_exp env exp1 in
+      let arg2 = eval_exp env exp2 in
+      apply_prim op arg1 arg2
+  | IfExp (exp1, exp2, exp3) ->
+      let test = eval_exp env exp1 in
+        (match test with
+            BoolV true -> eval_exp env exp2 
+          | BoolV false -> eval_exp env exp3
+          | _ -> err ("Test expression must be boolean: if"))
+
+let eval_decl env = function
+    Exp e -> let v = eval_exp env e in ("-", env, v)

File Interpreter/lexer.mll

View file
  • Ignore whitespace
+{
+let reservedWords = [
+  (* Keywords *)
+  ("else", Parser.ELSE);
+  ("false", Parser.FALSE);
+  ("if", Parser.IF);
+  ("then", Parser.THEN);
+  ("true", Parser.TRUE);
+] 
+}
+
+rule main = parse
+  (* ignore spacing and newline characters *)
+  [' ' '\009' '\012' '\n']+     { main lexbuf }
+
+| "-"? ['0'-'9']+
+    { Parser.INTV (int_of_string (Lexing.lexeme lexbuf)) }
+
+| "(" { Parser.LPAREN }
+| ")" { Parser.RPAREN }
+| ";;" { Parser.SEMISEMI }
+| "+" { Parser.PLUS }
+| "*" { Parser.MULT }
+| "<" { Parser.LT }
+
+| ['a'-'z'] ['a'-'z' '0'-'9' '_' '\'']*
+    { let id = Lexing.lexeme lexbuf in
+      try 
+        List.assoc id reservedWords
+      with
+      _ -> Parser.ID id
+     }
+| eof { exit 0 }
+
+

File Interpreter/main.ml

View file
  • Ignore whitespace
+open Syntax
+open Eval
+
+let rec read_eval_print env =
+  print_string "# ";
+  flush stdout;
+  let decl = Parser.toplevel Lexer.main (Lexing.from_channel stdin) in
+  let (id, newenv, v) = eval_decl env decl in
+    Printf.printf "val %s = " id;
+    pp_val v;
+    print_newline();
+    read_eval_print newenv
+
+let initial_env = 
+  Environment.extend "i" (IntV 1)
+    (* 以下、Ex3.1で追加*)
+    (Environment.extend "ii" (IntV 2)
+       (Environment.extend "iii" (IntV 3)
+	  (Environment.extend "iv" (IntV 4)
+	     (* 以上. *)
+	     (Environment.extend "v" (IntV 5) 
+		(Environment.extend "x" (IntV 10) Environment.empty)))))
+
+let _ = read_eval_print initial_env
+
+(* +--------------+ *)
+(* | Ex3.1 実行例 | *)
+(* +--------------+ *)
+(* # iv + iii * ii;; *)
+(* iv + iii * ii;;   *)
+(* val - = 10        *)
+

File Interpreter/parser.mly

View file
  • Ignore whitespace
+%{
+open Syntax
+%}
+
+%token LPAREN RPAREN SEMISEMI
+%token PLUS MULT LT
+%token IF THEN ELSE TRUE FALSE
+(* 以下、Ex3.2で追加 *)
+
+(* 以上 *)
+
+
+%token <int> INTV
+%token <Syntax.id> ID
+
+%start toplevel
+%type <Syntax.program> toplevel
+%%
+
+toplevel :
+    Expr SEMISEMI { Exp $1 }
+
+Expr :
+    IfExpr { $1 }
+  | LTExpr { $1 }
+
+LTExpr : 
+    PExpr LT PExpr { BinOp (Lt, $1, $3) }
+  | PExpr { $1 }
+
+PExpr :
+    PExpr PLUS MExpr { BinOp (Plus, $1, $3) }
+  | MExpr { $1 }
+
+MExpr : 
+    MExpr MULT AExpr { BinOp (Mult, $1, $3) }
+  | AExpr { $1 }
+
+AExpr :
+    INTV { ILit $1 }
+  | TRUE { BLit true }
+  | FALSE { BLit false }
+  | ID { Var $1 }
+  | LPAREN Expr RPAREN { $2 }
+
+IfExpr :
+    IF Expr THEN Expr ELSE Expr { IfExp ($2, $4, $6) }
+
+   

File Interpreter/syntax.ml

View file
  • Ignore whitespace
+(* ML interpreter / type reconstruction *)
+type id = string
+
+type binOp = Plus | Mult | Lt
+
+type exp =
+    Var of id
+  | ILit of int
+  | BLit of bool
+  | BinOp of binOp * exp * exp
+  | IfExp of exp * exp * exp
+
+type program = 
+    Exp of exp

File README.md

View file
  • Ignore whitespace
+# 実験4 プログラム検証