(**************************************************************************) (* *) (* Thibaut Balabonski, Sylvain Conchon, Jean-Christophe Filliâtre, *) (* Kim Nguyen, Laurent Sartre *) (* *) (* Informatique - MP2I/MPI - CPGE 1re et 2e années. *) (* Cours et exercices corrigés. Éditions Ellipses, 2022. *) (* *) (* https://www.informatique-mpi.fr/ *) (* *) (**************************************************************************) (* Problème du voyageur de commerce - mise en place - solution approchée à un facteur 2 - solution exacte par séparation et évaluation *) open Wgraph open Kruskal (* Fabrication d'un graphe euclidien complet *) let dist (x1, y1) (x2, y2) = let dx, dy = x1 -. x2, y1 -. y2 in sqrt (dx *. dx +. dy *. dy) let euclidean_graph (l: (float * float) list): wgraph = let n = List.length l in let g = create n in let v = Array.make n (0., 0.) in List.iteri (fun i (x, y) -> v.(i) <- (x, y); for j = 0 to i - 1 do add_edge g (dist v.(i) v.(j), i, j) done ) l; g (* Solution approchée Parcours en profondeur d'un arbre couvrant de poids minimal Solution garantie à un facteur <= 2 de la tournée optimale Complexité polynomiale *) let tour (g: wgraph): int list * float = let span = create (size g) in List.iter (add_edge span) (kruskal g); let visited = Array.make (size g) false in let tour = ref [] in let length = ref 0. in let add v = (* ajout du sommet `v` à la tournée *) if !tour <> [] then length := !length +. weight g v (List.hd !tour); tour := v :: !tour in let rec dfs (v, _) = (* exploration à partir de `v`, dans l'arbre couvrant *) if not visited.(v) then ( visited.(v) <- true; add v; List.iter dfs (succ span v) ) in dfs (0, 0.); add 0; !tour, !length (* Solution exacte par branch and bound (exp. dans le pire des cas) *) (* Deux plus petits éléments d'une liste Précondition : `l` contient au moins deux éléments *) let min_two l = let rec min_two l a b = match l with | [] -> a, b | x :: l when x < a -> min_two l x a | x :: l when x < b -> min_two l a x | _ :: l -> min_two l a b in match l with | a :: b :: l -> min_two l a b | _ -> invalid_arg "min_two" let bnb_tour (g: wgraph): float = let n = size g in (* précalcul des coûts minimaux associés aux sommets non visités *) let cost = Array.init n (fun i -> let d1, d2 = min_two (List.map snd (succ g i)) in (d1 +. d2) /. 2.) in let visited = Array.make n false in (* fonction de calcul de borne inférieure, en fonction de la longueur `d` du chemin déjà construit et des sommets non encore visités *) let lb d = let lb = ref d in for i = 0 to n - 1 do if not visited.(i) then lb := !lb +. cost.(i) done; !lb in (* plus courte tournée connue, initialisée avec l'algorithme d'approximation *) let ub = ref (snd (tour g)) in let rec explore s d k = if k = n then (* fermeture de la boucle *) let d = d +. weight g s 0 in (if d < !ub then ub := d) else ( visited.(s) <- true; let lb = lb d in if lb < !ub then List.iter (fun (i, di) -> if not visited.(i) then explore i (d +. di) (k + 1) ) (succ g s) ; (* pas de else *) visited.(s) <- false ) in explore 0 0. 1; !ub (* Tournée des bed n breakfast Variante avec borne inférieure légèrement améliorée, tenant compte du fait que l'on a déjà sélectionné une arête incidente au premier et au dernier sommets de la tournée *) let bnb_tour_improved (g: wgraph): float = let n = size g in (* précalcul des coûts minimaux associés aux sommets non visités ou en cours de visite `costs.(s).(k)` donne le coût résiduel du sommet `s` si la tournée contient déjà `k` arêtes incidentes à `s` (0 <= k <= 2) *) let costs = Array.init n (fun _ -> Array.make 3 0.) in for i = 0 to n - 1 do let a, b = min_two (List.map snd (succ g i)) in costs.(i).(0) <- (a +. b) /. 2.; costs.(i).(1) <- a /. 2.; done; (* nombre d'arêtes incidentes déjà sélectionnées pour chaque sommet, `visited.(s)` vaut 0 si et seulement si `s` n'a pas encore été visité *) let visited = Array.make n 0 in (* fonction de calcul de borne inférieure, en fonction de la longueur `d` du chemin déjà construit et des sommets non encore visités *) let lb d = let lb = ref d in for i = 0 to n - 1 do lb := !lb +. costs.(i).(visited.(i)) done; !lb in (* plus courte tournée connue, initialisée avec l'algorithme d'approximation *) let ub = ref (snd (tour g)) in let rec explore s d k = if k = n then (* fermeture de la boucle *) let d = d +. weight g s 0 in (if d < !ub then ub := d) else ( visited.(s) <- 1; let lb = lb d in if lb < !ub then ( visited.(s) <- 2; List.iter (fun (i, di) -> if visited.(i) = 0 then explore i (d +. di) (k + 1)) (succ g s); ) ; (* pas de else *) visited.(s) <- 0 ) in explore 0 0. 1; !ub