# 多相的ヴァリアントとデータ構造とパターンマッチ

```(* 図形を定義 *)
type figure =
Point
| Circle of float
| Rectangle of float * float
| Square of float;;

(* 座標情報をもったデータ *)
type 'a with_location = {loc_x : float; loc_y : float; body: 'a};;

type vector = Vector of float * float;;

(* 図形同士が重なっているかを判定*)
let rec overlap fig1 fig2 =
let (^-) p1 p2 = Vector (p1.loc_x -. p2.loc_x, p1.loc_y -. p2.loc_y) in
let contains rect point =
let Rectangle (w, h) = rect.body in
let Vector (dx, dy) = point ^- rect in
abs_float dx < w /. 2. && abs_float (dy) < h /. 2.
in
let dist p1 p2 =
let Vector (dx, dy) = p2 ^- p1 in
sqrt (dx *. dx +. dy *. dy)
in
let get_nearest rect point =
let Rectangle (w, h) = rect.body in
let Vector (dx, dy) = point ^- rect in
let w' = w /. 2. and h' = h /. 2. in
{loc_x = if      dx >   w' then rect.loc_x +. w'
else if dx < -.w' then rect.loc_x -. w'
else point.loc_x;
loc_y = if      dy >   h' then rect.loc_y +. h'
else if dy < -.h' then rect.loc_y -. h'
else point.loc_y;
body = Point}
in
match (fig1.body, fig2.body) with
(_, Square x) -> overlap fig1 {fig2 with body = Rectangle (x, x)}
| (Point, Point) -> fig1.loc_x = fig2.loc_x && fig1.loc_y = fig2.loc_y
| (Point, Circle r) -> dist fig1 fig2 < r
| (Point, Rectangle _) -> contains fig2 fig1
| (Circle r1, Circle r2) -> dist fig1 fig2 <= r1 +. r2
| (Circle r, Rectangle _) -> dist (get_nearest fig2 fig1) fig1 < r
| (Rectangle _, Rectangle _) -> contains (get_nearest fig2 fig1) fig1
| (_, _) -> overlap fig2 fig1;;
```

しっかしこれ、型推論無しでやったら大変そうだなぁ。型推論超便利！