Objective Caml 入門 手習い（6章）その1

いよいよ終盤になってきました。

• Objective Caml 入門

Exercise 1

問題

Exercise1 以下のレコード型 loc_fig は，図形にxy平面上での位置情報をもたせたもので ある．正方形，長方形は，各辺が軸に並行であるように配置されていると仮定(長方 形に関しては，Rectangle (x, y) の x の表す辺がx軸に並行，とする．)し， 二つの図形が重なりを持つか判定する関数 overlap を定義せよ．
type loc_fig = {x : int; y : int; fig : figure};;

自分の答え

type figure =
  | Point
  | Circle of int
  | Rectangle of int * int
  | Square of int
;;

type loc_fig = {x: int; y: int; fig: figure};;


let overlap lf1 lf2 =
  let square x = x * x in
  let overlap_circle x1 y1 r1 x2 y2 r2 =
	square (x1 - x2) + square (y1 - y2) > square (r1 - r2)
  in
  let rec overlap_rectangle x1 y1 h1 w1 x2 y2 h2 w2 =
	match x1, y1, x2, y2 with
    | x1, y1, x2, y2 when (x1 < x2) && (y1 < y2)
        -> (x1 + w1 > x2) && (y1 + h1 > y2)
    | x1, y1, x2, y2 when (x1 < x2) && (y1 > y2)
        -> (x1 + w1 > x2) && (y1 + h1 > y2 + h2)
    | x1, y1, x2, y2 when (x1 >= x2)
        -> overlap_rectangle x2 y2 h2 w2 x1 y1 h1 w1
	| _, _, _, _
        -> false
  in
  let overlap_square x1 y1 l1 x2 y2 l2 =
	overlap_rectangle x1 y1 l1 l1 x2 y2 l2 l2
  in
	match lf1.fig, lf2.fig with
	| Circle r1, Circle r2
		-> overlap_circle lf1.x lf1.y r1 lf2.x lf2.y r2
	| Rectangle (h1, w1), Rectangle (h2, w2)
		-> overlap_rectangle lf1.x lf1.y h1 w1 lf2.x lf2.y h2 w2
	| Square l1, Square l2
		-> overlap_square lf1.x lf1.y l1 lf2.x lf2.y l2
	| _, _
		-> false
;;

Exercise 2

問題

Exercise2 nat 型の値をそれが表現する int に変換する関数 int_of_nat, nat 上の掛け算を行う関数 mul，nat 上の引き算を行う 関数(ただし 0 − n = 0) monus (モーナス) を定義せよ． (mul, monus は *, - などの助けを借りず， 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 nat =
  let rec int_of_nat ret = function
	| Zero -> ret
	| OneMoreThan nat -> int_of_nat (ret + 1) nat
  in
	int_of_nat 0 nat
;;

let rec mul m n =
  match m, n with
  | OneMoreThan Zero, _ -> n
  | _, Zero | Zero, _ -> Zero
  | OneMoreThan m', _ -> mul m' (add n n)
;;

let rec monus m n =
  match m, n with
  | Zero, _ -> Zero
  | _, Zero -> m
  | OneMoreThan m', OneMoreThan n' -> monus m' n'
;;


let two = OneMoreThan (OneMoreThan Zero);; 
let three = OneMoreThan (OneMoreThan (OneMoreThan Zero));; 

let print_nat n = Printf.printf "%d\n" (int_of_nat n);;
print_nat three;;
print_nat (mul two three);;
print_nat (monus three two);;

Exercise 3

問題

Exercise3 上の monus 関数を変更して，0 − n (n > 0) は None を返す nat -> nat -> nat option 型の関数 minus を定義せよ．

自分の答え

let rec minus m n = 
  match m, n with
  | Zero, OneMoreThan n' -> None
  | _, Zero -> Some m
  | OneMoreThan m', OneMoreThan n' -> minus m' n'
;;

let print_nat_option = function
  | None -> Printf.printf "None\n"
  | Some x -> Printf.printf "%d\n" (int_of_nat x)
;;
  
print_nat_option (minus three two);;
print_nat_option (minus two three);;