From 307da4d1fb744bb3c66e5a43acd7702f0ce1b7ac Mon Sep 17 00:00:00 2001 From: xleroy Date: Wed, 13 Jan 2010 09:53:07 +0000 Subject: Backtracking on commit 1220 git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1228 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e --- backend/IRCColoring.v | 847 -------------------------------------------------- 1 file changed, 847 deletions(-) delete mode 100755 backend/IRCColoring.v (limited to 'backend/IRCColoring.v') diff --git a/backend/IRCColoring.v b/backend/IRCColoring.v deleted file mode 100755 index 5efeed7b..00000000 --- a/backend/IRCColoring.v +++ /dev/null @@ -1,847 +0,0 @@ -Require Import Recdef. -Require Import IRC. -Require Import FSetInterface. -Require Import Edges. -Require Import Interference_adjacency. -Require Import IRC_graph. -Require Import Conservative_criteria. -Require Import InterfGraphMapImp. -Require Import Graph_Facts. -Require Import IRC_Graph_Functions. -Require Import WS. - -Import Edge RegFacts Props OTFacts. - -Module MapFacts := FMapFacts.Facts ColorMap. - -Definition proper_coloring_1 (col : Coloring) g := forall e x y, -interf_edge e -> -In_graph_edge e g -> -OptionReg.eq (col (fst_ext e)) (Some x) -> -OptionReg.eq (col (snd_ext e)) (Some y) -> -~Register.eq x y. - -Definition proper_coloring_2 (col : Coloring) g := forall x y, -OptionReg.eq (col x) (Some y) -> In_graph x g. - -Definition proper_coloring_3 (col : Coloring) palette := forall x y, -OptionReg.eq (col x) (Some y) -> VertexSet.In y palette. - -Definition proper_coloring col g palette := -proper_coloring_1 col g /\ proper_coloring_2 col g /\ proper_coloring_3 col palette. - -Lemma diff_empty_sub : forall s1 s2, -VertexSet.Empty (VertexSet.diff s1 s2) -> -VertexSet.Subset s1 s2. - -Proof. -intros s1 s2 H. -intros a H0. -destruct (In_dec a s2). -assumption. -elim (H a). -apply (VertexSet.diff_3 H0 n). -Qed. - -Lemma interf_in_forbidden : forall x y col g c, -Interfere x y g -> -OptionReg.eq (map_to_coloring col y) (Some c) -> -VertexSet.In c (forbidden_colors x col g). - -Proof. -intros x y col g c H H0. -unfold forbidden_colors. -unfold Interfere in H. rewrite <-in_interf in H. -generalize (interf_adj_comm _ _ _ H). intro H1. -generalize (VertexSet.elements_1 H1);clear H1;intro H1. -rewrite VertexSet.fold_1. -induction (VertexSet.elements (interference_adj x g)). -inversion H1. -rewrite monad_fold. -inversion H1;subst. -unfold map_to_coloring in H0. -inversion H0;subst. -rewrite (MapFacts.find_o col H3) in H2. -rewrite <-H2. -simpl;apply VertexSet.add_1. -assumption. -destruct (ColorMap.find a col);[apply VertexSet.add_2|];apply IHl;assumption. -Qed. - -Lemma available_coloring_1 : forall col x g, -proper_coloring (map_to_coloring col) (irc_g g) (pal g) -> -In_graph x (irc_g g) -> -proper_coloring (map_to_coloring (available_coloring g x col)) (irc_g g) (pal g). - -Proof. -intros col x ircg H HH. unfold available_coloring. -set (palette := pal ircg) in *. set (g := irc_g ircg) in *. -case_eq (VertexSet.choose (VertexSet.diff palette (forbidden_colors x col g))). -intros c H1. -generalize H1;intro H0. -unfold proper_coloring. -split. -unfold proper_coloring_1. -intros e x' y' H2 H3 H4 H5. -destruct (Register.eq_dec x (fst_ext e)). -unfold map_to_coloring in H4;unfold map_to_coloring in H5. -rewrite MapFacts.add_eq_o in H4. -rewrite MapFacts.add_neq_o in H5. -generalize (VertexSet.choose_1 H1);clear H1;intro H1. -generalize (VertexSet.diff_1 H1);intro H6. -generalize (VertexSet.diff_2 H1);intro H7;clear H1. -assert (Interfere x (snd_ext e) g) as Hinterf. -unfold Interfere. -assert (eq (fst_ext e, snd_ext e,None) (x, snd_ext e, None)). -Eq_eq. -rewrite (edge_eq e) in H3. -rewrite H2 in H3. -rewrite H1 in H3;assumption. -generalize (interf_in_forbidden x (snd_ext e) col g y' Hinterf H5);intro H1. -intro H8. -inversion H4;subst. -generalize (Register.eq_trans H11 H8);clear H11 H8;intro H8. -rewrite H8 in H7. -elim (H7 H1). -intro Heq. -elim (In_graph_edge_diff_ext _ _ H3). -apply (Register.eq_trans (Register.eq_sym Heq) e0). -assumption. -destruct (Register.eq_dec x (snd_ext e)). -unfold map_to_coloring in H4;unfold map_to_coloring in H5. -rewrite MapFacts.add_eq_o in H5. -rewrite MapFacts.add_neq_o in H4. -generalize (VertexSet.choose_1 H1);clear H1;intro H1. -generalize (VertexSet.diff_1 H1);intro H6. -generalize (VertexSet.diff_2 H1);intro H7;clear H1. -assert (Interfere x (fst_ext e) g) as Hinterf. -unfold Interfere. -rewrite (edge_eq e) in H3. rewrite H2 in H3. -assert (eq (fst_ext e, snd_ext e,None) (x, fst_ext e, None)) by Eq_comm_eq. -rewrite H1 in H3;assumption. -generalize (interf_in_forbidden x (fst_ext e) col g x' Hinterf H4);intro H1. -intro H8. -inversion H5;subst. -generalize (Register.eq_trans H11 (Register.eq_sym H8));clear H11 H8;intro H8. -rewrite H8 in H7. -elim (H7 H1). -intro Heq. -elim (In_graph_edge_diff_ext _ _ H3). -apply (Register.eq_trans (Register.eq_sym e0) Heq). -assumption. -unfold map_to_coloring in H4;unfold map_to_coloring in H5. -rewrite MapFacts.add_neq_o in H5. -rewrite MapFacts.add_neq_o in H4. -unfold proper_coloring in H;destruct H as [H _]. -unfold proper_coloring_1 in H. -apply (H e);assumption. -assumption. -assumption. -split. -unfold proper_coloring in *. -destruct H as [_ H];destruct H as [H _]. -unfold proper_coloring_2 in *. -intros x' y' H2. -destruct (Register.eq_dec x x'). -unfold map_to_coloring in H2. -rewrite e in HH;assumption. -apply (H x' y'). -unfold map_to_coloring in H2. -rewrite MapFacts.add_neq_o in H2. -assumption. -assumption. -unfold proper_coloring in *. -do 2 destruct H as [_ H]. -unfold proper_coloring_3 in *. -intros x' y' H2. -destruct (Register.eq_dec x x'). -unfold map_to_coloring in H2. -generalize (VertexSet.choose_1 H1);clear H1;intro H1. -generalize (VertexSet.diff_1 H1);intro H3. -rewrite MapFacts.add_eq_o in H2. -inversion H2;subst. -rewrite H6 in H3;assumption. -assumption. -apply (H x' y'). -unfold map_to_coloring in H2. -rewrite MapFacts.add_neq_o in H2. -assumption. -assumption. -auto. -Qed. - -Lemma complete_coloring_1 : forall col e g, -In_graph_edge e g -> -ColorMap.find (snd_ext e) col = None -> -OptionReg.eq -(map_to_coloring (complete_coloring e col) (snd_ext e)) -(map_to_coloring (complete_coloring e col) (fst_ext e)). - -Proof. -intros col e g HH Hin;unfold complete_coloring. -case_eq (ColorMap.find (fst_ext e) col). -intros r H. -unfold map_to_coloring. -rewrite MapFacts.add_eq_o. -rewrite MapFacts.add_neq_o. -rewrite H;apply OptionReg.eq_refl. -apply (In_graph_edge_diff_ext _ _ HH). -apply Register.eq_refl. -intro H0. -unfold map_to_coloring. -rewrite Hin;rewrite H0;apply OptionReg.eq_refl. -Qed. - -Lemma complete_coloring_2 : forall col e x, -~Register.eq (snd_ext e) x -> -OptionReg.eq -(map_to_coloring (complete_coloring e col) x) -(map_to_coloring col x). - -Proof. -intros col e x H. -unfold complete_coloring. -destruct (ColorMap.find (fst_ext e) col). -unfold map_to_coloring. -rewrite MapFacts.add_neq_o. -apply OptionReg.eq_refl. -assumption. -apply OptionReg.eq_refl. -Qed. - -Definition compat_col col := forall x y, -Register.eq x y -> OptionReg.eq (col x) (col y). - -Lemma compat_IRC : forall g palette, compat_col (IRC g palette). - -Proof. -unfold IRC. -unfold compat_col. -intros g palette x y H. -unfold map_to_coloring. -rewrite MapFacts.find_o with (y := y). -apply OptionReg.eq_refl. -assumption. -Qed. - -Lemma compat_complete : forall col e, -compat_col (map_to_coloring col) -> -compat_col (map_to_coloring (complete_coloring e col)). - -Proof. -unfold compat_col;intros col e H. -intros x y Heq;generalize (H x y Heq);clear H;intro H. -unfold complete_coloring. -destruct (ColorMap.find (fst_ext e) col). -unfold map_to_coloring. -destruct (Register.eq_dec x (snd_ext e)). -rewrite MapFacts.add_eq_o. -rewrite MapFacts.add_eq_o. -apply OptionReg.eq_refl. -apply (Register.eq_trans (Register.eq_sym e0) Heq). intuition. -rewrite MapFacts.add_neq_o. -rewrite MapFacts.add_neq_o. -assumption. -intro Helim;elim n. -apply (Register.eq_trans Heq (Register.eq_sym Helim)). -intro H0;elim n;auto. -assumption. -Qed. - -Lemma colored_complete_diff_colored : forall e col, -~Register.eq (snd_ext e) (fst_ext e) -> -OptionReg.eq (map_to_coloring (complete_coloring e col) (fst_ext e)) (map_to_coloring col (fst_ext e)). - -Proof. -intros e col H. -unfold complete_coloring. -case_eq (ColorMap.find (fst_ext e) col). -intros r H0. -unfold map_to_coloring. -rewrite MapFacts.add_neq_o. -apply OptionReg.eq_refl. -assumption. -intro H0. -apply OptionReg.eq_refl. -Qed. - -Lemma complete_coloring_coloring : forall col e g Hin Haff, -~VertexSet.In (snd_ext e) (precolored (irc_g g)) -> -proper_coloring (map_to_coloring col) (merge e (irc_g g) Hin Haff) (pal g) -> -conservative_coalescing_criteria e (irc_g g) (irc_k g) = true -> -compat_col (map_to_coloring col) -> -proper_coloring (map_to_coloring (complete_coloring e col)) (irc_g g) (pal g). - -Proof. -unfold proper_coloring;unfold proper_coloring_1; -unfold proper_coloring_2;unfold proper_coloring_3. -intros col e ircg H1 Haff Hpre H H0 Hcompat. -set (g := irc_g ircg) in *. set (palette := pal ircg) in *. -rewrite <-(Hk ircg) in *. -destruct H as [H HH];destruct HH as [HH HHH]. -split. -intros e' x' y' H2 H3 H4 H5. -apply (H (redirect (snd_ext e) (fst_ext e) e')). -unfold interf_edge;rewrite redirect_weight_eq;assumption. -apply In_merge_interf_edge. -assumption. -assumption. -(*intro Heq. -generalize (get_weight_m _ _ Heq);intro H6. -rewrite H2 in H6. -unfold aff_edge in Haff. -destruct Haff as [w Haff]. -rewrite Haff in H6. -inversion H6. -assumption.*) -destruct e' as [e' we'];destruct e' as [e'1 e'2]. -unfold redirect. -unfold interf_edge in H2;simpl in H2;subst. -change_rewrite. -destruct (OTFacts.eq_dec e'1 (snd_ext e));change_rewrite. -generalize (compat_complete col e);intro Hcompat2. -generalize (Hcompat2 Hcompat _ _ r);intro H7. -generalize (OptionReg.eq_trans _ _ _ (OptionReg.eq_sym _ _ H4) H7); -clear H7;intro H7. -assert (ColorMap.find (snd_ext e) col = None) as Hn. -case_eq (ColorMap.find (snd_ext e) col). -clear H3 H4 H5 r Hcompat2 H7. -intros r H8. -generalize (HH (snd_ext e) r);intro Helim. -unfold map_to_coloring in Helim. -rewrite H8 in Helim. -generalize (Helim (OptionReg.eq_refl _));clear Helim;intro Helim. -rewrite In_merge_vertex in Helim. destruct Helim. elim H3. auto. -auto. -generalize (complete_coloring_1 col e g H1 Hn);intro H8. -generalize (OptionReg.eq_trans _ _ _ H7 H8);intro H9. -generalize (complete_coloring_2 col e (fst_ext e) (In_graph_edge_diff_ext _ _ H1)). -intro H10. -generalize (OptionReg.eq_trans _ _ _ H9 H10);intro H11. -apply OptionReg.eq_sym;assumption. -destruct (OTFacts.eq_dec e'2 (snd_ext e));change_rewrite; -apply OptionReg.eq_trans with (y := (map_to_coloring (complete_coloring e col) e'1)); -[apply OptionReg.eq_sym;apply complete_coloring_2;intuition|assumption| -apply OptionReg.eq_sym;apply complete_coloring_2;intuition|assumption]. -destruct e' as [e' we'];destruct e' as [e'1 e'2]. -unfold redirect;change_rewrite. -unfold interf_edge in H2;simpl in H2;subst. -destruct (OTFacts.eq_dec e'1 (snd_ext e));change_rewrite. -destruct (Register.eq_dec (snd_ext e) e'2). -elim (In_graph_edge_diff_ext _ _ H3). -apply (Register.eq_trans (Register.eq_sym e0) (Register.eq_sym r)). -generalize (complete_coloring_2 col e e'2 n);intro H6. -apply OptionReg.eq_trans with (y := map_to_coloring (complete_coloring e col) e'2). -apply OptionReg.eq_sym;assumption. -assumption. -destruct (OTFacts.eq_dec e'2 (snd_ext e));change_rewrite. -generalize (compat_complete col e);intro Hcompat2. -generalize (Hcompat2 Hcompat _ _ r);intro H7. -generalize (OptionReg.eq_trans _ _ _ (OptionReg.eq_sym _ _ H5) H7); -clear H7;intro H7. -assert (ColorMap.find (snd_ext e) col = None) as Hn. -case_eq (ColorMap.find (snd_ext e) col). -clear H3 H4 H5 r Hcompat2 H7. -intros r H8. -generalize (HH (snd_ext e) r);intro Helim. -unfold map_to_coloring in Helim. -rewrite H8 in Helim. -generalize (Helim (OptionReg.eq_refl _));clear Helim;intro Helim. -rewrite In_merge_vertex in Helim. destruct Helim. elim H3. auto. -auto. -generalize (complete_coloring_1 col e g H1 Hn);intro H8. -generalize (OptionReg.eq_trans _ _ _ H7 H8);intro H9. -generalize (complete_coloring_2 col e (fst_ext e) (In_graph_edge_diff_ext _ _ H1)). -intro H10. -generalize (OptionReg.eq_trans _ _ _ H9 H10);intro H11. -apply OptionReg.eq_sym;assumption. -change (snd_ext (e'1,e'2,None)) with e'2. -assert (~Register.eq (snd_ext e) e'2) by intuition. -generalize (complete_coloring_2 col e e'2 H2);intro H6. -apply OptionReg.eq_trans with (y := map_to_coloring (complete_coloring e col) e'2). -apply OptionReg.eq_sym;assumption. -assumption. -(* second step *) -split. -intros x y H2. -destruct (Register.eq_dec x (snd_ext e)). -rewrite e0. -apply (In_graph_edge_in_ext _ _ H1). -assert (In_graph x (merge e g H1 Haff)). -apply HH with (y := y). -apply OptionReg.eq_trans with (y := map_to_coloring (complete_coloring e col) x). -apply OptionReg.eq_sym. -apply complete_coloring_2. -intuition. -assumption. -rewrite In_merge_vertex in H3. intuition. -(* third step *) -intros x y H2. -destruct (Register.eq_dec x (snd_ext e)). -assert (ColorMap.find (snd_ext e) col = None) as Hn. -case_eq (ColorMap.find (snd_ext e) col). -intros r H8. -generalize (HH (snd_ext e) r);intro Helim. -unfold map_to_coloring in Helim. -rewrite H8 in Helim. -generalize (Helim (OptionReg.eq_refl _));clear Helim;intro Helim. -rewrite In_merge_vertex in Helim. destruct Helim. elim H4. auto. -auto. -generalize (complete_coloring_1 col e g H1 Hn);intro H3. -generalize (complete_coloring_2 col e (fst_ext e) (In_graph_edge_diff_ext _ _ H1)). -intro H4. -generalize (OptionReg.eq_trans _ _ _ (OptionReg.eq_sym _ _ H4) (OptionReg.eq_sym _ _ H3)). -clear H3 H4;intro H3. -generalize (compat_complete col e Hcompat);intro Hcompat2. -generalize (Hcompat2 _ _ e0). -intro H4. -generalize (OptionReg.eq_trans _ _ _ H3 (OptionReg.eq_sym _ _ H4)). -clear H3 H4;intro H3. -apply HHH with (x:= fst_ext e). -apply (OptionReg.eq_trans _ _ _ H3 H2). -assert (~Register.eq (snd_ext e) x) by intuition. -generalize (complete_coloring_2 col e x H3). -intro H4. -apply HHH with (x:= x). -apply (OptionReg.eq_trans _ _ _ (OptionReg.eq_sym _ _ H4) H2). -Qed. - -Lemma interf_edge_in_delete_preference : forall x e g H, -interf_edge e -> -In_graph_edge e g -> -In_graph_edge e (delete_preference_edges x g H). - -Proof. -intros x e g HH H H0. -generalize (proj2 (In_graph_interf_edge_in_IE _ _) (conj H H0));intro H1. -rewrite In_delete_preference_edges_edge. -split. assumption. -intro. destruct H2. destruct H2. congruence. -Qed. - -Lemma coloring_delete_preference : forall col x g H palette, -proper_coloring col (delete_preference_edges x g H) palette -> -proper_coloring col g palette. - -Proof. -unfold proper_coloring;unfold proper_coloring_1; -unfold proper_coloring_2;unfold proper_coloring_3. -intros col x g Hdp palette H. -destruct H as [H HH];destruct HH as [HH HHH]. -split. -intros e x' y' H0 H1 H2 H3. -apply H with (e:=e). -assumption. -apply interf_edge_in_delete_preference;assumption. -assumption. -assumption. -split. -intros x' y' H0. rewrite <-(In_delete_preference_edges_vertex x' x g Hdp). -apply (HH x' y');auto. -assumption. -Qed. - -Lemma proper_remove_proper : forall col g x palette, -proper_coloring col (remove_vertex x g) palette -> -compat_col col -> -proper_coloring col g palette. - -Proof. -intros col g x palette H Hcompat. -unfold proper_coloring in *;unfold proper_coloring_1 in *; -unfold proper_coloring_2 in *;unfold proper_coloring_3 in *. -destruct H as [H HH];destruct HH as [HH HHH]. -split. -intros e x' y' H0 H1 H2 H3. -destruct (incident_dec e x). -destruct H4. -generalize (Hcompat _ _ H4);intro H5. -generalize (OptionReg.eq_trans _ _ _ H5 H2);clear H5;intro H5. -generalize (HH _ _ H5). intro. -rewrite In_remove_vertex in H6. destruct H6. elim H7. auto. -generalize (Hcompat _ _ H4);intro H5. -generalize (OptionReg.eq_trans _ _ _ H5 H3);clear H5;intro H5. -generalize (HH _ _ H5). intro. -rewrite In_remove_vertex in H6. destruct H6. elim H7. auto. -apply H with (e:=e); auto. -rewrite In_remove_edge; auto. -split. -intros x' y' H0. -generalize (HH x' y' H0);intro H1. -rewrite In_remove_vertex in H1. intuition. -assumption. -Qed. - -Section Fold_Facts. - -Variable A : Type. - -Lemma fold_left_compat_map : forall (f : ColorMap.t Register.t -> A -> ColorMap.t Register.t) l e e', -ColorMap.Equal e e' -> -(forall e1 e2 a, ColorMap.Equal e1 e2 -> ColorMap.Equal (f e1 a) (f e2 a)) -> -ColorMap.Equal (fold_left f l e) (fold_left f l e'). - -Proof. -intros f l. -induction l;simpl. -auto. -intros e e' H H0 H1. -apply (IHl (f e a) (f e' a)). -apply H0;assumption. -assumption. -Qed. - -End Fold_Facts. - -Lemma empty_coloring_simpl : forall l a, -NoDupA Register.eq (a :: l) -> -ColorMap.Equal (fold_left (fun (a0 : ColorMap.t VertexSet.elt) (e : VertexSet.elt) => - ColorMap.add e e a0) (a :: l) (ColorMap.empty Register.t)) - (ColorMap.add a a ( - fold_left (fun (a0 : ColorMap.t VertexSet.elt) (e : VertexSet.elt) => - ColorMap.add e e a0) l (ColorMap.empty Register.t))). - -Proof. -intro l;generalize (ColorMap.empty Register.t). -induction l;simpl;intros. -unfold ColorMap.Equal;auto. -assert (ColorMap.Equal (ColorMap.add a a (ColorMap.add a0 a0 t0)) - (ColorMap.add a0 a0 (ColorMap.add a a t0))). -unfold ColorMap.Equal. -intro y. -destruct (Register.eq_dec a0 a). -inversion H;subst. -elim H2. -left;auto. -destruct (Register.eq_dec y a). -destruct (Register.eq_dec y a0). -elim (n (Register.eq_trans (Register.eq_sym e0) e)). -rewrite MapFacts.add_eq_o. -rewrite MapFacts.add_neq_o. -rewrite MapFacts.add_eq_o. -reflexivity. -intuition. -intro Hneq;elim n0;auto. -intuition. -rewrite MapFacts.add_neq_o. -destruct (Register.eq_dec a0 y). -rewrite MapFacts.add_eq_o. -rewrite MapFacts.add_eq_o. -reflexivity. -assumption. -assumption. -rewrite MapFacts.add_neq_o. -rewrite MapFacts.add_neq_o. -rewrite MapFacts.add_neq_o. -reflexivity. -intro Hneq;elim n0;auto. -assumption. -assumption. -intro Hneq;elim n0;auto. -rewrite (fold_left_compat_map _ - (fun (a1 : ColorMap.t VertexSet.elt) (e : VertexSet.elt) => ColorMap.add e e a1) l _ _ H0). -simpl in IHl;apply IHl. -constructor. -inversion H;subst. -intro H5;elim H3. -right;auto. -inversion H;subst. -inversion H4;subst;assumption. -intros e1 e2 a1 H1. -unfold ColorMap.Equal;intro y. -destruct (Register.eq_dec a1 y). -rewrite MapFacts.add_eq_o. -rewrite MapFacts.add_eq_o. -reflexivity. -assumption. -assumption. -rewrite MapFacts.add_neq_o. -rewrite MapFacts.add_neq_o. -apply H1. -assumption. -assumption. -Qed. - -Lemma map_to_coloring_ext : forall c1 c2 g palette, -ColorMap.Equal c2 c1 -> -proper_coloring (map_to_coloring c1) g palette -> -proper_coloring (map_to_coloring c2) g palette. - -Proof. -unfold proper_coloring;unfold proper_coloring_1; -unfold proper_coloring_2;unfold proper_coloring_3. -intros c1 c2 g palette H H0. -destruct H0 as [H0 H1];destruct H1 as [H1 H2]. -split. -intros e x y H3 H4 H5 H6. -apply (H0 e);try assumption. -unfold ColorMap.Equal in H. -apply OptionReg.eq_trans with (y := (map_to_coloring c2 (fst_ext e))). -unfold map_to_coloring. -rewrite H. -apply OptionReg.eq_refl. -assumption. -apply OptionReg.eq_trans with (y := (map_to_coloring c2 (snd_ext e))). -unfold map_to_coloring. -rewrite H. -apply OptionReg.eq_refl. -assumption. -split. -intros x y H3. -apply (H1 x y). -apply OptionReg.eq_trans with (y := (map_to_coloring c2 x)). -unfold map_to_coloring. -rewrite H. -apply OptionReg.eq_refl. -assumption. -intros x y H3. -apply (H2 x y). -apply OptionReg.eq_trans with (y := (map_to_coloring c2 x)). -unfold map_to_coloring. -rewrite H. -apply OptionReg.eq_refl. -assumption. -Qed. - -Lemma compat_map_to_coloring : forall c1 c2 x, -ColorMap.Equal c1 c2 -> -OptionReg.eq (map_to_coloring c1 x) (map_to_coloring c2 x). - -Proof. -intros c1 c2 x H;unfold map_to_coloring; -unfold ColorMap.Equal in H. -rewrite H;apply OptionReg.eq_refl. -Qed. - -Lemma proper_coloring_empty_aux : forall g x, -OptionReg.eq (precoloring g x) (Some x) \/ -OptionReg.eq (precoloring g x) None. - -Proof. -intros g x. -unfold precoloring, precoloring_map. -rewrite VertexSet.fold_1. - -assert (NoDupA Register.eq (VertexSet.elements (precolored g))) as HNoDup by - (apply RegFacts.NoDupA_elements). -induction (VertexSet.elements (precolored g)). -simpl. -right;unfold map_to_coloring;rewrite MapFacts.empty_o. -apply OptionReg.eq_refl. -(* induction case *) -generalize (empty_coloring_simpl l a HNoDup);intro H0. -inversion HNoDup;subst. -generalize (IHl H3);clear IHl H2 H3;intro IHl. -destruct IHl. -left. -generalize (compat_map_to_coloring _ _ x H0);clear H0;intro H0. -apply (OptionReg.eq_trans _ _ _ H0). -destruct (Register.eq_dec a x). -unfold map_to_coloring. -rewrite MapFacts.add_eq_o. -constructor;assumption. -assumption. -unfold map_to_coloring. -rewrite MapFacts.add_neq_o. -apply H. -assumption. -destruct (Register.eq_dec a x). -left. -generalize (compat_map_to_coloring _ _ x H0);clear H0;intro H0. -apply (OptionReg.eq_trans _ _ _ H0). -unfold map_to_coloring. -rewrite MapFacts.add_eq_o. -constructor;assumption. -assumption. -right. -generalize (compat_map_to_coloring _ _ x H0);clear H0;intro H0. -apply (OptionReg.eq_trans _ _ _ H0). -unfold map_to_coloring. -rewrite MapFacts.add_neq_o. -apply H. -assumption. -Qed. - -Lemma in_empty_coloring_in_precolored : forall x g y, -OptionReg.eq (precoloring g x)(Some y) -> -VertexSet.In x (precolored g). - -Proof. -intros x g y H. unfold precoloring, precoloring_map in H. -rewrite VertexSet.fold_1 in H. -generalize (VertexSet.elements_2);intro H0. -generalize (H0 (precolored g));clear H0;intro H0. -assert (NoDupA Register.eq (VertexSet.elements (precolored g))) as HNoDup by - (apply RegFacts.NoDupA_elements). -induction (VertexSet.elements (precolored g)). -simpl in H. -unfold map_to_coloring in H;rewrite MapFacts.empty_o in H. -inversion H. -destruct (Register.eq_dec a x). -apply H0. -left; intuition. -apply IHl. -generalize (empty_coloring_simpl l a HNoDup);intro H1. -generalize (compat_map_to_coloring _ _ x H1);clear H1;intro H1. -unfold map_to_coloring in H1. -rewrite MapFacts.add_neq_o in H1. -apply (OptionReg.eq_trans _ _ _ (OptionReg.eq_sym _ _ H1)). -clear H1 IHl. -assumption. -assumption. -intros;apply H0;right;auto. -inversion HNoDup;auto. -Qed. - -Lemma proper_coloring_pre_inv : forall g x, -VertexSet.In x (precolored g) -> -OptionReg.eq (precoloring g x) (Some x). - -Proof. -intros g x H. unfold precoloring, precoloring_map. -rewrite VertexSet.fold_1. -generalize (VertexSet.elements_1);intro H0. -generalize (H0 (precolored g) x);clear H0;intro H0. -assert (NoDupA Register.eq (VertexSet.elements (precolored g))) as HNoDup by - (apply RegFacts.NoDupA_elements). -induction (VertexSet.elements (precolored g)). -generalize (H0 H). intro. inversion H1. -generalize (empty_coloring_simpl l a HNoDup);intro H1. simpl in *. -generalize (compat_map_to_coloring _ _ x H1). intro. -unfold map_to_coloring in H2. -destruct (Register.eq_dec x a). - rewrite MapFacts.add_eq_o in H2. -apply (OptionReg.eq_trans _ _ _ H2). -constructor. apply Register.eq_sym. auto. -apply Register.eq_sym. auto. -rewrite (MapFacts.add_neq_o) in H2. apply (OptionReg.eq_trans _ _ _ H2). -apply IHl. clear H1 H2. -intros. generalize (H0 H1). intro. -inversion H2; subst. elim n. auto. -auto. -inversion HNoDup;auto. -auto. -Qed. - -Lemma proper_coloring_empty : forall g palette, -VertexSet.Subset (precolored g) palette -> -proper_coloring (precoloring g) g palette. - -Proof. -intros g palette H. -unfold proper_coloring;unfold proper_coloring_1; -unfold proper_coloring_2;unfold proper_coloring_3. -split;[|split]. -intros e x y H0 H1 H2 H3 H4. -destruct (proper_coloring_empty_aux g (fst_ext e)); -generalize (OptionReg.eq_trans _ _ _ (OptionReg.eq_sym _ _ H2) H5); -clear H2 H5;intro H2. -destruct (proper_coloring_empty_aux g (snd_ext e)); -generalize (OptionReg.eq_trans _ _ _ (OptionReg.eq_sym _ _ H3) H5); -clear H3 H5;intro H3. -elim (In_graph_edge_diff_ext _ _ H1). -inversion H2;inversion H3;subst. -apply (Register.eq_trans (Register.eq_sym H10) (Register.eq_trans (Register.eq_sym H4) H7)). -inversion H3. -inversion H2. -intros x y H0. -assert (VertexSet.In x (precolored g)). -apply in_empty_coloring_in_precolored with (y := y). assumption. -rewrite precolored_equiv in H1. intuition. -intros x y H0. -apply H. -destruct (proper_coloring_empty_aux g x); -generalize (OptionReg.eq_trans _ _ _ (OptionReg.eq_sym _ _ H1) H0); -intro H2;inversion H2;subst. -rewrite <-H5. -apply in_empty_coloring_in_precolored with (y := x). -assumption. -Qed. - -Lemma proper_coloring_IRC_map : forall gp, -VertexSet.Subset (precolored (irc_g gp)) (pal gp) -> -proper_coloring (map_to_coloring (IRC_map gp)) (irc_g gp) (pal gp). - -Proof. -intros gp Hpre. -functional induction IRC_map gp;simpl in *. - -(* simplify *) -generalize (simplify_inv _ _ e). intro. -generalize (simplify_inv2 _ _ e). intro. destruct H0. simpl in H0. -apply available_coloring_1. -apply proper_remove_proper with (x:=r). -rewrite H0 in *. unfold simplify_irc in *. simpl in *. -apply IHt0. rewrite precolored_remove_vertex. -unfold VertexSet.Subset. intros. apply Hpre. apply (VertexSet.remove_3 H1). - -unfold compat_col. -intros. unfold map_to_coloring. -rewrite (MapFacts.find_o _ H1). apply OptionReg.eq_refl. - -apply (In_simplify_props _ _ _ _ _ _ _ _ (VertexSet.choose_1 H) (refl_equal _) (HWS_irc g)). - -(*coalesce*) -generalize (coalesce_inv _ _ e0). intro. -generalize (coalesce_inv_2 _ _ e0). intro. -destruct H0. destruct H0. simpl in *. - -assert (forall e', EdgeSet.In e' (get_movesWL (irc_wl g)) -> In_graph_edge e' (irc_g g)). -intros. generalize (In_move_props _ _ _ _ _ _ _ _ H1 (refl_equal _) (HWS_irc g)). intuition. - -apply (complete_coloring_coloring _ _ _ x x0). -apply (any_coalescible_edge_2 e1 _ _ (get_movesWL (irc_wl g)) H1 H). -rewrite H0 in *. unfold merge_irc in *. simpl in *. apply IHt0. -rewrite precolored_merge. -unfold VertexSet.Subset. intros. apply Hpre. apply (VertexSet.remove_3 H2). -apply (proj1 (any_coalescible_edge_1 _ _ _ _ H1 H)). - -unfold compat_col. -intros. unfold map_to_coloring. -rewrite (MapFacts.find_o _ H2). apply OptionReg.eq_refl. - -(* freeze *) -generalize (freeze_inv _ _ e1). intro. -generalize (freeze_inv2 _ _ e1). intro. destruct H0. destruct H0. simpl in *. -apply (coloring_delete_preference _ r (irc_g g) x0 _). -rewrite H0 in *. unfold delete_preference_edges_irc2 in *. simpl in *. apply IHt0. -unfold VertexSet.Subset. intros. apply Hpre. -rewrite precolored_delete_preference_edges in H1. assumption. - -(* spill *) -generalize (spill_inv _ _ e2). intro. -generalize (spill_inv2 _ _ e2). intro. destruct H0. simpl in *. -apply available_coloring_1. -apply proper_remove_proper with (x:=r). -rewrite H0 in *. unfold spill_irc in *. simpl in *. apply IHt0. -unfold VertexSet.Subset. intros. apply Hpre. -rewrite precolored_remove_vertex in H1. apply (VertexSet.remove_3 H1). - -unfold compat_col. -intros. unfold map_to_coloring. -rewrite (MapFacts.find_o _ H1). apply OptionReg.eq_refl. - -apply (In_spill_props _ _ _ _ _ _ _ _ (lowest_cost_in _ _ _ H) (refl_equal _) (HWS_irc g)). - -(* terminal case *) -apply proper_coloring_empty. assumption. -Qed. - -Lemma proper_coloring_IRC_aux : forall g palette, -VertexSet.Subset (precolored g) palette -> -proper_coloring (IRC g palette) g palette. - -Proof. -intros. apply proper_coloring_IRC_map. auto. -Qed. - -Lemma proper_coloring_IRC : forall g palette, -proper_coloring (precoloring g) g palette -> -proper_coloring (IRC g palette) g palette. - -Proof. -intros. apply proper_coloring_IRC_map. -intro. intro. unfold proper_coloring, proper_coloring_3 in H. -do 2 destruct H as [_ H]. unfold graph_to_IRC_graph in *. simpl in *. -apply H with (x:= a). apply proper_coloring_pre_inv. assumption. -Qed. \ No newline at end of file -- cgit