Require Import Coq.Reals.Rbase Coq.Reals.RList.
Require Import Coq.Reals.Rfunctions.
Require Import Ranalysis_reg.
Require Import Reals.Integration.
Require Import Rtrigo_def.
Require Import List.
Require Import EquivDec Nat Omega Lra.

Require Import LibUtils ListAdd.
Require Import Relation_Definitions Sorted.

Require Import Isomorphism.

Import ListNotations.

Local Open Scope R.

Lemma INR_nzero {n} :
  (n > 0)%nat -> INR n <> 0.
Proof.
  destruct n.
  - omega.
  - rewrite S_INR.
    generalize (pos_INR n); intros.
    lra.
Qed.

Lemma INR_nzero_eq {n} :
  (~ n = 0)%nat -> INR n <> 0.
Proof.
  destruct n.
  - omega.
  - rewrite S_INR.
    generalize (pos_INR n); intros.
    lra.
Qed.

Lemma INR_zero_lt {n} :
  (n > 0)%nat -> 0 < INR n.
Proof.
  destruct n.
  - omega.
  - rewrite S_INR.
    generalize (pos_INR n); intros.
    lra.
Qed.

Lemma Rinv_pos n :
  0 < n ->
  0 < / n.
Proof.
  intros.
  rewrite <- (Rmult_1_l ( / n)).
  apply Rdiv_lt_0_compat; lra.
Qed.

Lemma pos_Rl_nth (l:list R) n : pos_Rl (iso_b l) n = nth n l 0.
Proof.
  revert n.
  induction l; destruct n; simpl in *; trivial.
Qed.

Lemma Rlength_length (l:list R) : Rlength (iso_b l) = length l.
Proof.
  induction l; simpl in *; trivial.
  rewrite IHl; trivial.
Qed.

Hint Rewrite pos_Rl_nth Rlength_length : R_iso.

Lemma Rlt_le_sub : subrelation Rlt Rle.
Proof.
  repeat red; intuition.
Qed.

Lemma find_bucket_nth_finds_Rle needle l idx d1 d2:
  StronglySorted Rle l ->
  (S idx < length l)%nat ->
  nth idx l d1 < needle ->
  needle <= nth (S idx) l d2 ->
  find_bucket Rle_dec needle l = Some (nth idx l d1, nth (S idx) l d2).
Proof.
  intros.
  apply find_bucket_nth_finds; trivial
  ; repeat red; intros; lra.
Qed.

Lemma find_bucket_bounded_Rle_exists {a b needle} :
  a <= needle <= b ->
  forall l,
    exists lower upper,
      find_bucket Rle_dec needle (a::l++[b]) = Some (lower, upper).
Proof.
  intros.
  apply find_bucket_bounded_le_exists; intros; lra.
Qed.

Lemma telescope_plus_fold_right_sub_seq f s n :
  fold_right Rplus 0 (map (fun x => (f (INR x)) -  (f (INR (x+1)))) (seq s n)) = (f (INR s)) - (f (INR (s+n))).
Proof.
  Opaque INR.
  revert s.
  induction n; simpl; intros s.
  - replace (s+0)%nat with s by omega.
    lra.
  - specialize (IHn (S s)).
    unfold Rminus in *.
    rewrite Rplus_assoc in *.
    f_equal.
    simpl in IHn.
    replace (S (s + n))%nat with (s + (S n))%nat in IHn by omega.
    rewrite IHn.
    replace (s+1)%nat with (S s) by omega.
    lra.
    Transparent INR.
Qed.

Lemma fold_right_Rplus_mult_const {A:Type} (f:A->R) c l :
  fold_right Rplus 0 (map (fun x : A => f x * c) l) =
  (fold_right Rplus 0 (map (fun x : A => f x) l))*c.
Proof.
  induction l; simpl; lra.
Qed.

Lemma bounded_dist_le  x lower upper :
  lower <= x <= upper ->
  R_dist x upper <= R_dist lower upper.
Proof.
  intros.
  rewrite (R_dist_sym x).
  rewrite (R_dist_sym lower).
  unfold R_dist.
  repeat rewrite Rabs_pos_eq by lra.
  lra.
Qed.

Lemma bounded_dist_le_P2  x lower upper :
  lower <= x <= upper ->
  R_dist x lower <= R_dist upper lower.
Proof.
  intros.
  unfold R_dist.
  repeat rewrite Rabs_pos_eq by lra.
  lra.
Qed.

Definition interval_increasing f (a b:R) : Prop :=
  forall x y :R, a <= x -> y <= b -> x<=y -> f x <= f y.

Definition interval_decreasing f (a b:R) : Prop :=
  forall x y :R, a <= x -> y <= b -> x<=y -> f y <= f x.

Lemma bounded_increasing_dist_le (f : R -> R) x lower upper :
  interval_increasing f lower upper ->
  lower <= x <= upper ->
  R_dist (f x) (f upper) <= R_dist (f lower) (f upper).
Proof.
  intros df xin.
  apply bounded_dist_le.
  destruct xin as [ltx gtx].
  red in df.
  split; apply df; trivial.
  apply Rle_refl.
  apply Rle_refl.
Qed.

Lemma bounded_decreasing_dist_le (f : R -> R) x lower upper :
  interval_decreasing f lower upper ->
  lower <= x <= upper ->
  R_dist (f x) (f upper) <= R_dist (f lower) (f upper).
Proof.
  intros df xin.
  apply bounded_dist_le_P2.
  destruct xin as [ltx gtx].
  red in df.
  split; apply df; trivial.
  apply Rle_refl.
  apply Rle_refl.
Qed.

Lemma subinterval_increasing (f : R -> R) (a b x y : R) :
  a <= x -> x <= y -> y <= b -> interval_increasing f a b -> interval_increasing f x y.
Proof.
  intros.
  red in H2.
  red.
  intros.
  cut (y0 <= b).
  cut (a <= x0).
  intuition.
  lra.
  lra.
Qed.

Lemma subinterval_decreasing (f : R -> R) (a b x y : R) :
  a <= x -> x <= y -> y <= b -> interval_decreasing f a b -> interval_decreasing f x y.
Proof.
  intros.
  red in H2.
  red.
  intros.
  cut (y0 <= b).
  cut (a <= x0).
  intuition.
  lra.
  lra.
Qed.

Lemma increasing_decreasing_opp (f : R -> R) (a b:R) :
  a <= b -> interval_increasing f a b -> interval_decreasing (fun x => -f x) a b.
Proof.
  unfold interval_increasing.
  unfold interval_decreasing.
  intros.
  apply Ropp_le_contravar.
  apply H0.
  trivial.
  trivial.
  trivial.
Qed.

Fixpoint Int_SF' (l k : list R) {struct l} : R :=
  match l with
  | nil => 0
  | a::l' =>
    match k with
    | nil => 0
    | x::nil => 0
    | x::y::k' => a * (y - x) + Int_SF' l' (y:: k')
    end
  end.

Lemma Int_SF'_eq l k : Int_SF (iso_b l) (iso_b k) = Int_SF' l k.
Proof.
  revert k.
  induction l; simpl; trivial.
  destruct k; simpl; trivial.
  destruct k; simpl; trivial.
  rewrite <- IHl.
  trivial.
Qed.

