Browse Source

Indentation fixes.

master
Quentin Barrand 5 years ago
parent
commit
2f09c95671
4 changed files with 139 additions and 82 deletions
  1. +40
    -22
      part1.ml
  2. +63
    -49
      part2.ml
  3. +7
    -0
      part2.test.ml
  4. +29
    -11
      part3.ml

+ 40
- 22
part1.ml View File

@@ -1,10 +1,12 @@
type coord = float * float ;;
type rect = R of coord * coord ;;
(* Question 1 *)

let make_rect = fun a -> fun b ->
let make_rect =
fun a ->
fun b ->
let c1 = (min (fst a) (fst b), max (snd a) (snd b)) in
let c2 = (max (fst a) (fst b), min (snd a) (snd b)) in
R(c1, c2)
@@ -13,62 +15,78 @@ let make_rect = fun a -> fun b ->

(* Question 2 *)

let rect_left = fun r -> match r with
let rect_left =
fun r ->
match r with
| R((x1, y1), (x2, y2)) -> x1
;;

let rect_right = fun r -> match r with
let rect_right =
fun r ->
match r with
| R((x1, y1), (x2, y2)) -> x2
;;

let rect_bottom = fun r -> match r with
let rect_bottom =
fun r ->
match r with
| R((x1, y1), (x2, y2)) -> y2
;;

let rect_top = fun r -> match r with
let rect_top =
fun r ->
match r with
| R((x1, y1), (x2, y2)) -> y1
;;


(* Question 3 *)

let rect_length = fun r ->
let rect_length =
fun r ->
rect_right r -. rect_left r
;;

let rect_height = fun r ->
let rect_height =
fun r ->
rect_top r -. rect_bottom r
;;


(* Question 4 *)

let rect_mem = fun r -> fun a ->
fst a > rect_left r &&
fst a < rect_right r &&
snd a < rect_top r &&
snd a > rect_bottom r
let rect_mem =
fun r ->
fun a ->
fst a >= rect_left r &&
fst a <= rect_right r &&
snd a <= rect_top r &&
snd a >= rect_bottom r
;;


(* Question 5 *)

let rect_intersect = fun r1 -> fun r2 ->
rect_mem r1 (rect_left r2, rect_top r2)
|| rect_mem r1 (rect_left r2, rect_bottom r2)
|| rect_mem r1 (rect_right r2, rect_top r2)
|| rect_mem r1 (rect_right r2, rect_bottom r2)
let rect_intersect =
fun r1 ->
fun r2 ->
rect_mem r1 (rect_left r2, rect_top r2) ||
rect_mem r1 (rect_left r2, rect_bottom r2) ||
rect_mem r1 (rect_right r2, rect_top r2) ||
rect_mem r1 (rect_right r2, rect_bottom r2)
;;


(* Question 6 *)

let rect_split = fun r ->
let rect_split =
fun r ->
let p = (rect_left r) +. ((rect_length r) /. 2.),
(rect_bottom r +. (rect_height r) /. 2.)
(rect_bottom r +. (rect_height r) /. 2.)
in
make_rect (rect_left r, rect_top r) p,
make_rect p (rect_right r, rect_top r),
make_rect (rect_left r, rect_bottom r) p,
make_rect p (rect_right r, rect_bottom r)
;;


+ 63
- 49
part2.ml View File

@@ -1,13 +1,13 @@
#use "part1.ml"
type 'a quadtree =
| Q of rect * 'a cell
and 'a cell =
| Empty
| Leaf of coord * 'a
| Node of 'a quadtree * 'a quadtree * 'a quadtree * 'a quadtree
| Q of rect * 'a cell
and 'a cell =
| Empty
| Leaf of coord * 'a
| Node of 'a quadtree * 'a quadtree * 'a quadtree * 'a quadtree
;;

(* Question 7 *)

@@ -16,7 +16,8 @@ and 'a cell =

(* Question 8 *)

