(************************************************************************) (* *) (* Enveloppe convexe d'un ensemble fini *) (* de points du plan *) (* *) (* StratŽgie DIVISER POUR RƒGNER et *) (* algorithme de Preparata et Hong *) (* *) (************************************************************************) load_object "Cycles" ;; #open "Cycles" ;; let rec avance_cycle_jusque but cycle = if (valeur_cycle cycle) = but then cycle else avance_cycle_jusque but (avance_cycle cycle) ;; load_object "tri_fusion" ;; #open "tri_fusion" ;; (* type point == int * int ;; *) let abscisse = function (px,_) -> px ;; let ordonnŽe = function (_,py) -> py ;; let vecteur (px,py) (qx,qy) = (qx-px,qy-py) ;; let dŽterminant (ax,ay) (bx,by) = ax * by - ay * bx ;; let saillant p q r = 0 < (dŽterminant (vecteur p q) (vecteur q r)) ;; let rentrant p q r = 0 > (dŽterminant (vecteur p q) (vecteur q r)) ;; let alignŽs p q r = 0 = (dŽterminant (vecteur p q) (vecteur q r)) ;; (* un polygone sera reprŽsentŽ par un cycle de points, pris dans l'ordre *) (* trigonomŽtrique --- on ne considre ici que des polygones convexes *) let point_droit p = (* p ˆ partir de son point le plus ˆ droite *) let xici p = abscisse (valeur_cycle p) and xav p = abscisse (valeur_cycle (avance_cycle p)) and xap p = abscisse (valeur_cycle (recule_cycle p)) in let rec roule_avant p = if (xici p) < (xav p) then roule_avant (avance_cycle p) else p and roule_derrire p = if (xici p) < (xap p) then roule_derrire (recule_cycle p) else p in if (xici p) < (xav p) then roule_avant p else roule_derrire p ;; let point_gauche p = (* p ˆ partir de son point le plus ˆ gauche *) let xici p = abscisse (valeur_cycle p) and xav p = abscisse (valeur_cycle (avance_cycle p)) and xap p = abscisse (valeur_cycle (recule_cycle p)) in let rec roule_avant p = if (xici p) > (xav p) then roule_avant (avance_cycle p) else p and roule_derrire p = if (xici p) > (xap p) then roule_derrire (recule_cycle p) else p in if (xici p) > (xav p) then roule_avant p else roule_derrire p ;; (* les fonctions de recherche des ponts inf et sup *) (* les deux polygones sont p1, ˆ gauche, et p2, ˆ droite *) (* d est le point le plus ˆ droite de p1, g ˆ gauche de p2 *) let pont_infŽrieur d g = let saille p q r = let d = dŽterminant (vecteur p q) (vecteur q r) in (d > 0) or ( (d = 0) & ((ordonnŽe p) > (ordonnŽe r)) ) and rentre p q r = let d = dŽterminant (vecteur p q) (vecteur q r) in (d < 0) or ( (d = 0) & ((ordonnŽe p) > (ordonnŽe r)) ) in let rec tourne_en_appui_gauche (p1,p2,niveau) = if saille (valeur_cycle p2) (valeur_cycle p1) (valeur_cycle (avance_cycle p2)) then tourne_en_appui_gauche (p1,(avance_cycle p2),0) else (p1,p2,niveau + 1) and tourne_en_appui_droit (p1,p2,niveau) = if rentre (valeur_cycle p1) (valeur_cycle p2) (valeur_cycle (recule_cycle p1)) then tourne_en_appui_droit ((recule_cycle p1),p2,0) else (p1,p2,niveau + 1) and itre (p1,p2,niveau) = if niveau < 2 then itre (tourne_en_appui_droit (tourne_en_appui_gauche (p1,p2,niveau))) else p1,p2 in itre (d,g,0) ;; let pont_supŽrieur d g = let saille p q r = let d = dŽterminant (vecteur p q) (vecteur q r) in (d > 0) or ( (d = 0) & ((ordonnŽe p) < (ordonnŽe r)) ) and rentre p q r = let d = dŽterminant (vecteur p q) (vecteur q r) in (d < 0) or ( (d = 0) & ((ordonnŽe p) < (ordonnŽe r)) ) in let rec tourne_en_appui_gauche (p1,p2,niveau) = if rentre (valeur_cycle p2) (valeur_cycle p1) (valeur_cycle (recule_cycle p2)) then tourne_en_appui_gauche (p1,(recule_cycle p2),0) else (p1,p2,niveau + 1) and tourne_en_appui_droit (p1,p2,niveau) = if saille (valeur_cycle p1) (valeur_cycle p2) (valeur_cycle (avance_cycle p1)) then tourne_en_appui_droit ((avance_cycle p1),p2,0) else (p1,p2,niveau + 1) and itre (p1,p2,niveau) = if niveau < 2 then itre (tourne_en_appui_droit (tourne_en_appui_gauche (p1,p2,niveau))) else p1,p2 in itre (d,g,0) ;; (* enveloppeConvexe [p1;pŽ;É;pn] renvoie le polygone *) (* frontire de l'enveloppe convexe de la liste de *) (* points du plan fournie en argument *) let enveloppeConvexe l = let rec enveloppeConvexeRŽcursif l = match l with [] -> liste_en_cycle l (* cas dŽgŽnŽrŽ *) | [p] -> liste_en_cycle l (* cas dŽgŽnŽrŽ *) | [p;q] -> liste_en_cycle l | [p;q;r] -> if saillant p q r (* on assure le bon sens de parcours *) then liste_en_cycle [p;q;r] else liste_en_cycle [p;r;q] | _ -> let l1,l2 = coupe_en_deux l in let p1,p2 = (enveloppeConvexeRŽcursif l1), (enveloppeConvexeRŽcursif l2) in let d,g = (point_droit p1),(point_gauche p2) in let p,q = pont_infŽrieur d g and p',q' = pont_supŽrieur d g in fusion_polygones p q p' q' and coupe_en_deux l = let rec coupure_rŽcursive i l = if i <= 0 then [],l else let l1,l2 = coupure_rŽcursive (i-1) (tl l) in ((hd l) :: l1) , l2 in coupure_rŽcursive ((list_length l) / 2) l and fusion_polygones p q p' q' = let rec tour1 accu c val_p' = if (valeur_cycle c) = val_p' then val_p' :: accu else tour1 ((valeur_cycle c) :: accu) (recule_cycle c) val_p' and tour2 accu c val_q = if (valeur_cycle c) = val_q then val_q :: accu else tour2 ((valeur_cycle c) :: accu) (recule_cycle c) val_q in liste_en_cycle (tour2 (tour1 [] p (valeur_cycle p')) q' (valeur_cycle q)) in enveloppeConvexeRŽcursif (tri_fusion (fun (px,_) (qx,_) -> px < qx) l) ;;