Definition Int_SF'_alt l k
  := fold_right Rplus 0
                (map (fun '(x,y) => x * y)
                     (combine l
                              (map (fun '(x,y) => y - x) (adjacent_pairs k)))).

Lemma Int_SF'_alt_eq l k :
  Int_SF' l k = Int_SF'_alt l k.
Proof.
  unfold Int_SF'_alt.
  revert k.
  induction l; simpl; trivial.
  destruct k; simpl; trivial.
  destruct k; simpl; trivial.
  rewrite IHl; trivial.
Qed.

Lemma up_IZR n : up (IZR n) = (Z.succ n)%Z.
Proof.
  symmetry.
  apply tech_up; try rewrite succ_IZR; lra.
Qed.

Lemma up0 : up 0 = 1%Z.
Proof.
  apply up_IZR.
Qed.

Lemma up_pos (r:R) :
  r>0 -> ((up r) > 0)%Z.
Proof.
  intros.
  destruct (archimed r) as [lb ub].
  assert (IZR (up r) > 0) by lra.
  apply lt_IZR in H0.
  omega.
Qed.

Lemma up_nonneg (r:R) :
  r>=0 -> ((up r) >= 0)%Z.
Proof.
  inversion 1.
  - unfold Z.ge; rewrite up_pos; congruence.
  - subst. rewrite up0.
    omega.
Qed.

Lemma INR_up_pos r :
  r >= 0 -> INR (Z.to_nat (up r)) = IZR (up r).
Proof.
  intros.
  rewrite INR_IZR_INZ.
  rewrite Z2Nat.id; trivial.
  generalize (up_nonneg _ H).
  omega.
Qed.

Lemma frac_max_frac_le (x y:R) :
  1 <= x ->
  x <= y ->
  x / (x + 1) <= y / (y + 1).
Proof.
  intros.
  assert (1 <= x) by lra.
  cut (x * (y + 1) <= y * (x + 1)).
  - intros HH.
    apply (Rmult_le_compat_r (/ (x+1))) in HH.
    + rewrite Rinv_r_simpl_l in HH by lra.
      apply (Rmult_le_compat_r (/ (y+1))) in HH.
      * eapply Rle_trans; try eassumption.
        unfold Rdiv.
        repeat rewrite Rmult_assoc.
        apply Rmult_le_compat_l; [lra | ].
        rewrite <- Rmult_assoc.
        rewrite Rinv_r_simpl_m by lra.
        right; trivial.
      * left; apply Rinv_0_lt_compat; lra.
    + left; apply Rinv_0_lt_compat; lra.
  - lra.
Qed.


From Coq Require Import Arith List Lia Vector.
From Equations Require Import Equations.

Notation vector := t.
Notation nvector := (t nat).

Arguments Vector.nil {A}.
Arguments Vector.cons {A} _ {n}.

Declare Scope vect_scope.
Notation " x |:| y " := (@Vector.cons _ x _ y) (at level 20, right associativity) : vect_scope.
Notation " x |: n :| y " := (@Vector.cons _ x n y) (at level 20, right associativity) : vect_scope.
Notation "[]v" := Vector.nil (at level 0) : vect_scope.
Local Open Scope vect_scope.

Import Sigma_Notations.

Inductive Sorted : forall {n}, nvector n -> Prop :=
| Sorted_nil : Sorted nil
| Sorted_cons {x n} {xs : nvector n} : Forall (le x) xs -> Sorted xs -> Sorted (x |:| xs).

Lemma sorted_test : Sorted (1 |:| 2 |:| 3 |:| []v).
Proof.
repeat (constructor + lia).
Qed.

Section MergeSort.
Set Program Mode.

(* TODO: make type simpler i.e. nvector (n+m)
   This actually makes proofs more difficult as we can't separate the vector and the length (including proof of equality of output length and required length)
*)
Equations? merge {n m} (v1 : nvector n) (v2 : nvector m) :
  (Σ (k : nat), { v : nvector k | k = n + m }) by wf (n + m) lt :=
    merge []v xs := (_,xs) ;
    merge xs []v := (_,xs) ;
    merge (x |:| xs) (y |:| ys) with (x <=? y) :=
      { | true => (_,x |:| (merge xs (y |:| ys)).2) ;
        | false => (_,y |:| (merge (x |:| xs) ys).2) }.
Proof.
- apply eq_S.
  destruct merge. destruct pr2.
  simpl. exact e.
- lia.
- simpl. apply eq_S.
  destruct merge. destruct pr2.
  simpl. rewrite <- Nat.add_succ_comm. exact e.
Defined.

(*
Global Transparent merge.

Compute ((merge (1 |:| 4 |:| 7 |:| []v) (4 |:| 2 |:| 6 |:| []v)).2).

Compute (splitat (Nat.div2 5) (1 |:| 2 |:| 3 |:| 4 |:| 5 |:| []v)).
*)

Lemma sorted_le_hd {n} (h : nat) (v : nvector n) :
  Sorted(h |:| v) -> Forall (le h) v.
Proof.
revert h. revert dependent n. induction v.
- intros. constructor.
- intros. constructor.
  + inversion H. dependent rewrite H2 in H3. inversion H3. exact H8.
  + inversion H. dependent rewrite H2 in H3.
    inversion H3. dependent rewrite H7 in H9. exact H9.
Qed.

Lemma le_hd_sorted {n} (h h' : nat) (v : nvector n) :
  h <= h' -> Sorted (h' |:| v) -> Forall (le h) (h' |:| v).
Proof.
revert h h'. revert dependent n. induction v.
- intros. constructor. exact H. constructor.
- intros. constructor.
  + exact H.
  + apply IHv.
    * inversion H0. dependent rewrite H3 in H4. inversion H4. lia.
    * inversion H0. dependent rewrite H3 in H5. exact H5.
Qed.

Lemma in_merge {n m} (x : nat) (vn : nvector n) (vm : nvector m) :
  In x (proj1_sig (merge vn vm).2) -> In x vn \/ In x vm.
Proof.
revert dependent m. revert dependent n. induction vn.
- intros. simp merge in H. right. exact H.
- intros. revert dependent m. induction vm.
  + simp merge. intros. left. exact H.
  + intros. simp merge in H. destruct (h <=? h0).
    * simpl in *. inversion H.
      -- left. constructor.
      -- dependent rewrite H3 in H2.
         assert (In x vn \/ In x (h0 |:| vm)).
         { apply IHvn. exact H2. }
         elim H4.
         ++ intros. left. constructor. exact H5.
         ++ intros. right. exact H5.
    * simpl in *. inversion H.
      -- right. constructor.
      -- dependent rewrite H3 in H2.
         assert (In x (h |:| vn) \/ In x vm).
         { apply IHvm. exact H2. }
         elim H4.
         ++ intros. left. exact H5.
         ++ intros. right. constructor. exact H5.
Qed.

Lemma le_merge {n m} (h : nat) (vn : nvector n) (vm : nvector m) :
  Forall (le h) vn -> Forall (le h) vm ->
    Forall (le h) (proj1_sig (merge vn vm).2).
Proof.
intros. apply Forall_forall.
intros. assert (In a vn \/ In a vm).
{ apply in_merge. exact H1. }
elim H2.
- intros. apply (Forall_forall nat (le h) n vn). exact H. exact H3.
- intros. apply (Forall_forall nat (le h) m vm). exact H0. exact H3.
Qed.

Lemma merge_sorted {n m} (v1 : nvector n) (v2 : nvector m) :
  Sorted v1 -> Sorted v2 -> Sorted (merge v1 v2).2.
Proof.
revert dependent m. revert dependent n. induction v1.
- intros. simpl. exact H0.
- induction v2.
  + intros. simp merge.
  + intros. simp merge. destruct (h <=? h0) eqn:E.
    * simpl. constructor.
      -- apply le_merge. apply sorted_le_hd. exact H.
         apply le_hd_sorted.
         ++ apply leb_complete. exact E.
         ++ exact H0.
      -- apply IHv1. inversion H.
         dependent rewrite H3 in H5. exact H5.
         exact H0.
    * simpl. constructor.
      -- apply (le_merge h0 (h |:| v1) v2). apply le_hd_sorted.
         rewrite leb_iff_conv in E. lia.
         exact H.
         apply sorted_le_hd. exact H0.
      -- apply IHv2. exact H. inversion H0.
         dependent rewrite H3 in H5. exact H5.
Qed.

Equations? splitinhalf' {n} (v : nvector n) :
  Σ (k1 : nat) (k2 : nat),
    { v' : nvector k1 * nvector k2 | k1 = Nat.div2 n /\ k2 = n - (Nat.div2 n) /\ forall x : nat, In x v <-> In x (fst v') \/ In x (snd v')  }:=
    splitinhalf' xs := (_,_,splitat (Nat.div2 n) xs).
Proof.
- exact (n - Nat.div2 n).
- apply le_plus_minus. induction n.
  + simpl. lia.
  + assert (Nat.div2 (S n) <= n) by (apply Nat.le_div2). lia.
- simpl. split.
  + reflexivity.
  + split.
    * reflexivity.
    * intros. split.
      -- revert x. induction xs.
         ++ intros. exfalso. inversion H.
         ++ intros. inversion H.
            ** destruct n.
Abort.
(* Horrible due to proof terms in last obligation *)

Equations? mergesort {n} (v : nvector n) : nvector n by wf n lt :=
  mergesort nil := nil ;
  mergesort (cons x nil) := cons x nil ;
  mergesort xs := (merge (mergesort (fst (splitat (Nat.div2 n) xs))) (mergesort (snd (splitat (Nat.div2 n) xs)))).2.
Proof.
- exact (S(S n) - (Nat.div2 n)).
- apply le_plus_minus. apply Nat.div2_decr. lia.
- Search (_ < _ -> _ < S _). destruct n.
  + simpl. lia.
  + apply Nat.lt_lt_succ_r. apply Nat.lt_lt_succ_r.
    apply Nat.lt_div2. lia.
-
 Abort.
(* not true, we need more information from the splitat function *)

Print splitat.

(* TODO: split v' = v1, v2 and prove app v1 v2 = v *)
Equations? splitinhalf {n} (v : nvector n) :
  Σ (k1 : nat) (k2 : nat),
    { v' : nvector k1 * nvector k2 |
      k1 = Nat.div2 n /\ k2 = n - (Nat.div2 n) } :=
    splitinhalf xs := (_,_,splitat (Nat.div2 n) xs).
Proof.
apply le_plus_minus. apply Nat.div2_decr. lia.
Defined.

Equations? mergesort {n} (v : nvector n) :
  (Σ n : nat, nvector n) by wf n lt :=
  mergesort nil := (_,nil) ;
  mergesort (cons x nil) := (_,cons x nil) ;
  mergesort xs := (_,(merge (mergesort (fst (splitinhalf xs).2.2)).2 (mergesort (snd (splitinhalf xs).2.2)).2).2).
Proof.
- subst xs. destruct splitinhalf. destruct pr2. destruct pr2. simpl. destruct a. rewrite H. apply Nat.lt_div2. lia.
- subst xs. destruct splitinhalf. simpl. destruct pr2. destruct pr2. simpl. destruct a. rewrite H0. Search (_ - _ < _). apply Nat.sub_lt.
  assert (Nat.div2 (S (S n)) < S (S n)).
  { apply Nat.lt_div2. lia. }
  lia. induction n.
  + simpl. lia.
  + simpl. destruct n. lia. lia.
Defined.

(** Issues with pattern-matching using with *)
(*
Equations? mergesortw {n} (v : nvector n) : nvector n by wf n lt :=
  mergesortw nil := nil ;
  mergesortw (cons x nil) := cons x nil ;
  mergesortw xs := let (f,s) := (splitinhalf xs).2.2 in (merge (mergesortw (fst f)) (mergesortw (snd f))).2.
*)

Lemma ms_sorted {n} (v : nvector n) : Sorted (mergesort v).2.
Proof.
funelim (mergesort v).
- constructor.
- simp mergesort. constructor. constructor. constructor.
- simp mergesort. apply merge_sorted. exact H. exact H0.
Qed.


(***************************************************************************)
(*   This is part of FA_3rdCalculus, it is distributed under the terms     *)
(*         of the GNU Lesser General Public License version 3              *)
(*                (see file LICENSE for more details)                      *)
(*                                                                         *)
(*            Copyright 2020-2022: Yaoshun Fu and Wensheng Yu.             *)
(***************************************************************************)

Require Import StD calTh.

(* Higher order strong derivative *)
Fixpoint N_str_derivative F f a b n :=
  match n with
  | 1 => str_derivative F f a b
  | p` => ∃ f1, str_derivative F f1 a b /\ N_str_derivative f1 f a b p
  end.

Definition N_str_derivability F a b n := ∃ f, N_str_derivative F f a b n.

Fact Nstd_imply_der : ∀ {F f a b n}, a < b -> N_str_derivative F f a b n ->
  N_uni_derivative F f a b n.
Proof.
  intros. generalize dependent F. induction n; intros.
  - apply std_imply_der; auto.
  - destruct H0 as [f1 [H0]]. apply (std_imply_der H) in H0. exists f1; auto.
Qed.

Fact Nstdpred : ∀ {F a b n},
  N_str_derivability F a b n` -> N_str_derivability F a b n.
Proof.
  intros. generalize dependent F. induction n; intros.
  - destruct H as [f [f1 [H]]]. red; eauto.
  - destruct H as [f [f1 [H]]], (IHn f1) as [f2]; [red; eauto|].
    exists f2. red; eauto.
Qed.

Definition N_th {F a b n} (H :N_str_derivability F a b n) :=
  Getele H.

Definition P_th {F a b n} (H :N_str_derivability F a b n`) :=
  Getele (Nstdpred H).

Ltac Ndg f := unfold N_th, Getele; destruct (cid) as [f ]; simpl proj1_sig.
Ltac Pdg f := unfold P_th, Getele; destruct (cid) as [f ]; simpl proj1_sig.

(* Main term of Taylor formula for higher order strong derivative *)
Fixpoint TFmain_std F a b c n
  :N_str_derivability F a b n -> Rfun := match n with
  | 1 => λ _ _, F c
  | p` => λ l x, (P_th l c)·(Rdifa ((x-c)^p) p) +
  TFmain_std F a b c p (Nstdpred l) x end.

(* The uniqueness of main term of Taylor formula *)
Fact TF_eq : ∀ {F a b n} l1 l2, ∀ {c x}, c ∈ [a|b] ->
  TFmain_std F a b c n l1 x = TaylorFormula_main F a b c n l2 x.
Proof.
  intros. pose proof (Nder_lt l2). revert l1 l2. induction n; intros; auto.
  pose proof (IHn (Nstdpred l1) (Nderpred l2)). simpl; f_equal; auto.
  Pdg f1. pdg1 f2. apply Nstd_imply_der in n0; auto.
  rewrite (uniNder n0 n1); auto.
Qed.

(* Taylor theorem for higher order strong derivative *)
Theorem TTstd : ∀ {F a b n l},
  ∀ M, (∀ x, x ∈ [a|b] -> |(N_th l) x|≦M) ->
  ∀ c x, c ∈ [a|b] -> x ∈ [a|b] ->
  |F(x)-(TFmain_std F a b c n l x)|≦ M·(Rdifa (|x-c|^n) n).
Proof.
  intros. pose proof (ccil H0). destruct H2, H2 as [_ [H2| H2]].
  - assert (l1:N_uni_derivability F a b n).
    { inversion l as [f]. exists f. apply Nstd_imply_der; auto. }
    assert (∀ x,x ∈ [a|b] -> |n_th l1 x| ≦ M).
    { intros. eapply Theorem173; eauto. right. f_equal. ndg1 f1. Ndg f2.
      apply Nstd_imply_der in n1; auto. eapply uniNder; eauto. }
    rewrite (TF_eq _ l1); auto. exact (TaylorThoerem _ H3 _ _ H0 H1).
  - subst a. destruct H0, H0, H1, H1. LEGER H0 H2. LEGER H1 H3. subst b c.
    assert (∀ F a b c n l, F c = TFmain_std F a b c n l c).
    { intros. induction n0; simpl; auto. rewrite (IHn0 (Nstdpred l0)).
      Simpl_R. rewrite powO; unfold Rdifa; Simpl_R. }
    rewrite <- H4; Simpl_R. rewrite powO. right; unfold Rdifa; Simpl_R.
Qed.


Require Import Program Arith.

Program Fixpoint check_n  (n : nat) (P : { i | i < n } -> bool) (p : nat)
  (H : forall (i : { i | i < n }), i < p -> P i = true)
  {measure (n - p)} :
  Exc (forall (p : { i | i < n}), P p = true) :=
  match le_lt_dec n p with
  | left _ => value _
  | right cmp =>
      if dec (P p) then
        check_n n P (S p) _
      else
        error
  end.

Require Import Omega.

Solve Obligations with program_simpl ; auto with *; try omega.

Next Obligation.
  apply H. simpl. omega.
Defined.

Next Obligation.
  case (le_lt_dec p i) ; intros. assert(i = p) by omega. subst.
  revert H0. clear_subset_proofs. auto.
  apply H. simpl. assumption. Defined.


Require Export FormalMath.lib.Coqlib.
Require Import FormalMath.Category.Category.
Require Import FormalMath.Category.CategoryExamples.
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Logic.Eqdep.

(** Chapter 1.4.6: All categories as a category *)
Record CatObj: Type := {
    obj:> Type;
    cat_arrows: Arrows obj;
    cat_equiv: forall a b: obj, Equiv (a ~> b);
    cat_catid: CatId obj;
    cat_catcomp: CatComp obj;
    cat_category: Category obj
  }.

Arguments Build_CatObj _ {_ _ _ _ _}.
#[local] Existing Instance cat_arrows.
#[local] Hint Extern 0 (Equiv (_ ~> _)) => eapply @cat_equiv : typeclass_instances.
#[local] Existing Instance cat_catid.
#[local] Existing Instance cat_catcomp.
#[local] Existing Instance cat_category.

Record CatArrow (a b: CatObj): Type := {
    cat_map :> obj a -> obj b;
    cat_Fmap: Fmap cat_map;
    cat_Functor: Functor cat_map _
  }.

Arguments Build_CatArrow {_ _} _ {_ _}.
Arguments cat_map {_ _} _ _.
Arguments cat_Fmap {_ _}.
#[local] Existing Instance cat_Fmap.
#[local] Existing Instance cat_Functor.

#[local] Instance CatArrows: Arrows CatObj := CatArrow.

#[local] Instance catEquiv: forall a b: CatObj, Equiv (a ~> b) :=
  fun a b F1 F2 => sigT_relation (@fmapEquiv (obj a) (cat_arrows a)
                                             (obj b) (cat_arrows b) (cat_equiv b))
                                 (existT _ (cat_map F1) (cat_Fmap F1))
                                 (existT _ (cat_map F2) (cat_Fmap F2)).

#[local] Instance catCatId: CatId CatObj := fun x => @Build_CatArrow x x id _ _.

#[local] Instance catCatComp: CatComp CatObj :=
  fun x y z f g => @Build_CatArrow x z (compose f g) _ _.

#[local] Instance catCategory: Category CatObj.
Proof.
  constructor; intros.
  - constructor; repeat intro; unfold equiv, catEquiv in *.
    + now constructor.
    + apply sigT_relation_symmetric; auto. apply _.
    + eapply sigT_relation_transitive; eauto. apply _.
  - repeat intro. unfold comp, catCatComp. apply path_sigT_relation in H.
    destruct H, x, y. simpl in *. subst. simpl in *. apply path_sigT_relation in H0.
    destruct H0, x0, y0. simpl in *. subst. simpl in *.
    constructor. simpl. unfold fmapEquiv in *. intros.
    unfold compFmap, fmap, compose. rewrite f0. apply f.
  - unfold comp, catCatComp. constructor. simpl. unfold fmapEquiv. now intros.
  - unfold comp, catCatComp. constructor. simpl. unfold fmapEquiv. now intros.
  - unfold comp, catCatComp. constructor. simpl. unfold fmapEquiv. now intros.
Qed.

(** * Chapter 1.9 Exercises 5 Question 2 *)
Definition sliceToArrowObj {M: Type} {AM: Arrows M} (o: M) (so: sliceObj o): arrowObj.
Proof.
  destruct so. exists (x, o). exact a.
Defined.

Section SLICE_TO_ARROW_FUNCTOR.

  Context `{Category C}.
  Context {o: C}.

  Instance sliceToArrowFmap : @Fmap (sliceObj o) (sliceArrows o)
                                    arrowObj arrowArrows (sliceToArrowObj o).
  Proof.
    repeat intro. destruct v as [v fv]. destruct w as [w fw].
    destruct X as [fvw ?H]. cbn. exists (fvw, cat_id). simpl. rewrite H1.
    apply left_identity.
  Defined.

  Instance sliceToArrowFunc:
    @Functor (sliceObj o) (sliceArrows o) (sliceCatEq o) (sliceCatId o)
             (sliceCatComp o) arrowObj arrowArrows arrowCatEq arrowCatId arrowCatComp
             (sliceToArrowObj o) _.
  Proof.
    pose proof (sliceCategory o). pose proof arrowCategory.
    constructor; try apply _; intros; unfold sliceToArrowObj.
    - constructor; try apply _. repeat intro.
      destruct a as [a aa]. destruct b as [b ab]. cbn in x, y.
      destruct x as [fx ?H]. destruct y as [fy ?H]. cbn in H3. cbn. now split.
    - destruct a as [a aa]. cbn. now split.
    - destruct x as [x ax]. destruct y as [y ay]. destruct z as [z az].
      cbn in f, g. destruct f as [fxy ?H]. destruct g as [fyz ?H]. cbn. split; auto.
      symmetry. apply left_identity.
  Qed.

  Definition sliceCatObj: CatObj :=
    @Build_CatObj (sliceObj o) (sliceArrows o) (sliceCatEq o) (sliceCatId o)
                  (sliceCatComp o) (sliceCategory o).

  Definition arrowCatObj: CatObj :=
    @Build_CatObj arrowObj arrowArrows arrowCatEq arrowCatId
                  arrowCatComp arrowCategory.

  Definition sliceToArrowCatArrow: sliceCatObj ~> arrowCatObj :=
    Build_CatArrow _.

  Definition cCatObj: CatObj := Build_CatObj C.

  Definition domCatArrow: arrowCatObj ~> cCatObj :=
    @Build_CatArrow arrowCatObj cCatObj _ domFmap domFunctor.

  Definition sliceForgetCatArrow: sliceCatObj ~> cCatObj :=
    @Build_CatArrow sliceCatObj cCatObj _ (sliceForgetFmap o) (sliceForgetFunctor o).

  Lemma dom_F_U: domCatArrow >>> sliceToArrowCatArrow = sliceForgetCatArrow.
  Proof.
    unfold domCatArrow, sliceToArrowCatArrow, sliceForgetCatArrow.
    unfold comp, catCatComp, sliceCatObj, arrowCatObj, cCatObj, compose. cbn.
    unfold equiv, catEquiv. cbn. apply path_sigT_relation. simpl.
    assert ((fun x : sliceObj o => fst (projT1 (sliceToArrowObj o x))) ==
              projT1 (P:=fun dom : C => dom ~> o)). {
      extensionality x. destruct x as [x ar]. now simpl. } exists H1.
    unfold eq_rect. unfold fmapEquiv. intros.
    destruct v as [v fv]. destruct w as [w fw]. destruct ar as [ar ?H]. simpl.
  Abort.

End SLICE_TO_ARROW_FUNCTOR.

(** Example 2.11.2 *)
Section INITIAL_TERMINAL.

  Definition emptyCatObj : CatObj :=
    @Build_CatObj Empty_set emptyArrows emptyEq emptyCatId emptyCatComp emptyCategory.

  Definition toAny (c: CatObj) (s: obj emptyCatObj) : obj c.
  Proof. destruct s. Defined.

  Definition toAnyFmap (c: CatObj): Fmap (toAny c).
  Proof. repeat intro. destruct v. Defined.

  Instance emptyCatInitArrow : InitialArrow emptyCatObj.
  Proof.
    repeat intro. exists (toAny c) (toAnyFmap c). constructor; try apply _.
    - intros. destruct a.
    - intros. destruct a.
    - intros. destruct x.
  Defined.

  Instance emptyCatInitial: Initial emptyCatObj.
  Proof.
    repeat intro. repeat red. unfold initial_arrow.
    unfold emptyCatInitArrow. simpl. apply path_sigT_relation. simpl.
    assert (cat_map f' == toAny c). { extensionality x. destruct x. } exists H.
    red. intros. destruct v.
  Qed.

  Definition unitCatObj : CatObj :=
    @Build_CatObj unit unitArrows unitEq unitCatId unitCatComp unitCategory.

  Definition fromAny (c: CatObj) (x: obj c): obj unitCatObj := tt.

  Definition fromAnyFmap (c: CatObj): Fmap (fromAny c) := fun _ _ _ => tt.

  Instance unitCatTermArrow: TerminalArrow unitCatObj.
  Proof.
    repeat intro. exists (fromAny c) (fromAnyFmap c). constructor; try apply _.
    - intros. constructor; try apply _. repeat intro. reflexivity.
    - intros. reflexivity.
    - intros. reflexivity.
  Defined.

  Instance unitTerminal: Terminal unitCatObj.
  Proof.
    repeat intro. repeat red. unfold terminal_arrow. unfold unitCatTermArrow. simpl.
    apply path_sigT_relation. simpl.
    assert (cat_map f' == fromAny c). {
      extensionality x. destruct (f' x). destruct (fromAny c x). easy. }
    exists H. unfold fmapEquiv. intros. unfold fromAnyFmap.
    destruct (@eq_rect (c -> unit) f' (@Fmap _ _ _ unitArrows)
                       (cat_Fmap f') (fromAny c) H v w ar). easy.
  Qed.

End INITIAL_TERMINAL.


Inductive tm :=
  | true
  | false
  | ITE : tm -> tm -> tm -> tm
  | O
  | S : tm -> tm
  | P : tm -> tm
  | IZ : tm -> tm.

Notation "'if' c 'then' u 'else' v" :=
  (ITE c u v)
  (at level 200).

Inductive nval : tm -> Prop :=
  | zeroisnval : nval O
  | succisnval : forall n, nval n -> nval (S n).
Inductive val : tm -> Prop :=
  | tisval : val true
  | fisval : val false
  | nvsareval : forall n, nval n -> val n.

Inductive step : tm -> tm -> Prop :=
  | eiftrue : forall t2 t3,
      step (if true then t2 else t3) t2
  | eiffalse : forall t2 t3,
      step (if false then t2 else t3) t3
  | eif : forall t t' t2 t3
        (IH: step t t'),
      step (if t then t2 else t3) (if t' then t2 else t3)
  | esucc : forall t t'
        (IH: step t t'),
      step (S t) (S t')
  | epredzero :
      step (P O) O
  | epredsucc : forall n
        (IH: nval n),
      step (P (S n)) n
  | epred : forall t t'
        (IH: step t t'),
      step (P t) (P t')
  | eiszerozero :
      step (IZ O) true
  | eiszerosucc : forall n
        (IH: nval n),
      step (IZ (S n)) false
  | eiszero : forall t t'
        (IH: step t t'),
      step (IZ t) (IZ t')
  .

Notation "a --> b" := (step a b) (at level 5).

Inductive stepstar : tm -> tm -> Prop :=
  | zerosteps : forall t, stepstar t t
  | oneormoresteps : forall t1 t2 t3,
      step t1 t2 -> stepstar t2 t3 -> stepstar t1 t3.
Notation "a -->* b" := (stepstar a b) (at level 5).

Inductive leap : tm -> tm -> Prop := (* for big step, ha ha. *)
  | bvalue : forall v, val v -> leap v v
  | biftrue : forall t1 t2 t3 v2
        (IH1: leap t1 true)
        (IH2: leap t2 v2),
      leap (if t1 then t2 else t3) v2
  | biffalse : forall t1 t2 t3 v3
        (IH1: leap t1 false)
        (IH2: leap t3 v3),
      leap (if t1 then t2 else t3) v3
  | bsucc : forall t v
        (IH1: nval v)
        (IH2: leap t v),
      leap (S t) (S v)
  | bpredzero : forall t
        (IH: leap t O),
      leap (P t) O
  | bpredsucc : forall t v
        (IH1: nval v)
        (IH2: leap t (S v)),
      leap (P t) v
  | biszerozero : forall t
        (IH: leap t O),
      leap (IZ t) true
  | biszerosucc : forall t v
        (IH1: nval v)
        (IH2: leap t (S v)),
      leap (IZ t) false
  .

Notation "a || b" := (leap a b).

Definition normal_form t := forall t', ~ t --> t'.

Definition stuck t := normal_form t /\ ~ val t.


Theorem t1_1 : forall P : Prop, P -> ~~P.
Proof.
  intro P.
  intro h.
  unfold not.
  intro i.
  apply i.
  apply h.
Qed.

Theorem t1_2 : forall P : Prop, ~~P -> P.
Proof.
  intro P.
  unfold not.
  intro h.
Abort.

Definition lem : Prop :=
forall P : Prop, P \/ ~P.

Theorem t1_2_fei : lem -> forall P : Prop, ~~P -> P.
Proof.
  intro L.
  intro P.
  unfold not.
  intro h.
  destruct (L P) as [p1 | p2].
  apply p1.
  unfold not in p2.
  contradiction.
Qed.

Theorem t2_1 : forall P : Prop, ~~ (P \/ ~P).
Proof.
  intro P.
  unfold not.
  intro h.
  apply h.
  right.
  intro i.
  apply h.
  left.
  apply i.
Qed.

Theorem t3_1 : forall P Q : Prop, ((P -> Q) -> P) -> P.
Proof.
  intro P.
  intro Q.
  intro h.
  apply h.
  intro i.
Abort.

Theorem t3_1_fei : lem -> forall P Q : Prop, ((P -> Q) -> P) -> P.
Proof.
  intro L.
  intro P.
  intro Q.
  intro h.
  destruct (L P) as [p1 | p2].
  apply p1.
  apply h.
  intro i.
  contradiction.
Qed.

Theorem t3_2 : forall P Q : Prop, ((P -> Q) -> P) -> ~~P.
Proof.
  intro P.
  intro Q.
  intro h.
  unfold not.
  intro i.
  apply i.
  apply h.
  intro j.
  contradiction.
Qed.

Theorem t4_1_fei : forall P Q : Prop, (P -> Q) -> (~P \/ Q).
Proof.
  intro P.
  intro Q.
  intro h.
  unfold not.
  left.
  intro i.
Abort.

Theorem t4_1_fei : lem -> forall P Q : Prop, (P -> Q) -> (~P \/ Q).
Proof.
  intro L.
  intro P.
  intro Q.
  intro h.
  unfold not.
  destruct (L P) as [p1 | p2].
  right.
  apply h.
  apply p1.
  left.
  intro i.
  unfold not in p2.
  contradiction.
Qed.

Theorem t4_2 : forall P Q : Prop, (~P \/ Q) -> (P -> Q).
Proof.
  intro P.
  intro Q.
  unfold not.
  intro h.
  intro i.
  destruct h as [h1 | h2].
  contradiction.
  apply h2.
Qed.

Theorem t4_3 : forall P Q : Prop, (P \/ Q) -> (~P -> Q).
Proof.
  intro P.
  intro Q.
  unfold not.
  intro h.
  intro i.
  destruct h as [h1 | h2].
  contradiction.
  apply h2.
Qed.

Theorem t4_4 : forall P Q : Prop, (~P -> Q) -> (P \/ Q).
Proof.
  intro P.
  intro Q.
  unfold not.
  intro h.
  right.
  apply h.
  intro i.
Abort.

Theorem t4_4_fei : lem -> forall P Q : Prop, (~P -> Q) -> (P \/ Q).
Proof.
  intro L.
  intro P.
  intro Q.
  unfold not.
  intro h.
  destruct (L P) as [p1 | p2].
  left.
  apply p1.
  right.
  apply h.
  intro i.
  unfold not in p2.
  contradiction.
Qed.

Theorem t5_1 : forall P Q : Prop, P \/ Q -> ~(~P /\ ~Q).
Proof.
  intro P.
  intro Q.
  intro h.
  unfold not.
  intro i.
  destruct i as [i1 i2].
  destruct h as [h1 | h2].
  apply i1.
  apply h1.
  apply i2.
  apply h2. (*** GG \in \nat ... tendeu? :p ***)
Qed.

Theorem t5_2 : forall P Q : Prop, ~(~P /\ ~Q) -> P \/ Q.
Proof.
  intro P.
  intro Q.
  unfold not.
  intro h.
  left.
  destruct h.
  split.
  intro i.
Abort.

Theorem t5_2_fei : lem -> forall P Q : Prop, ~(~P /\ ~Q) -> P \/ Q.
Proof.
  intro L.
  intro P.
  intro Q.
  unfold not.
  intro h.
  right.
  destruct (L Q) as [q1 | q2].
  apply q1.
  unfold not in q2.
  destruct h.
  split.
  intro i.
  destruct q2.
  admit.
  apply q2.
Admitted.

Theorem t5_3 : forall P Q : Prop, P /\ Q -> ~(~P\/~Q).
Proof.
  intro P.
  intro Q.
  intro h.
  unfold not.
  intro i.
  destruct i as [i1 | i2].
  apply i1.
  apply h.
  apply i2.
  apply h.
Qed.

Theorem t5_4 : forall P Q : Prop,~(~P\/~Q) -> P /\ Q.
Proof.
  intro P.
  intro Q.
  unfold not.
  intro h.
  split.
Abort.

Theorem t5_4 : lem -> forall P Q : Prop, ~(~P\/~Q) -> P /\ Q.
Proof.
  intro L.
  intro P.
  intro Q.
  unfold not.
  intro h.
  split.
  destruct (L P) as [p1 | p2].
  apply p1.
  unfold not in p2.
  destruct h.
  left.
  apply p2.
  destruct (L Q) as [q1 | q2].
  apply q1.
  unfold not in q2.
  destruct h.
  right.
  apply q2.
Qed.

Theorem t6_1 : forall P Q : Prop, ~(P \/ Q) -> (~P /\ ~Q).
Proof.
  intro P.
  intro Q.
  unfold not.
  intro h.
  split.
  intro i.
  apply h.
  left.
  apply i.
  intro j.
  apply h.
  right.
  apply j.
Qed.

Theorem t6_2 : forall P Q : Prop, (~P /\ ~Q) -> ~(P \/ Q).
Proof.
  intro P.
  intro Q.
  unfold not.
  intro h.
  intro i.
  destruct h as [h1 h2].
  destruct i as [i1 | i2].
  apply h1.
  apply i1.
  apply h2.
  apply i2.
Qed.

Theorem t6_3 : forall P Q : Prop, ~(P /\ Q) -> (~Q \/ ~P).
Proof.
  intro P.
  intro Q.
  unfold not.
  intro h.
  right.
  intro i.
  apply h.
  split.
  apply i.
Abort.

Theorem t6_3_fei : lem -> forall P Q : Prop, ~(P /\ Q) -> (~Q \/ ~P).
Proof.
  intro L.
  intro P.
  intro Q.
  unfold not.
  intro h.
  destruct (L Q) as [q1 | q2].
  right.
  intro i.
  apply h.
  split.
  apply i.
  apply q1.
  unfold not in q2.
  left.
  apply q2.
Qed.

Theorem t6_4 : forall P Q : Prop, (~Q \/ ~P) -> ~(P /\ Q).
Proof.
  intro P.
  intro Q.
  unfold not.
  intro h.
  intro i.
  destruct i as [i1 i2].
  destruct h as [h1 | h2].
  apply h1.
  apply i2.
  apply h2.
  apply i1.
Qed.

Theorem t7_1 : forall P Q R : Prop, P /\ (Q \/ R) -> (P /\ Q) \/ (P /\ R).
Proof.
  intro P.
  intro Q.
  intro R.
  intro h.
  destruct h as [h1 h2].
  destruct h2 as [h3 | h4].
  left.
  split.
  apply h1.
  apply h3.
  right.
  split.
  apply h1.
  apply h4.
Qed.

Theorem t7_2 : forall P Q R : Prop, (P /\ Q) \/ (P /\ R) -> P /\ (Q \/ R).
Proof.
  intro P.
  intro Q.
  intro R.
  intro h.
  destruct h as [h1 | h2].
  destruct h1 as [p q].
  split.
  apply p.
  left.
  apply q.
  destruct h2 as [p r].
  split.
  apply p.
  right.
  apply r.
Qed.

Theorem t7_3 : forall P Q R : Prop, P \/ (Q /\ R) -> (P \/ Q) /\ (P \/ R).
Proof.
  intro P.
  intro Q.
  intro R.
  intro h.
  destruct h as [p | qr].
  split.
  left.
  apply p.
  left.
  apply p.
  destruct qr as [q r].
  split.
  right.
  apply q.
  right.
  apply r.
Qed.

Theorem t7_4 : forall P Q R : Prop, (P \/ Q) /\ (P \/ R) -> P \/ (Q /\ R).
Proof.
  intro P.
  intro Q.
  intro R.
  intro h.
  destruct h as [pq pr].
  destruct pq as [p | q].
  left.
  apply p.
  destruct pr as [p | r].
  left.
  apply p.
  right.
  split.
  apply q.
  apply r.
Qed.


Require Import IndependentSets SetOrdering auxProofs Sorting.
Import DirectedGraphs_morph SimpleUndirectedGraphs .
Import MSets.

Module MaximalIndSets (DG : SimpleUndirectedGraphs).
   Module ind :=  (independentSets DG).
   Import ind.
   Import DG.
   Import DG_Facts.
   Module Import vOTF := OrderedTypeFacts Vertices.E.

   Module ordDec := WDecide Vertices.
   Import ordDec.

   (*   Module SProp := WProperties S. *)
   (*   Module SFacts := WFacts S. *)
  Require Import List.
  Import ListNotations.

  Module ordV := OrdProperties Vertices.
  Module ord := MakeSetOrdering Vertices.E Vertices.
  Module Import mo := ord.MO.

  Module ordL := MakeListOrdering Vertices.E.
  Module Import SetO := SetOrd Vertices.

  Module auxp := auxproofs DG.
  Import auxp.

  (* Definition of a Maximal Independent Set with respect to a graph *)
  Inductive MaximalIndSet (X : Vertices.t) (G : t) : Prop :=
  | defMaximalIndSet :
      IndSet X G ->
      (forall x, IndSet (Vertices.add x X) G -> Vertices.In x X) ->
      MaximalIndSet X G.

  Definition maximalIndSet (X : Vertices.t) (G : t) : bool :=
    indSet X G && Vertices.for_all (fun x => indSet (Vertices.add x X) G && Vertices.mem x X) (enumVertices G).

  Theorem maxIndReflect : forall X G,
      reflect (MaximalIndSet X G) (maximalIndSet X G).
  Proof.
    Admitted.

  (* An equivalent definition *)
  Inductive MaximalIndSet_contrapos
  (X : Vertices.t) (G : t) : Prop :=
  | defMaximalIndSet_contrapos :
      IndSet X G ->
      (forall x, ~ Vertices.In x X -> ~ IndSet (Vertices.add x X) G) ->
      MaximalIndSet_contrapos X G.

  Theorem MaximalIndSet_eq : forall X G, MaximalIndSet X G <-> MaximalIndSet_contrapos X G.
  Proof.
    split; intros H; constructor; inversion H; try intros x; auto.
    destruct (vert_prop.In_dec x) with (s := X); auto.
    apply H1 in n.
    contradiction.
  Qed.

  Definition MkMaximalIndSet' (X : Vertices.t) (G : t)
    : Vertices.t :=
    Vertices.fold (fun x X' =>
                     if indSet (Vertices.add x X') G
                                 then
                       (Vertices.add x X') else X') (enumVertices G) X.

  Theorem MkMaximalIndSet'_spec : forall X G,
      IndSet X G -> IndSet (MkMaximalIndSet' X G) G.
  Proof.
    intros X G H.
    unfold MkMaximalIndSet'.
    apply DG_Facts.VertProperties.P.fold_rec_weak; intros; auto.
        destruct (indSet (Vertices.add x a) G) eqn:H4;
      try apply indSet_true_iff in H4;
      auto.
        destruct (indSet_reflect (Vertices.add x a) G); auto.
        inversion H4.
  Qed.

  Add Morphism MaximalIndSet
      with signature Vertices.eq ==> EqualGraph ==> iff
        as maxindEq.
  Proof.
    intros.
    split; constructor; intros.
    {
      inversion H1.
      inversion H2; constructor; unfold ValidSet,IndependentSet in *;
      auto.
      intros.
      rewrite  <- H0.
      apply H4.
      rewrite H.
      auto.
      intros.
      rewrite <- H0.
      apply H5.
      rewrite <- H in H6,H7.
      do 2 auto.
      rewrite H.
      auto.
    }
    {
      inversion H1.
      rewrite <- H.
      apply H4.
      inversion H2.
      constructor; unfold ValidSet, IndependentSet in *; intros; auto.
      rewrite H0.
      apply H5.
      rewrite <- H.
      auto.
      rewrite  H0.
      apply H6;
      rewrite <- H; auto.
    }
    {
      inversion H1.
      inversion H2.
      constructor; unfold ValidSet, IndependentSet in *; intros; auto.
      rewrite H0.
      apply H4.
      rewrite <- H.
      auto.
      rewrite H0.
      apply H5;
        rewrite <- H; auto.
    }
    {
      inversion H1.
      rewrite  H.
      apply H4.
      inversion H2.
      constructor; unfold ValidSet, IndependentSet in *; intros; auto.
      rewrite <- H0.
      apply H5.
      rewrite H.
      auto.
      rewrite <-  H0.
      apply H6;
      rewrite  H; auto.
    }
  Qed.

  Lemma MaximalIndSet_spec : forall x Y G, MaximalIndSet Y G ->Vertices.In x Y -> Vertices.In x (enumVertices G).
   Proof.
     intros.
     inversion H.
     inversion H1.
     unfold ValidSet in H3.
     apply H3.
     auto.
   Qed.

  Lemma MaximalIndSet_spec1 : forall x X G, MaximalIndSet X G -> Vertices.In x X \/ ~ IndSet (Vertices.add x X) G.
  Proof.
    intros.
    assert ({IsVertex x G} + {~IsVertex x G}).
    eapply reflect_dec.
    apply IsVertex_reflect.
    destruct H0.
    +
      assert ({IndSet (Vertices.add x X) G} + {~ IndSet (Vertices.add x X) G}).
      eapply reflect_dec.
      apply indSet_reflect.
      destruct H0; auto.
      inversion H.
      apply H1 in i0.
      auto.
    +
      right.
      intros Hnot.
      inversion Hnot.
      unfold ValidSet in H0.
      specialize (H0 x).
      apply n.
      apply IsVertexEnum.
      apply H0.
      apply Vertices.add_spec.
      left.
      reflexivity.
  Qed.

  Definition growMisStep (G : t) (x : vertex) (X : Vertices.t)  :=
    if indSet (Vertices.add x X) G then Vertices.add x X else X.

  Definition growMis (V : Vertices.t) (X : Vertices.t) (G : t) :=
    Vertices.fold (growMisStep G) V X.

  Definition MkMax (X : Vertices.t) G := growMis (enumVertices G) X.

  Ltac fd :=
    match goal with
    | [ |- ?X =V= ?X ] => reflexivity
    | _ => fsetdec
    end.

  Open Scope nat_scope.
Ltac solve_by_inverts n :=
  match goal with | H : ?T |- _ =>
  match type of T with Prop =>
    solve [
      inversion H; try reflexivity; auto;
      match n with S (S (?n')) => subst; solve_by_inverts (S n') end ]
  end end.

Ltac si :=
  try contradiction; solve_by_inverts 2.

  Add Morphism growMisStep
      with signature  EqualGraph ==> Vertices.E.eq ==> Vertices.eq ==> Vertices.eq
        as growMisStep_morph.
  Proof.
    intros.
    unfold growMisStep.
    destruct ( indSet (Vertices.add x0 x1) x) eqn: H2;
    destruct ( indSet (Vertices.add y0 y1) y)eqn: H3; try auto; try rewrite H1, H0; try fd try reflexivity; try rewrite <- H1, H0; try fd.

    destruct (indSet_reflect (Vertices.add x0 x1) x).
    destruct (indSet_reflect (Vertices.add y0 y1) y); try si.
    rewrite H,H0,H1 in i.
    si.
    si.
    destruct (indSet_reflect (Vertices.add x0 x1) x).
    destruct (indSet_reflect (Vertices.add y0 y1) y). try si.
    si.
    destruct (indSet_reflect (Vertices.add y0 y1) y).
    rewrite H,H0,H1 in n.
    si.
    si.
  Qed.

  Theorem MkMaximalIndSet'_mon : forall V X G, exists X',
        growMis V X G =V= Vertices.union X X'.
  Proof.
    intros V X G.
    induction V using ordV.P.set_induction.
    exists (Vertices.empty).
    unfold growMis.
    unfold growMisStep.
    rewrite VertProperties.P.fold_1b; try fsetdec.
    rewrite VertProperties.P.empty_union_2; try fsetdec; try reflexivity.
    destruct IHV1.
    unfold growMis.
    apply ordV.P.fold_rec_weak;
    intros; eauto.
    exists (Vertices.empty).
   rewrite VertProperties.P.empty_union_2; try fsetdec; try reflexivity.
    unfold growMisStep.
    destruct (indSet (Vertices.add x1 a) G); eauto.
    destruct H3.
    exists (Vertices.add x1 x2).
    rewrite H3.
    +
      split; intros; try fsetdec.
  Qed.

  Theorem growMis_mon : forall V X G, exists X',
      growMis V X G =V= Vertices.union X X' /\
      Vertices.Subset X' V.
  Proof.
    intros.
    induction V using ordV.P.set_induction.
    exists (Vertices.empty).
    unfold growMis.
    unfold growMisStep.
    rewrite VertProperties.P.fold_1b; try fsetdec. split.
    rewrite VertProperties.P.empty_union_2; try fsetdec; try reflexivity.
    apply ordV.P.subset_empty.
    destruct IHV1.
    destruct H1.
    unfold growMis.
    apply ordV.P.fold_rec_weak;
    intros; eauto.
    do 2 destruct H4.
    +
      exists x1; split; [auto | fsetdec].
    +
      exists (Vertices.empty).
      split.
      rewrite VertProperties.P.empty_union_2;
        try fsetdec; try reflexivity.
      apply ordV.P.subset_empty.
    +
      unfold growMisStep.
      destruct (indSet (Vertices.add x1 a) G); eauto;
        try fsetdec.
      destruct H4.
      exists (Vertices.add x1 x2).
      destruct H4.
      rewrite H4.
      split; intros; auto; try fsetdec.
      split; intros; try fsetdec.
      do 2 destruct H4.
      exists x2; split; [auto | fsetdec].
  Qed.

  Lemma fold_left_decomp : forall x0 x1 G X,
      fold_left (flip (growMisStep G)) (x0 :: x1) X =
      fold_left (flip (growMisStep G)) (x1) (growMisStep G x0 X).
  Proof.
    intros.
    simpl.
    reflexivity.
  Qed.

  Lemma fold_equivlistLeft : forall G,
      forall s s' i,
        eqlistA Vertices.E.eq s s' -> Vertices.Equal (fold_left (flip (growMisStep G)) s i) (fold_left (flip (growMisStep G)) s' i).
  Proof.
    intros.
    do 2 rewrite  <- fold_left_rev_right.
    eapply fold_right_eqlistA; eauto.
    apply Vertices.eq_equiv.
    unfold Proper.
    unfold respectful.
    intros.
    rewrite H0.
    rewrite H1.
    reflexivity.
    rewrite H.
    reflexivity.
  Qed.

  Lemma eqlistA_equivlistA :
    forall S S', eqlistA Vertices.E.eq S S'->
                      equivlistA Vertices.E.eq S S'.
  Proof.
    intros.
    induction H; intros.
    constructor; intros; auto.
    split; intros;
    [ rewrite <- H;
     rewrite <- IHeqlistA | rewrite H; rewrite IHeqlistA ]; auto.
  Qed.

  Hint Resolve ordV.P.Dec.F.elements_iff.

  Theorem fold_decomp_spec : forall v V X G, Vertices.In v V ->
    exists X' X'', growMis V X G =V=
                   growMis X' ((growMisStep G) v (growMis X'' X G)) G /\
                   V =V= Vertices.union X' (Vertices.add v X'') /\
             (forall x, Vertices.In x X''
                        -> Vertices.E.lt x v /\ Vertices.In x V).         Proof.
    unfold growMis.
    intros.
    apply listIn in H.
    destruct H.
    assert (exists l1 l2,  eqlistA Vertices.E.eq (Vertices.elements V) ((Vertices.elements l1) ++  x :: (Vertices.elements l2))).
    eapply list_decomp.
    intuition.
    destruct H.
    do 2 destruct H0.
    exists x1,x0.
    split.
    rewrite Vertices.fold_spec.
    rewrite fold_equivlistLeft with (s' := (Vertices.elements x0 ++ x :: Vertices.elements x1)); auto.
    rewrite fold_left_app.
    rewrite fold_left_decomp.
    rewrite <- Vertices.fold_spec.
    rewrite <- Vertices.fold_spec.
    rewrite H.
    reflexivity.
    intros.
    subst.
    assert (Sorted Vertices.E.lt (Vertices.elements x0 ++ v :: Vertices.elements x1)).
    rewrite <- H0.
    auto.
    split; intros.
    +
      apply mon_aux_equivlistA_eq_app; auto.
    +
      split.
      *
        assert (NoDupA Vertices.E.eq (Vertices.elements V)).
        apply ordV.ML.Sort_NoDup.
        auto.
        assert (NoDupA Vertices.E.eq
                 (Vertices.elements x0 ++ v :: Vertices.elements x1)).
        admit.
        admit.
      *
        rewrite ordV.P.Dec.F.elements_iff in *.
        rewrite H0.
        apply InA_app_iff.
        auto.
    Admitted.

  Theorem fold_decomp : forall v V X G, Vertices.In v V ->
      exists X' X'', growMis V X G =V=
               growMis X' ((growMisStep G) v (growMis X'' X G)) G.
  Proof.
    intros.
    edestruct (fold_decomp_spec); eauto.
    destruct H0.
    destruct H0.
    eauto.
  Qed.

  Definition MkMaximalIndSet (X : Vertices.t) (G : t) :=
    growMis (enumVertices G) X G.

  Lemma  Mkequiv : forall X G,
      MkMaximalIndSet X G = MkMaximalIndSet' X G.
  Proof.
    intros.
    unfold MkMaximalIndSet.
    unfold growMis.
    unfold MkMaximalIndSet'.
    unfold growMisStep.
    reflexivity.
  Qed.

  Theorem MkMaximalIndSet_spec : forall X G,
      IndSet X G -> IndSet (MkMaximalIndSet X G) G.
  Proof.
    intros X G H.
    rewrite Mkequiv.
    apply MkMaximalIndSet'_spec.
    auto.
  Qed.

  Theorem MkMaximalIndSet_mon :forall X G, exists X',
        (MkMaximalIndSet X G) =V= Vertices.union X X'.
  Proof.
    intros X G.
    assert (exists X' : Vertices.t, growMis (enumVertices G) X G =V= Vertices.union X X').
    apply MkMaximalIndSet'_mon.
    destruct H.
    exists x.
    auto.
  Qed.

  Lemma sil : forall x0 x x1 X G, exists X', (growMis x0 (Vertices.add x (growMis x1 X G)) G) =V= Vertices.union ((Vertices.add x (growMis x1 X G))) X'.
  Proof.
    intros.
    apply MkMaximalIndSet'_mon.
  Qed.

  Lemma IndSet_grow_decomp : forall x x0 x1 X G, IndSet
         (Vertices.add x (growMis x0 (growMisStep G x (growMis x1 X G)) G)) G -> IndSet (Vertices.add x (growMis x1 X G)) G.
  Proof.
    intros.
    constructor;
      inversion H.
    {
      unfold ValidSet in *.
      intros.
      apply H0; auto.
      apply Vertices.add_spec in H2.
      destruct H2.
      apply Vertices.add_spec.
      intuition.
      assert (exists X', growMis x0 (growMisStep G x (growMis x1 X G)) G =V= Vertices.union (growMisStep G x (growMis x1 X G)) X').
      apply MkMaximalIndSet'_mon.
      destruct H3.
      rewrite H3.
      apply Vertices.add_spec.
      right.
      apply Vertices.union_spec.
      left.
      unfold growMisStep.
      destruct (indSet (Vertices.add x (growMis x1 X G)) G);
        try apply Vertices.add_spec;
        intuition.
    }
    {
      unfold IndependentSet in *.
      intros.
      apply H1; rewrite Vertices.add_spec in *.
      +
        assert (exists X', growMis x0 (growMisStep G x (growMis x1 X G)) G =V= Vertices.union (growMisStep G x (growMis x1 X G)) X') by
      apply MkMaximalIndSet'_mon;
            destruct H4.
        destruct H2.
        left; auto.
        right.
        rewrite H4.
        apply Vertices.union_spec.
        left;
          unfold growMisStep.
          destruct (indSet (Vertices.add x (growMis x1 X G)) G);
          auto.
          apply Vertices.add_spec.
          intuition.
      +
        assert (exists X', growMis x0 (growMisStep G x (growMis x1 X G)) G =V= Vertices.union (growMisStep G x (growMis x1 X G)) X') by
      apply MkMaximalIndSet'_mon;
            destruct H4.
        destruct H3.
        intuition.
        right.
        rewrite H4.
        apply Vertices.union_spec.
        left;
          unfold growMisStep.
          destruct (indSet (Vertices.add x (growMis x1 X G)) G);
          auto.
          apply Vertices.add_spec.
          intuition.
    }
  Qed.

  Theorem MkMaximalIndSet_max : forall X G,
      IndSet X G -> MaximalIndSet (MkMaximalIndSet X G) G.
  Proof.
    intros.
    constructor; intros.
    apply MkMaximalIndSet_spec.
    auto.
    assert ({Vertices.In x (MkMaximalIndSet X G)} + {~Vertices.In x (MkMaximalIndSet X G)}).
    apply ordV.P.In_dec.
    destruct H1.
    auto.
    unfold MkMaximalIndSet in *.
    assert (exists X' X'' : Vertices.t,
         growMis (enumVertices G) X G =V=
         growMis X' (growMisStep G x (growMis X'' X G)) G).
    apply fold_decomp.
    assert ({Vertices.In x (enumVertices G)} + {~Vertices.In x (enumVertices G)}).
    apply ordV.P.In_dec.
    destruct H1; auto.
    +
      inversion H0.
      unfold ValidSet in H1.
      apply H1.
      apply Vertices.add_spec.
      intuition.
    +
        do 2 destruct H1.
        rewrite H1 in n.
        unfold growMisStep in n.
        case_eq (indSet (Vertices.add x (growMis x1 X G)) G).
    -
      intros.
      rewrite H2 in n.
      assert ( exists X',
                 (MkMaximalIndSet X G) =V= Vertices.union X X').
      apply MkMaximalIndSet_mon.
      destruct H3.
      unfold MkMaximalIndSet in H3.
      assert (exists X' : Vertices.t,
                 growMis x0 (Vertices.add x (growMis x1 X G)) G =V=
                 Vertices.union (Vertices.add x (growMis x1 X G)) X').
      apply MkMaximalIndSet'_mon.
      destruct H4.
      rewrite H4 in n.
      exfalso.
      apply n.
      apply Vertices.union_spec.
      left.
      apply Vertices.add_spec. intuition.
    -
      intros.
      rewrite H2 in n.
      rewrite H1 in H0.
      apply IndSet_grow_decomp in H0.
      destruct (indSet_reflect ((Vertices.add x (growMis x1 X G))) G);
      si.
  Qed.

  (*Given two subset X, Y ⊆ V, such that X , Y, X < Y according to the lexicographic ordering
if and only if the minimum element of X − Y is less than the minimum element of Y − X or
Y − X = ∅.*)

  (* Here begins the lexegraphical ordering *)

  Theorem MaximalIndSet_subs : forall X Y G, Vertices.Subset X Y -> MaximalIndSet X G -> MaximalIndSet Y G ->  X =V= Y.
  Proof.
    intros X Y G H0 H1 H2. rewrite  MaximalIndSet_eq in *.
    unfold Vertices.Subset in H0.  intros x. split; intros H3.
    (* -> *)
    apply H0 in H3. apply H3.
    (* <- *)
    assert ({Vertices.In x X} + {~ Vertices.In x X}) as H4. apply ordV.P.In_dec.
    destruct H4 as [H4| H4]. apply H4.

    assert (False).
    assert (~IndSet (Vertices.add x X) G) as H5. destruct H1 as [H1 H5].    apply H5. apply H4.
    apply H5. constructor. intros y H6.
    apply Vertices.add_spec in H6.
    destruct H6 as [H6 | H6]. apply H2.
    rewrite H6. auto. apply H1. auto.
    intros y z H6 H7. apply H2.
    apply Vertices.add_spec in H6.
    destruct H6 as [H6 | H6].
    rewrite H6. auto. auto.
    apply Vertices.add_spec in H7.
    destruct H7 as [H7 | H7].
    rewrite H7. auto. apply H0. auto. inversion H.
  Qed.

  Theorem IndSet_lift_spec : forall X x G,
      MaximalIndSet X G -> IsVertex x G -> IndSet (Vertices.add x X) G -> Vertices.In x X.
  Proof.
    intros. rewrite -> MaximalIndSet_eq in H. destruct H as [[H2 H3] H4].
    assert ( {Vertices.In x X}+{~Vertices.In x X} ) as H5 by (apply ordV.P.In_dec).
    destruct H5 as [H5 | H5]. assumption.
    exfalso. apply H4 in H5. contradiction.
  Qed.

  Lemma MkMaximalIndSet_spec4 : forall X G, Vertices.Subset X (MkMaximalIndSet X G).
 Proof.
   intros.
   intros x  H.
   destruct (MkMaximalIndSet_mon X G).
   rewrite H0.
   rewrite Vertices.union_spec.
   auto.
 Qed.

 Lemma MkMaximalIndSet_subset : forall X Y G, MaximalIndSet X G -> MaximalIndSet Y G -> Vertices.Subset X Y -> (Vertices.Subset Y (MkMaximalIndSet X G)).
 Proof.
   intros.
   eapply MaximalIndSet_subs with (G := G)in H1; eauto.
   destruct (MkMaximalIndSet_mon X G).
   rewrite H2.
   intros v H3.
   apply Vertices.union_spec.
   rewrite H1.
   auto.
 Qed.

 Definition eleSub X Y := forall x , InA Vertices.E.eq x (Vertices.elements X) -> InA Vertices.E.eq x (Vertices.elements Y).

 Definition subset_list X Y := forall x , InA Vertices.E.eq x X -> InA Vertices.E.eq x Y.

 Lemma subs_elements : forall X Y ,
     Vertices.Subset X Y -> eleSub X Y.
 Proof.
   intros.
   unfold eleSub.
   unfold Vertices.Subset in H.
   intros.
   apply ordV.P.Dec.F.elements_iff  with (x := x) in H; auto.
   rewrite <- VertProperties.P.Dec.F.elements_iff in H0.
   auto.
 Qed.

 Lemma  not_le_lt_set : forall X Y, ~ le_set X Y ->
                                    lt_set Y X.
 Proof.
   intros.
   apply not_le_lt_rev in H.
   auto.
 Qed.

 Lemma help : forall X,
     (exists x , Vertices.In x X) \/ Vertices.Empty X.
 Proof.
   intros.
   induction X using ordV.P.set_induction; eauto.
   destruct IHX1.
   destruct H1;
     apply ordV.P.Add_Equal in H0.
   left.
   exists x0.
   rewrite H0.
   rewrite Vertices.add_spec.
   auto.
   left.
   exists x.
   apply ordV.P.Add_Equal in H0.
   rewrite H0.
   rewrite Vertices.add_spec.
   auto.
 Qed.

 Lemma indset_singleton : forall x G,
     Vertices.In x (enumVertices G) -> IndSet (Vertices.singleton x) G.
 Proof.
   intros.
   constructor.
   intros x0 H0; auto.
   apply ordV.P.Dec.F.singleton_1 in H0.
   rewrite <- H0.
   auto.
   intros x0 x1 H0 H1.
   apply ordV.P.Dec.F.singleton_1 in H0.
   apply ordV.P.Dec.F.singleton_1 in H1.
   rewrite <- H0,H1.
   rewrite <- IsEdgeEnum.
   apply edges_irreflexive.
 Qed.

 Lemma ahhhh : forall X Y G,
     MaximalIndSet (ordV.P.of_list X) G -> MaximalIndSet (ordV.P.of_list Y) G -> ord.lt_list X Y -> X <> [] /\ Y <> [].
 Proof.
   intros.
   destruct X;
     destruct Y.
   inversion H1.
   inversion H.
   assert (IndSet (Vertices.add e (ordV.P.of_list [])) G).
   { simpl.  rewrite <- ordV.P.singleton_equal_add.
     apply indset_singleton.
     assert (InA Vertices.E.eq e (Vertices.elements (ordV.P.of_list (e :: Y)))).
     rewrite <- ordV.P.Dec.F.elements_iff.
     simpl.
     apply Vertices.add_spec.
     auto.
     eapply MaximalIndSet_spec; eauto.
     apply  <- ordV.P.Dec.F.elements_iff in H4.
     auto.
   }
   inversion H.
   apply H6 in H4.
   simpl in H4.
   apply ordV.P.Dec.F.empty_iff in H4.
   destruct H4.
   inversion H1.
   split; intros Hnot; inversion Hnot.
 Qed.

 Lemma notIn_notInd : forall x2 X G x,
     Vertices.In x x2 ->
     ~ Vertices.In x (growMis x2 X G) -> exists X',
         ~IndSet (Vertices.add x X') G /\ Vertices.Subset X' (growMis x2 X G).
 Proof.
   intros.
   destruct (MkMaximalIndSet'_mon x2 X G).
   unfold growMis in H.
   destruct (fold_decomp_spec x x2 X G); auto.
   do 2 destruct H2.
   destruct H3.
   unfold growMisStep in H2.
   destruct (indSet (Vertices.add x (growMis x3 X G))) eqn:H5.
   -
     rewrite H2 in H0.
     exfalso.
     apply H0.
     destruct (MkMaximalIndSet'_mon x1 (Vertices.add x (growMis x3 X G)) G).
     rewrite H6.
     apply Vertices.union_spec.
     rewrite Vertices.add_spec.
     auto.
   -
     exists (growMis x3 X G).
     split.
     destruct (indSet_reflect (Vertices.add x (growMis x3 X G)) G);
       try si; auto.
     rewrite H2.
     destruct (MkMaximalIndSet'_mon x1 (growMis x3 X G) G).
     rewrite H6.
     intros x' H7.
     apply Vertices.union_spec.
     auto.
 Qed.

 Lemma and_reflect : forall a b, reflect (a=true /\ b=true) (a && b) .
 Proof.
   intros.
   apply iff_reflect.
   symmetry.
   apply andb_true_iff.
 Qed.

 Lemma IndSet_Mult_Add : forall x x0 X1 G,
     ~ Edges.In (buildEdge x x0) (enumEdges G) /\
     IndSet (Vertices.add x0 X1) G /\
     IndSet (Vertices.add x X1) G ->
     IndSet (Vertices.add x (Vertices.add x0 X1)) G.
 Proof.
   intros.
   intuition.
   inversion H.
   inversion H2.
   constructor.
   clear H3. clear H5.
   {
     unfold ValidSet in *.
     intros.
     apply Vertices.add_spec in H3.
     destruct H3.
     apply H4.
     rewrite H3.
     apply Vertices.add_spec.
     auto.
     apply Vertices.add_spec in H3.
     destruct H3.
     apply H1.
     rewrite H3.
     apply Vertices.add_spec; auto.
     apply H4.
     apply Vertices.add_spec; auto.
   }
   clear H4. clear H1.
   unfold IndependentSet in *.
   intros.
   rewrite Vertices.add_spec in H1,H4.
   destruct H4.
   +
     rewrite H4.
     destruct H1.
     *
       rewrite H1.
       rewrite <- IsEdgeEnum.
       apply edges_irreflexive.
     *
       rewrite Vertices.add_spec in H1.
       destruct H1.
       {
         rewrite H1.
         intros Hnot.
         apply H0.
         rewrite <- IsEdgeEnum in *.
         apply undirected.
         auto.
       }
       {
         apply H5;
           apply Vertices.add_spec;
           auto.
       }
   +
     destruct H1.
     rewrite H1.
     apply Vertices.add_spec in H4.
     destruct H4.
     *
       rewrite H4.
       intros Hnot.
       eauto.
     *
       apply H5.
       apply Vertices.add_spec.
       auto.
       apply Vertices.add_spec.
       auto.
     *
       apply H3;
         auto.
 Qed.

 Lemma not_ind_witness : forall x X G ,
     IndSet X G -> IsVertex x G ->
     ~ IndSet (Vertices.add x X) G ->
     exists z : vertex,
       Vertices.In z X /\ Edges.In (buildEdge x z) (enumEdges G).
 Proof.
   intros.
   generalize dependent G.
   induction X using ordV.P.set_induction.
   {
     intros.
     assert (Vertices.Equal X Vertices.empty).
     apply ordV.P.empty_is_empty_1; auto.
     rewrite H3 in H2.
     exfalso.
     apply H2.
     rewrite IsVertexEnum in H1.
     apply nilIndSetAdd; auto.
   }
   intros.
   rewrite ordV.P.Add_Equal in H0.
   rewrite H0 in *.
   destruct (EdgeProperties.P.In_dec (buildEdge x x0) (enumEdges G)).
   exists x0.
   split; auto.
   rewrite H0.
   rewrite Vertices.add_spec. auto.
   +
     assert (~ IndSet (Vertices.add x X1) G).
     intros Hnot.
     apply H3.
     assert (~ Edges.In (buildEdge x x0) (enumEdges G) /\
             IndSet (Vertices.add x0 X1) G /\
             IndSet (Vertices.add x X1) G ->
             IndSet (Vertices.add x (Vertices.add x0 X1)) G).
     intros.
     apply IndSet_Mult_Add.
     auto.
     apply H4.
     auto.
     apply IndSet_add in H1.
     apply IHX1 in H1; auto.
     destruct H1.
     intuition.
     exists x1; auto.
     split; auto.
     rewrite H0.
     rewrite Vertices.add_spec.
     auto.
 Qed.

 Lemma max_edge_contra : forall x x3 G Y,
     MaximalIndSet Y G ->
     Edges.In (buildEdge x x3) (enumEdges G) ->
     Vertices.In x3 Y -> Vertices.In x Y -> False.
 Proof.
   intros.
   inversion H.
   inversion H3.
   unfold IndependentSet in H6.
   specialize (H6 x x3).
   apply H6; auto.
 Qed.

 Lemma IndGrow : forall x2 X G, IndSet X G -> IndSet (growMis x2 X G) G.
 Proof.
   intros.
   unfold growMis.
   apply DG_Facts.VertProperties.P.fold_rec_weak; intros; auto.
   unfold growMisStep.
   destruct (indSet (Vertices.add x a) G) eqn:H2; auto.
   destruct (indSet_reflect (Vertices.add x a) G); auto; try si.
 Qed.

 Lemma In_Max_Is_Vertex : forall x X G,
     Vertices.In x X -> MaximalIndSet X G -> IsVertex x G.
 Proof.
   intros.
   inversion H0.
   inversion H1.
   unfold ValidSet in H3.
   apply IsVertexEnum.
   apply H3; auto.
 Qed.

 Lemma InGrowMis :
   forall x V X G,
     Vertices.In x (growMis V X G) ->
     Vertices.In x V \/ Vertices.In x X.
 Proof.
   intros.
   destruct (growMis_mon V X G).
   destruct H0.
   rewrite H0 in H.
   apply Vertices.union_spec in H.
   destruct H; auto.
 Qed.

 Lemma InSubVert_Not_In_Subset :
   forall x3 x2 X G Y,
     Vertices.Subset X Y ->
     Vertices.In x3 (growMis x2 X G) /\ ~ Vertices.In x3 Y ->
     Vertices.In x3 x2.
 Proof.
   intros.
   destruct H0.
   apply InGrowMis in H0.
   destruct H0; auto.
   exfalso; apply H1; apply H; auto.
 Qed.

 Lemma emptyDiff_sub : forall X Y,
     Vertices.Empty (Vertices.diff X Y) ->
     Vertices.Subset X Y.
 Proof.
   intros.
   unfold Vertices.Empty in H.
   unfold Vertices.Subset.
   intros.
   destruct (ordV.P.In_dec a Y); auto.
   exfalso.
   assert (Vertices.In a (Vertices.diff X Y)).
   apply Vertices.diff_spec.
   auto.
   apply (H a); auto.
 Qed.

 Theorem MkMaximalIndSet_spec3 : forall X Y G,
     IndSet X G -> MaximalIndSet Y G -> Vertices.Subset X Y ->
     le_set (MkMaximalIndSet X G) Y.
 Proof.
   intros.
   destruct (le_setReflect (MkMaximalIndSet X G) Y); auto.
   apply not_le_lt_set in n.
   assert (MaximalIndSet (MkMaximalIndSet X G) G).
   apply MkMaximalIndSet_max.
   auto.
   assert (H3 : lt_set Y (MkMaximalIndSet X G)) by auto.
   eapply lt_witness in n; eauto.
   destruct n.
   {
     inversion H0.
     apply le_set_spec.
     left.
     symmetry.
     eapply MaximalIndSet_subs; eauto.
   }
   {
     destruct H4.
     destruct H4.
     (* destruct (ordV.P.In_dec x (Vertices.diff (MkMaximalIndSet X G) Y)). *)
     destruct (help (Vertices.diff (MkMaximalIndSet X G) Y)).
     -
       destruct H6.
       assert (Vertices.In x0 (Vertices.diff (MkMaximalIndSet X G) Y))
         by auto.
       apply H5 in H6.
       rewrite Vertices.diff_spec in *.
       destruct (fold_decomp_spec x (enumVertices G) X G); auto.
       eapply MaximalIndSet_spec with (Y := Y); eauto; intuition.
       destruct H8.
       destruct H8.
       assert (H20 : lt_set Y (MkMaximalIndSet X G)) by auto.
       rewrite H8 in H3.
       unfold growMisStep in H3.
       case_eq (indSet (Vertices.add x (growMis x2 X G)) G).
       +
         intros.
         assert ( Vertices.In x (MkMaximalIndSet X G)).
         rewrite H8.
         unfold growMisStep.
         rewrite H10.
         destruct (MkMaximalIndSet'_mon x1  (Vertices.add x (growMis x2 X G)) G).
         rewrite H11.
         apply Vertices.union_spec.
         rewrite  Vertices.add_spec.
         auto.
         destruct H4.
         contradiction.
       +
         intros.
         assert (exists z, Vertices.In z (growMis x2 X G) /\
                           ~Vertices.In z Y).
         destruct (not_ind_witness x (growMis x2 X G) G).
         apply IndGrow; auto.
         apply In_Max_Is_Vertex with (X := Y); intuition.
         destruct (indSet_reflect (Vertices.add x (growMis x2 X G)) G);
           auto; try si.
         destruct (indSet_reflect (Vertices.add x (growMis x2 X G)) G);
           auto; try si.
         destruct (indSet_reflect (Vertices.add x (growMis x2 X G)) G);
           try si.
         destruct H11.
         exists x3.
         split; auto.
         intros Hnot.
         destruct (indSet_reflect (Vertices.add x (growMis x2 X G)) G).
         try si.
         clear H10.
         apply (max_edge_contra x x3 G Y); destruct H4; auto.
         destruct H11.
         assert (Vertices.In x3 x2).
         eapply InSubVert_Not_In_Subset; eauto.
         assert (Vertices.In x3 (MkMaximalIndSet X G) /\
                 ~ Vertices.In x3 Y).
         {
           rewrite H8.
           destruct H11.
           split; auto.
           destruct (MkMaximalIndSet'_mon x1
                                          (growMisStep G x (growMis x2 X G)) G).
           rewrite H14.
           apply Vertices.union_spec.
           left.
           unfold growMisStep.
           rewrite H10.
           auto.
         }
         rewrite <- Vertices.diff_spec in H13, H4.
         apply H5 in H13.
         destruct H9.
         apply H14 in H12.
         destruct H12.
         assert (StrictOrder Vertices.E.lt).
         apply Vertices.E.lt_strorder.
         exfalso.
         apply StrictOrder_Asymmetric in H13.
         auto.
         auto.
     -
       apply le_set_spec.
       left.
       apply emptyDiff_sub in H6.
       apply MaximalIndSet_subs with (G := G); auto.
       }
 Qed.

End MaximalIndSets.

(* init first set is empty, list
   shift : list (sets vert) -> list (sets vert)
     cons a B -> (mkcs a) ++ B.
     can only can only be applied when not empty or not last vertex
   dump : list (sets vert) -> list (sets vert)
   if its' a maximalind of the entire graph and dumps them somewhere.
   terminate : nil -> stuff you have dumped.
 *)


Require Import CoqStock.Invs.
Require Import CoqStock.List.

Require Import Brzozowski.Alphabet.
Require Import Brzozowski.Derive.
Require Import Brzozowski.DeriveCommutes.
Require Import Brzozowski.Language.
Require Import Brzozowski.Null.
Require Import Brzozowski.NullCommutes.
Require Import Brzozowski.Regex.

CoInductive Trace: regex -> lang :=
| empty_trace : forall q:regex, null_def q = emptystr -> Trace q []
| cons_trace :
    forall (q q':regex) (a:alphabet) (s:str),
        derive_def q a = q' -> Trace q' s -> Trace q (a :: s).

Theorem trace_is_equivalent:
  forall (p: regex),
    {{p}} {<->} Trace p.
Proof.
intros.
split; intros.
- generalize dependent p.
  generalize dependent s.
  cofix G.
  intros.
  unfold "\in".
  (* `induction s` would break Guarded *)
  destruct s.
  + constructor.
    rewrite null_iff_null_def.
    constructor.
    assumption.
    Guarded.
  + apply (cons_trace p (derive_def p a) a).
    * reflexivity.
    * specialize G with (s := s) (p := (derive_def p a)).
      apply G.
      rewrite <- derive_commutes_a.
      assumption.
      Guarded.
- generalize dependent p.
  induction s.
  + intros.
    inversion H.
    rewrite null_iff_null_def in H0.
    invs H0.
    assumption.
  + intros.
    specialize IHs with (p := (derive_def p a)).
    replace ((a :: s) \in {{p}}) with (s \in (derive_lang a {{p}})).
    * rewrite derive_commutes_a.
      apply IHs.
      invs H.
      assumption.
    * unfold derive_lang.
      unfold "\in".
      reflexivity.
Qed.


Theorem Modus_tollens : forall P Q : Prop, ~Q /\ (P -> Q) -> ~P.
Proof.
  intros.
  destruct H.
  contradict H.
  apply H0.
  assumption.
Qed.


(* Copyright 2012-2017 by Adam Petcher and FCF Contributors.	*
 * Use of this source code is governed by the license described	*
 * in the LICENSE file at the root of the source tree.		*)

(* An argument that is used to prove that the "two worlds" style of security definition is equivalent to the "coin flipping" style. *)

Set Implicit Arguments.

Require Import FCF.FCF.
Require Import FCF.Crypto.
Require Import FCF.Asymptotic.

Theorem evalDist_bool_support :
  forall (c : Comp bool)(ls : list bool),
    well_formed_comp c ->
    ls = getSupport c ->
    sumList ls (evalDist c) == evalDist c false + evalDist c true.

  intuition.
  specialize (support_NoDup c); intuition.
  rewrite <- H0 in H1.

  destruct ls; intuition.
  specialize (getSupport_length_nz H); intuition.
  rewrite <- H0 in H2.
  simpl in *.
  omega.

  destruct b.

  destruct ls.
  unfold sumList; simpl.

  eapply ratAdd_eqRat_compat.
  symmetry.
  eapply getSupport_not_In_evalDist.
  intuition.
  rewrite <- H0 in H2.
  simpl in *.
  intuition.
  intuition.

  destruct b.
  inversion H1; clear H1; subst.
  simpl in *.
  intuition.

  destruct ls.

  unfold sumList.
  simpl.
  rewrite <- ratAdd_0_l.
  eapply ratAdd_comm.

  destruct b.
  inversion H1; clear H1; subst.
  simpl in *.
  intuition.
  inversion H1; clear H1; subst.
  simpl in *.
  intuition.
  inversion H5; clear H5; subst.
  simpl in *; intuition.

  destruct ls.
  unfold sumList; simpl.

  rewrite ratAdd_comm.
  eapply ratAdd_eqRat_compat.
  intuition.
  symmetry.
  eapply getSupport_not_In_evalDist.
  intuition.
  rewrite <- H0 in H2.
  simpl in *.
  intuition.

  destruct b.

  destruct ls.

  unfold sumList.
  simpl.
  rewrite <- ratAdd_0_l.
  intuition.

  destruct b.
  inversion H1; clear H1; subst.
  simpl in *.
  intuition.
  inversion H5; clear H5; subst.
  simpl in *; intuition.
  inversion H1; clear H1; subst.
  simpl in *; intuition.
  inversion H1; clear H1; subst.
  simpl in *; intuition.

Qed.

Theorem evalDist_bool_complement :
  forall (c : Comp bool),
    well_formed_comp c ->
    evalDist c false == ratSubtract 1 (evalDist c true).

  intuition.
  eapply (eqRat_ratAdd_same_r (evalDist c true)).
  symmetry.
  rewrite ratAdd_comm.
  rewrite ratSubtract_ratAdd_inverse_2.

  specialize (@evalDist_lossless _ c); intuition.
  rewrite <- H1.
  clear H1.
  eapply evalDist_bool_support.
  intuition.
  intuition.

  eapply evalDist_le_1.
Qed.

Theorem rndBool_bind :
  forall
    (f : bool -> Comp bool),
    Pr[b <-$ {0, 1}; f b] == (1 / 2) * Pr[f true] + (1 / 2) * Pr[f false].

  intuition.
  simpl.
  destruct (bind_eq_dec ({ 0 , 1 }^1) (fun m : Bvector 1 => ret Vector.hd m)
    false true).
  discriminate.

  unfold sumList.
  simpl.
  destruct (EqDec_dec bool_EqDec true false).
  discriminate.
  destruct (EqDec_dec bool_EqDec false true).
  discriminate.
  destruct (EqDec_dec bool_EqDec true true).
  destruct (EqDec_dec bool_EqDec false false).

  repeat rewrite <- ratAdd_0_l.
  repeat rewrite ratMult_0_r.
  repeat rewrite <- ratAdd_0_r.
  repeat rewrite <- ratAdd_0_l.
  repeat rewrite ratMult_1_r.
  eapply ratAdd_eqRat_compat;
    eapply ratMult_eqRat_compat; intuition.

  intuition.
  intuition.
Qed.

Section TwoWorldsEquiv.

  Variable f : nat -> bool -> Comp bool.

  Hypothesis f_wf : forall n b, well_formed_comp (f n b).

  Section TwoWorldsEquiv_eta.
    Variable eta : nat.

    Definition StandardDef_G :=
      b <-$ {0, 1};
      b' <-$ f eta b;
      ret (eqb b b').

    Theorem StandardDef_equiv_2W_h :
      | Pr[StandardDef_G] - 1 / 2 | == (1 / 2) * | Pr[f eta true] - Pr[f eta false] |.

      unfold StandardDef_G.

      rewrite rndBool_bind.

      assert ( Pr[b' <-$ f eta true; ret eqb true b'] == Pr[f eta true]).
      symmetry.
      rewrite <- evalDist_right_ident.
      comp_skip.
      fcf_compute.
      rewrite H.
      clear H.

      assert ( Pr  [b' <-$ f eta false; ret eqb false b' ] == (ratSubtract 1 (Pr[f eta false]))).
      assert (Pr  [b' <-$ f eta false; ret eqb false b' ]  == evalDist (f eta false) false).
      symmetry.
      rewrite <- evalDist_right_ident.
      comp_skip.
      fcf_compute.
      rewrite H.
      clear H.

      eapply evalDist_bool_complement.
      wftac.

      rewrite H.
      clear H.

      rewrite <- ratMult_distrib.
      rewrite <- (ratMult_1_r (1/2)) at 2.

      rewrite ratMult_ratDistance_factor_l.
      eapply ratMult_eqRat_compat; intuition.

      assert ((Pr  [f eta false])  + ratSubtract 1 (Pr  [f eta false]) == 1).
      rewrite <- ratSubtract_ratAdd_assoc.
      eapply ratSubtract_ratAdd_inverse.

      eapply evalDist_le_1.
      unfold eq_dec.

      rewrite <- H at 2.

      rewrite ratDistance_add_same_r.
      reflexivity.

      Grab Existential Variables.
      exact _.
      exact _.
    Qed.

    Theorem Def_equiv_2W :
      | Pr[StandardDef_G] - 1 / 2 | == (1 / 2) * | Pr[f eta false] - Pr[f eta true] |.

      rewrite StandardDef_equiv_2W_h.
      rewrite ratDistance_comm.
      intuition.

    Qed.

    End TwoWorldsEquiv_eta.

    Theorem TwoWorlds_equiv_f :
      negligible (fun eta => (| Pr[f eta false] - Pr[f eta true] |)) ->
      negligible (fun eta => | Pr[StandardDef_G eta] - 1 / 2 |).

      unfold negligible.
      intuition.
      destruct (H c).
      exists x.
      intuition.
      eapply H0.
      intuition.
      rewrite H2.
      rewrite Def_equiv_2W.

      rewrite ratMult_comm.
      eapply ratMult_small_le.

      eapply rat_le_1.
      simpl.
      omega.

    Qed.

    Theorem TwoWorlds_equiv_b :
      negligible (fun eta => | Pr[StandardDef_G eta] - 1 / 2 |) ->
      negligible (fun eta => (| Pr[f eta false] - Pr[f eta true] |)).

      unfold negligible.
      intuition.
      edestruct (H (1 + c)%nat).
      exists (S x)%nat.
      intuition.
      eapply H0.
      omega.

      assert ((RatIntro (S O)
        (@natToPosnat (expnat x0 (plus (S O) c))
           (@expnat_nz (plus (S O) c) x0 pf_nz))) == (1 / x0) * (1 / (expnat x0 c))).

      simpl.
      rewrite <- ratMult_denom.
      eapply eqRat_terms; intuition.

      rewrite H3.
      clear H3.
      rewrite H2.

      eapply leRat_trans.
      2:{
        eapply eqRat_impl_leRat.
        symmetry.
        eapply Def_equiv_2W.
      }

      eapply ratMult_leRat_compat; intuition.
      unfold leRat.
      eapply leRat_terms; intuition.
      unfold natToPosnat, posnatToNat.
      omega.

    Qed.

    Theorem TwoWorlds_equiv :
      negligible (fun eta => (| Pr[f eta false] - Pr[f eta true] |)) <->
      negligible (fun eta => | Pr[StandardDef_G eta] - 1 / 2 |).

      intuition.
      eapply TwoWorlds_equiv_f; intuition.
      eapply TwoWorlds_equiv_b; intuition.

    Qed.

End TwoWorldsEquiv.