let boundary = fun q ->
let boundary =
fun q ->
match q with
| Q(r, _) -> r
;;
@@ -24,83 +25,96 @@ let boundary = fun q ->

(* Question 9 *)

let rec cardinal = fun q ->
let rec cardinal =
fun q ->
match q with
| Q(_, c) -> match c with
| Empty -> 0
| Leaf _ -> 1
| Node (q1, q2, q3, q4) -> cardinal q1 + cardinal q2 + cardinal q3 + cardinal q4
| Empty -> 0
| Leaf _ -> 1
| Node (q1, q2, q3, q4) -> cardinal q1 + cardinal q2 + cardinal q3 + cardinal q4
;;


(* Question 10 *)

let rec list_of_quadtree = fun q ->
let rec list_of_quadtree =
fun q ->
match q with
| Q(_, cell) -> match cell with
| Empty -> []
| Leaf (c, obj) -> (c, obj)::[]
| Node (q1, q2, q3, q4) -> (list_of_quadtree q1)@(list_of_quadtree q2)@(list_of_quadtree q3)@(list_of_quadtree q4)
| Empty -> []
| Leaf (c, obj) -> (c, obj)::[]
| Node (q1, q2, q3, q4) -> (list_of_quadtree q1)@(list_of_quadtree q2)@(list_of_quadtree q3)@(list_of_quadtree q4)
;;


(* Question 11 *)

let split_leaf = fun q -> fun c -> fun obj ->
let split_leaf =
fun q ->
fun c ->
fun obj ->
match q with
| Q(r, cell) ->
let r1, r2, r3, r4 = rect_split r in
let newcell =
if rect_mem r1 c then Node(Q(r1, Leaf(c, obj)), Q(r2, Empty), Q(r3, Empty), Q(r4, Empty)) else
if rect_mem r2 c then Node(Q(r1, Empty), Q(r2, Leaf(c, obj)), Q(r3, Empty), Q(r4, Empty)) else
if rect_mem r3 c then Node(Q(r1, Empty), Q(r2, Empty), Q(r3, Leaf(c, obj)), Q(r4, Empty)) else
if rect_mem r4 c then Node(Q(r1, Empty), Q(r2, Empty), Q(r3, Empty), Q(r4, Leaf(c, obj))) else
failwith "No quadtree of which point is member"
in Q(r, newcell)
let r1, r2, r3, r4 = rect_split r in
let newcell =
if rect_mem r1 c then Node(Q(r1, Leaf(c, obj)), Q(r2, Empty), Q(r3, Empty), Q(r4, Empty)) else
if rect_mem r2 c then Node(Q(r1, Empty), Q(r2, Leaf(c, obj)), Q(r3, Empty), Q(r4, Empty)) else
if rect_mem r3 c then Node(Q(r1, Empty), Q(r2, Empty), Q(r3, Leaf(c, obj)), Q(r4, Empty)) else
if rect_mem r4 c then Node(Q(r1, Empty), Q(r2, Empty), Q(r3, Empty), Q(r4, Leaf(c, obj))) else
failwith "No sub quadtree of which point is member"
in Q(r, newcell)
;;


let rec insert = fun q -> fun c -> fun add_obj ->
let rec insert =
fun q ->
fun c ->
fun add_obj ->
match q with
Q(r, cell) ->
if rect_mem r c = false
then q (* or exception *)
else
match cell with
| Empty -> Q(r, Leaf (c, add_obj))
| Leaf (c', obj) -> insert (split_leaf q c' obj) c add_obj
| Node (q1, q2, q3, q4) -> Q(r, Node(insert q1 c add_obj, insert q2 c add_obj, insert q3 c add_obj, insert q4 c add_obj))
if rect_mem r c = false
then q (*failwith "Object coordinates not within the quadtree's rectangle" *)
else
match cell with
| Empty -> Q(r, Leaf (c, add_obj))
| Leaf (c', obj) -> insert (split_leaf q c' obj) c add_obj
| Node (q1, q2, q3, q4) -> Q(r, Node(insert q1 c add_obj, insert q2 c add_obj, insert q3 c add_obj, insert q4 c add_obj))
;;

