Yaron Minsky avatar Yaron Minsky committed 000598e

added convex hull

Comments (0)

Files changed (1)

 open Core.Std
 
 type posn = { x: float; y: float }
+with compare
 
 let posn x y = {x;y}
 
 let negate p = { x = -. p.x; y = -. p.y }
 ;;
 
+let cross_product p1 p2 =
+  p1.x *. p2.y -. p1.y *. p2.x
+;;
+
+let convex_hull ps =
+  if List.length ps <= 1 then ps else
+    (* Computes an upper or lower envelope from a sorted sequence of posns *)
+    let compute_envelope ps =
+      let envelope = Stack.create () in
+      List.iter ps ~f:(fun p ->
+        let rec pop () =
+          match Stack.to_list envelope with
+          | [] | [_] ->  ()
+          | a :: b :: _  ->
+            if cross_product (a -! p) (b -! p) <= 0. then
+              (ignore (Stack.pop envelope : posn option); pop ())
+            else ()
+        in
+        pop ();
+        Stack.push envelope p 
+      );
+      Stack.to_list envelope
+    in
+    let ps = List.sort ps ~cmp:compare_posn |! List.dedup in
+    let lower = compute_envelope ps in
+    let upper = compute_envelope (List.rev ps) in
+    List.tl_exn lower @ List.tl_exn upper
+
+let convex_test () =
+  assert (convex_hull [posn 0. 0.] = [posn 0. 0.]);
+  assert (convex_hull [posn 0. 0.; posn 10. 3.] = [posn 0. 0.; posn 10. 3.]);
+  assert (convex_hull [posn 10. 3.; posn 0. 0.] = [posn 0. 0.; posn 10. 3.]);
+  assert (convex_hull [posn 10. 3.; posn 0. 0.; posn 3. 4.]
+          = [posn 3. 4.; posn 0. 0.; posn 10. 3.]);
+  assert (convex_hull [posn 10. 3.; posn 5. 0.; posn 3. 4.; posn 5. 1.]
+          = [posn 3. 4.; posn 5. 0.; posn 10. 3.]);
+  assert (convex_hull [posn 0. 0.; posn 1. 1.; posn 3. 3.]
+          = [posn 0. 0.; posn 3. 3.]);
+  assert (convex_hull [posn 0. 0.; posn 3. 3.; posn 1. 1.001]
+          = [posn 1. 1.001; posn 0. 0.;  posn 3. 3.]);
+;;
+
+let _ = convex_hull
+
 type color = { r: float; g: float; b: float }
 let color r g b = {r;g;b}
 
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.