(* Question 12 *)

let quadtree_of_list = fun l -> fun r ->
(* Question 12 *)
let quadtree_of_list =
fun l ->
fun r ->
List.fold_left (fun q item -> match item with c, obj -> insert q c obj) (Q(r, Empty)) l
;;


(* Question 13 *)

let rec clean_node = fun cell ->
let rec clean_node =
fun cell ->
match cell with
| Empty -> cell
| Leaf _ -> cell
| Node(Q(_, Empty), Q(_, Empty), Q(_, Empty), Q(_, Empty)) -> Empty
| Node(Q(r1, c1), Q(r2, c2), Q(r3, c3), Q(r4, c4)) -> Node(
Q(r1, clean_node c1),
Q(r2, clean_node c2),
Q(r3, clean_node c3),
Q(r4, clean_node c4))
| Node(Q(r1, c1), Q(r2, c2), Q(r3, c3), Q(r4, c4)) ->
Node(
Q(r1, clean_node c1),
Q(r2, clean_node c2),
Q(r3, clean_node c3),
Q(r4, clean_node c4))
;;

let remove = fun q -> fun c ->
let remove =
fun q ->
fun c ->
match q with
| Q(r, cell) -> let newcell = match cell with
| Empty -> cell
| Leaf (c1, _) -> if c1 = c then Empty else cell
| Node (q1, q2, q3, q4) -> clean_node (Node (q1, q2, q3, q4))
| Empty -> cell
| Leaf (c1, _) -> if c1 = c then Empty else cell
| Node (q1, q2, q3, q4) -> clean_node (Node (q1, q2, q3, q4))
in Q(r, newcell)
;;



+ 7
- 0
part2.test.ml View File

@@ -3,3 +3,10 @@

#use "display.ml"

let r = make_rect (0., 0.) (3., 3.) ;;

let q = Q(r, Empty) ;;

let q0 = insert q (1., 1.) "obj1" ;;

simple_test q0 (fun str -> str);;

+ 29
- 11
part3.ml View File

@@ -2,19 +2,37 @@

#use "display.ml"

let r0 = make_rect (0., 0.) (1., 1.) ;;
let r1 = make_rect (1., 1.) (2., 2.) ;;
let r1 = make_rect (2., 2.) (3., 3.) ;;
let r0 = make_rect (0., 0.) (2., 2.) ;;
let c0 = 1., 1. ;;

let q0 = Q(r0, Leaf(c0, 0)) ;;
let q1 = Q(r0, Leaf(c0, "obj1")) ;;
let q2 = Q(r0, Leaf((2., 2.), "obj2")) ;;

let c1 = 1.5, 1.5 ;;
let obj1 = "obj1" ;;
let obj1bis = 1 ;;
(*
simple_test q0 string_of_int ;;
simple_test q1 (fun str -> str) ;;
simple_test q2 (fun str -> str) ;;
*)
let r1, r2, r3, r4 = rect_split r0 ;;
rect_mem r1 (1.5, 1.5) ;;
rect_mem r2 (1.5, 1.5) ;;
rect_mem r3 (1.5, 1.5) ;;
rect_mem r4 (1.5, 1.5) ;;

let qt0 = Q(r0, Empty) ;;
let qt1 = Q(r1, Leaf(c1, obj1bis)) ;;
let q3 = insert q1 (1.5, 1.5) "obj3" ;;

let func = fun str -> str ;;
simple_test q3 (fun str -> str) ;;

simple_test qt0 func ;;
simple_test qt1 string_of_int ;;
(* simple_test: 'a quadtree -> ('a -> string) -> unit
*)
let new_simple_test = fun qt f ->
let r = boundary qt in
let dparams = init r in
let _ = draw_quadtree dparams f qt in
wait_and_quit ()
;;

Loading…
Cancel
Save