Require Import Setoid Morphisms.
Require Export Coq.Classes.Equivalence.
Open Scope equiv_scope.

Generalizable All Variables.

(** * Ordered Types

   This file corresponds to OrderedType.v in the standard FSets/FMaps
   library. It contains a formalization of types equipped with a total
   and decidable order.
   Notations on ordered types are defined in scope [compare_scope],
   delimited by key [compare].
   *)
Delimit Scope compare_scope with compare.

(** ** Strict orders : the [StrictOrder] class

   A strict order [lt] with respect to an equivalence relation [eq]
   on a type [A] is an antireflexive transitive relation, ie. it
   is a transitive relation that does not contain two congruent terms.
   We define the class [StrictOrder A lt eq] of such objects.
   *)
Class StrictOrder {A} lt eq {equiv : Equivalence eq} := {
  StrictOrder_Transitive :> Transitive lt;
  StrictOrder_Irreflexive : forall (x y : A), lt x y -> x =/= y
}.
Definition lt_StrictOrder `{StrictOrder A lt_ eq_} := lt_.

(** If [x] and [y] belong to a strict order, we define the
   notations [x >>> y] and [y <<< x]. *)
Notation " x >>> y " := (lt_StrictOrder y x)
  (at level 70, no associativity, only parsing) : compare_scope.
Notation " x <<< y " := (lt_StrictOrder x y)
  (at level 70, no associativity) : compare_scope.
Open Scope compare_scope.

(** A couple of useful basic properties about strict orders. *)
Set Implicit Arguments. Unset Strict Implicit.
Section StrictOrderProps.
  Context `{StrictOrder A}.

  Property lt_antirefl : forall x, ~x <<< x.
  Proof using .
    intros; intro Hlt; apply (StrictOrder_Irreflexive x x Hlt); reflexivity.
  Qed.
  Property lt_not_eq : forall x y, x <<< y -> x =/= y.
  Proof using .
    intros; apply StrictOrder_Irreflexive; auto.
  Qed.
  Property gt_not_eq : forall x y, x >>> y -> x =/= y.
  Proof using .
    intros; intro abs; symmetry in abs; revert abs; apply lt_not_eq; auto.
  Qed.
  Property eq_not_lt : forall x y, x === y -> ~ x <<< y.
  Proof using .
    intros; intro abs; apply (lt_not_eq abs); auto.
  Qed.
  Property eq_not_gt : forall x y, x === y -> ~ x >>> y.
  Proof using .
    intros; intro abs; apply (gt_not_eq abs); auto.
  Qed.
  Property lt_not_gt : forall x y, x <<< y -> ~(x >>> y).
  Proof using .
    intros; intro abs; refine (lt_not_eq _ _).
    apply transitivity with y; eauto. reflexivity.
  Qed.
End StrictOrderProps.
Unset Implicit Arguments.

(** ** Ordered types : the [OrderedType] class

   [OrderedType] is the class of types that enjoy decidable comparison for
   a given setoid equality and strict order relation with respect to this
   equality. An instance of [OrderedType] for a type [A] must bring :
   - the equality relation [eq]
   - a proof that [eq] is an equivalence relation
   - the order relation [lt]
   - an instance of [StrictOrder] for [lt] and [eq]
   - a comparison function [cmp : A -> A -> comparison]
   - a proof that [cmp] really implements [lt] and [eq]

   With respect to the original formalization in the FSets/FMaps library,
   the fundamental difference is that the comparison function is purely
   computational, whereas the return type of the [compare] function in
   [FSets.OrderedType] includes proofs. In that sense, this formalisation
   is more similar to [FSets.OrderedTypeAlt]. To define the specification
   that the function [cmp] must meet, unlike [OrderedTypeAlt], we use
   the following inductive view [compare_spec] :
   *)
Inductive compare_spec {A} eq lt (x y : A) : comparison -> Prop :=
| compare_spec_lt : lt x y -> compare_spec eq lt x y Lt
| compare_spec_eq : eq x y -> compare_spec eq lt x y Eq
| compare_spec_gt : lt y x -> compare_spec eq lt x y Gt.

(** [compare_spec] describes what is the correct result for a comparison
   between two elements [x] and [y] ; in particular, a suitable comparison
   function is a function that is included in this relation.

   Given these definitions, we can now define the [OrderedType] class.
   *)
Class OrderedType (A : Type) := {
  _eq : relation A;
  _lt : relation A;
  OT_Equivalence :> Equivalence _eq;
  OT_StrictOrder :> StrictOrder _lt _eq;
  _cmp : A -> A -> comparison;
  _compare_spec : forall x y, compare_spec _eq _lt x y (_cmp x y)
}.

(** If [x] and [y] belong to an ordered type [A], we can write [compare x y]
   to denote the comparison of [x] and [y], as well as the special handy
   notation [x =?= y]. *)
Definition compare `{OrderedType A} := _cmp.
Notation " x =?= y " :=
  (compare (x :>) (y :>)) (no associativity, at level 70) : compare_scope.

(** The following lemma is a convenient way to access the specification of
   the [compare] function. Its typical use is the following : if a comparison
   [x =?= y] appears in the Coq context, [destruct (compare_dec x y)] will
   create 3 branches for each result of the comparison, and add the correct
   hypothesis in each branch. It is almost as easy to work with as the
   original dependently-typed [OrderedType.compare] function.
   *)
Definition compare_dec `{H : OrderedType A} :
  forall x y, compare_spec equiv lt_StrictOrder x y (compare x y) :=
    @_compare_spec A H.

(** [compare] is made globally opaque so that case analysis can be done
   easily by destructing [compare_dec _ _]. *)
Global Opaque compare.

(** We define shortcut notations [x == y], [x << y] and [x >> y]
   for purely computational equality and ordering tests, and
   their specification as well. *)
Definition is_compare `{OrderedType A} (x y : A) c :=
  match x =?= y, c with
    | Eq, Eq | Lt, Lt | Gt, Gt => true
    | _, _ => false
  end.
Notation " x == y " :=
  (is_compare x y Eq) (no associativity, at level 70) : compare_scope.
Notation " x << y " :=
  (is_compare x y Lt) (no associativity, at level 70) : compare_scope.
Notation " x >> y " :=
  (is_compare x y Gt) (no associativity, at level 70) : compare_scope.

Property compare_1 `{OrderedType A} : forall x y, x =?= y = Lt -> x <<< y.
Proof using .
  intros; destruct (compare_dec x y); auto; congruence.
Qed.
Property compare_2 `{OrderedType A} : forall x y, x =?= y = Eq -> x === y.
Proof using .
  intros; destruct (compare_dec x y); auto; congruence.
Qed.
Property compare_3 `{OrderedType A} : forall x y, x =?= y = Gt -> x >>> y.
Proof using .
  intros; destruct (compare_dec x y); auto; congruence.
Qed.

(** Decidability lemmas for equality and orders, specified in a way
   similar to [compare_spec]. *)
Inductive decides {A} (R : relation A) (x y : A) : bool -> Prop :=
| decides_true : R x y -> decides R x y true
| decides_false : ~(R x y) -> decides R x y false.

Property eq_dec `{OrderedType A} :
  forall (x y : A), decides equiv x y (x==y).
Proof using .
  intros; unfold is_compare. destruct (compare_dec x y); constructor.
  apply lt_not_eq; auto.
  assumption.
  apply gt_not_eq; auto.
Qed.
Property lt_dec `{OrderedType A} :
  forall x y, decides lt_StrictOrder x y (x<<y).
Proof using .
  intros; unfold is_compare. destruct (compare_dec x y); constructor.
  assumption.
  intro abs; apply (lt_not_eq abs); auto.
  apply lt_not_gt; auto.
Qed.
Property gt_dec `{OrderedType A} :
  forall x y, decides lt_StrictOrder y x (x>>y).
Proof using .
  intros; unfold is_compare. destruct (compare_dec x y); constructor.
  apply lt_not_gt; auto.
  intro abs; apply (gt_not_eq abs); auto.
  assumption.
Qed.

(** More lemmas about ordered types, in particular the fact that
   the order relations are morphisms for equality. *)
Set Implicit Arguments. Unset Strict Implicit.
Property eq_lt `{OrderedType A} :
  forall (x x' y : A), x === x' -> x <<< y -> x' <<< y.
Proof using .
  intros; destruct (compare_dec x' y); auto.
  contradiction (lt_not_eq H1); transitivity x'; auto.
  contradiction (lt_not_eq (x:=x) (y:=x')); auto; transitivity y; auto.
Qed.
Corollary eq_lt2 `{OrderedType A} :
  forall (x x' y : A), x === x' -> x' <<< y -> x <<< y.
Proof using .
  intros; apply eq_lt with x'; auto; symmetry; auto.
Qed.
Property eq_gt `{OrderedType A} :
  forall (x x' y : A), x === x' -> x >>> y -> x' >>> y.
Proof using .
  intros; destruct (compare_dec x' y); auto.
  contradiction (gt_not_eq (x:=x) (y:=x')); auto; transitivity y; auto.
  contradiction (gt_not_eq H1); transitivity x'; auto.
Qed.
Instance lt_m `{OrderedType A} : Proper (_eq ==> _eq ==> iff) _lt.
Proof using .
  repeat intro; split; intro Hlt.
  apply (eq_lt (x:=x)); auto. apply (eq_gt (x:=x0)); auto.
  apply (eq_lt (x:=y)); try symmetry; auto.
  apply (eq_gt (x:=y0)); try symmetry; auto.
Qed.
Instance le_m `{OrderedType A} : Proper (_eq ==> _eq ==> iff) (complement _lt).
Proof using .
  repeat intro; split; intro Hlt; unfold complement in  *.
  rewrite H1 in Hlt; rewrite H0 in Hlt; assumption.
  rewrite H0, H1; assumption.
Qed.

(** Shortcut lemmas for the [order] tactic *)
Section OrderLemmas.
  Context `{OrderedType A}.
  Variables x y z : A.

  Corollary lt_eq : x <<< y -> y === z -> x <<< z.
  Proof using .
    intros; rewrite <- H1; assumption.
  Qed.
  Corollary le_eq : ~x <<< y -> y === z -> ~x <<< z.
  Proof using .
    intros; rewrite <- H1; assumption.
  Qed.
  Corollary eq_le : x === y -> ~y <<< z -> ~x <<< z.
  Proof using .
    intros; rewrite H0; assumption.
  Qed.
  Corollary neq_eq : x =/= y -> y === z -> x =/= z.
  Proof using .
    intros; rewrite <- H1; assumption.
  Qed.
  Corollary eq_neq : x === y -> y =/= z -> x =/= z.
  Proof using .
    intros; rewrite H0; assumption.
  Qed.

  Property le_lt_trans : ~ y <<< x -> y <<< z -> x <<< z.
  Proof using .
    intros; destruct (compare_dec x z); auto.
    rewrite <- H2 in H1; contradiction.
    contradiction H0; transitivity z; auto.
  Qed.
  Property lt_le_trans : x <<< y -> ~ z <<< y -> x <<< z.
  Proof using .
    intros; destruct (compare_dec x z); auto.
    rewrite <- H2 in H1; contradiction.
    contradiction H1; transitivity x; auto.
  Qed.
  Property le_neq : ~x <<< y -> x =/= y -> x >>> y.
  Proof using .
    intros; destruct (compare_dec x y); auto; contradiction.
  Qed.

  Lemma elim_compare_eq : x === y -> x =?= y = Eq.
  Proof using .
    intros; destruct (compare_dec x y); auto.
    contradiction (lt_not_eq H1 H0).
    contradiction (lt_not_eq H1 (symmetry H0)).
  Qed.
  Lemma elim_compare_lt : x <<< y -> x =?= y = Lt.
  Proof using .
    intros; destruct (compare_dec x y); auto.
    contradiction (lt_not_eq H0 H1).
    contradiction (lt_not_gt H1 H0).
  Qed.
  Lemma elim_compare_gt : x >>> y -> x =?= y = Gt.
  Proof using .
    intros; destruct (compare_dec x y); auto.
    contradiction (lt_not_gt H1 H0).
    contradiction (gt_not_eq H0 H1).
  Qed.
End OrderLemmas.
Unset Implicit Arguments.

(** The following is the adaptation of the original [order] tactic
   developed by P. Letouzey in the original library. It should
   prove exactly the same goals, with a slight decrease in performance
   due to the extra implicit instance parameters.
   *)
Ltac normalize_notations :=
  match goal with
 | H : ?R ?x ?y |- _ =>
   progress ((change (x === y) in H) || (change (x <<< y) in H) ||
     (change (x >>> y) in H)); normalize_notations
 | H : ~(?R ?x ?y) |- _ =>
   progress ((change (x =/= y) in H) || (change (~ x <<< y) in H) ||
     (change (~ y <<< x) in H)); normalize_notations
 | |- ?R ?x ?y =>
   progress (change (x === y) || change (x <<< y) || change (y <<< x))
 | |- ~?R ?x ?y =>
   progress (change (x =/= y) || change (~x <<< y) || change (~y <<< x))
 | _ => idtac
  end.

Ltac abstraction := match goal with
 | H : False |- _ => elim H
 | H : ?x <<< ?x |- _ => elim (lt_antirefl H)
 | H : ?x =/= ?x |- _ => elim (H (reflexivity x))
 | H : ?x === ?x |- _ => clear H; abstraction
 | H : ~?x <<< ?x |- _ => clear H; abstraction
 | |- ?x === ?x => reflexivity
 | |- ?x <<< ?x => elimtype False; abstraction
 | |- ~ _ => intro; abstraction
 | H1: ~?x <<< ?y, H2: ?x =/= ?y |- _ =>
     generalize (le_neq H1 H2); clear H1 H2; intro; abstraction
 | H1: ~?x <<< ?y, H2: ?y =/= ?x |- _ =>
     symmetry in H2; generalize (le_neq H1 H2);
       clear H1 H2; intro; abstraction
 | H : ?x =/= ?y |- _ => revert H; abstraction
 | H : ~?x <<< ?y |- _ => revert H; abstraction
 | H : ?x <<< ?y |- _ => revert H; abstraction
 | H : ?x === ?y |- _ => revert H; abstraction
 | _ => idtac
end.

Ltac do_eq a b EQ := match goal with
 | |- ?x <<< ?y -> _ => let H := fresh "H" in
     (intro H;
      (generalize (eq_lt EQ H); clear H; intro H) ||
      (generalize (lt_eq H EQ); clear H; intro H) ||
      idtac);
      do_eq a b EQ
 | |- ~?x <<< ?y -> _ => let H := fresh "H" in
     (intro H;
      (generalize (eq_le (symmetry EQ) H); clear H; intro H) ||
      (generalize (le_eq H EQ); clear H; intro H) ||
      idtac);
      do_eq a b EQ
 | |- ?x === ?y -> _ => let H := fresh "H" in
     (intro H;
      (generalize (transitivity (symmetry EQ) H); clear H; intro H) ||
      (generalize (transitivity H EQ); clear H; intro H) ||
      idtac);
      do_eq a b EQ
 | |- ?x =/= ?y -> _ => let H := fresh "H" in
     (intro H;
      (generalize (eq_neq (symmetry EQ) H); clear H; intro H) ||
      (generalize (neq_eq H EQ); clear H; intro H) ||
      idtac);
      do_eq a b EQ
 | |- a <<< ?y => apply eq_lt with b; [exact (symmetry EQ)|]
 | |- ?y <<< a => apply lt_eq with b; [|exact (symmetry EQ)]
 | |- a === ?y => transitivity b; [exact EQ|]
 | |- ?y === a => transitivity b; [|exact (symmetry EQ)]
 | _ => idtac
 end.

Ltac propagate_eq := abstraction; match goal with
 | |- ?a === ?b -> _ =>
     let EQ := fresh "EQ" in (intro EQ; do_eq a b EQ; clear EQ);
     propagate_eq
 | _ => idtac
end.

(* Example test `{OrderedType A} : *)
(*   forall (x x' x'' x''' y a b c d e f g h : A), *)
(*     x === x -> x === x' -> x' === x'' -> *)
(*     x =/= y -> b =/= x -> *)
(*     y >>> x -> c <<< x -> *)
(*     x'' === x''' -> *)
(*     ~a >>> x -> ~d <<< x -> *)
(*     e === x -> x === e -> *)
(*     f >>> x. *)
(* Proof. *)
(*   intros. *)
(*   propagate_eq. *)

Ltac do_lt x y LT := match goal with
 | |- x <<< y -> _ => intros _; do_lt x y LT
 | |- y <<< ?z -> _ => let H := fresh "H" in
     (intro H; generalize (transitivity LT H); intro); do_lt x y LT
 | |- ?z <<< x -> _ => let H := fresh "H" in
     (intro H; generalize (transitivity H LT); intro); do_lt x y LT
 | |- _ <<< _ -> _ => intro; do_lt x y LT

 | |- ~y <<< x -> _ => intros _; do_lt x y LT
 | |- ~x <<< ?z -> _ => let H := fresh "H" in
     (intro H; generalize (le_lt_trans H LT); intro); do_lt x y LT
 | |- ~?z <<< y -> _ => let H := fresh "H" in
     (intro H; generalize (lt_le_trans LT H); intro); do_lt x y LT
 | |- ~_ <<< _ -> _ => intro; do_lt x y LT
 | _ => idtac
 end.

Definition hide_lt `{StrictOrder A lt_ eq_} := lt_StrictOrder.

Ltac propagate_lt := abstraction; match goal with
 | |- ?x <<< ?y -> _ =>
     let LT := fresh "LT" in
       (intro LT; do_lt x y LT; change (hide_lt x y) in LT);
       propagate_lt
 | _ => unfold hide_lt in *
end.

Ltac order :=
 intros;
 normalize_notations;
 abstraction;
 propagate_eq;
 propagate_lt;
 auto;
 propagate_lt;
 eauto.

Ltac false_order := elimtype False; order.

Hint Extern 0 (_eq _ _) => reflexivity.
Hint Extern 0 (_ === _) => reflexivity.
Hint Extern 2 (_eq _ _) => symmetry; assumption.
Hint Extern 2 (_ === _) => symmetry; assumption.
Hint Extern 1 (Equivalence _) => constructor; congruence.
Hint Extern 1 (Equivalence _) => apply OT_Equivalence.
Hint Extern 1 (StrictOrder _) => apply OT_StrictOrder.
Hint Extern 1 (RelationClasses.StrictOrder _) =>
  constructor; repeat intro; order.
Hint Extern 1 (Proper _ _) => apply lt_m.
Hint Extern 1 (Proper _ _) => repeat intro; intuition order.

(** ** Specific Ordered types : [OrderedType] with specific equality

   Sometimes, one wants to consider ordered types where the equality
   has to be Leibniz equality or any other specific equality. Because there
   is no 'with' construct for  typeclasses, as there is for modules, we
   define another class for these types and show that such types
   also match [OrderedType]. An alternative would be to take the equality
   relation ouf of the [OrderedType] instance and add it as a parameter.
*)
Class SpecificOrderedType
  (A : Type) (eqA : relation A) := {
  SOT_Equivalence :> Equivalence eqA ;
  SOT_lt : relation A;
  SOT_StrictOrder : StrictOrder SOT_lt eqA;
  SOT_cmp : A -> A -> comparison;
  SOT_compare_spec : forall x y, compare_spec eqA SOT_lt x y (SOT_cmp x y)
}.
Instance SOT_as_OT `{SpecificOrderedType A} : OrderedType A := {
  _eq := eqA;
  OT_StrictOrder := SOT_StrictOrder;
  _compare_spec := SOT_compare_spec
}.
Instance SOT_SO_to_SO `{SpecificOrderedType A eqA} : StrictOrder SOT_lt eqA | 4.
Proof.
  intros; apply SOT_StrictOrder.
Defined.

(** ** Usual Ordered types : [OrderedType] with Leibniz equality

   A typical case is to require an instance of [OrderedType] where the equality
   is the Leibniz equality. We define the notation [UsualOrderedType] for that
   purpose.
   *)
Notation "'UsualOrderedType' A" :=
  (SpecificOrderedType A (@eq A))(at level 30).

(** * Facts about setoid list membership

   The remainer of this file correspond to the final section
   of the [OrderedTypeFacts] functor and the [KeyOrderedType] functor.
   They are used especially in [SetList] and [MapList].
   *)
Set Implicit Arguments. Unset Strict Implicit.
Require Import SetoidList.
Section ForNotations.
  Notation In:=(InA _eq).
  Notation Inf:=(lelistA _lt).
  Notation Sort:=(sort _lt).
  Notation NoDup:=(NoDupA _eq).

  Context `{Helt : OrderedType elt}.
  Implicit Types x y : elt.

  Lemma In_eq : forall l x y, x === y -> In x l -> In y l.
  Proof using . apply InA_eqA; eauto with typeclass_instances. Qed.

  Lemma ListIn_In : forall l x, List.In x l -> In x l.
  Proof using . apply In_InA; eauto with typeclass_instances. Qed.

  Lemma Inf_lt : forall l x y, x <<< y -> Inf y l -> Inf x l.
  Proof using .
    apply InfA_ltA; constructor; repeat intro; order.
  Qed.

  Lemma Inf_eq : forall l x y, x === y -> Inf y l -> Inf x l.
  Proof using .
    apply InfA_eqA; eauto with typeclass_instances.
  Qed.

  Lemma Sort_Inf_In : forall l x a, Sort l -> Inf a l -> In x l -> a <<< x.
  Proof using .
    apply SortA_InfA_InA; eauto with typeclass_instances.
  Qed.

  Lemma ListIn_Inf : forall l x, (forall y, List.In y l -> x <<< y) -> Inf x l.
  Proof using . exact (@In_InfA _ _lt). Qed.

  Lemma In_Inf : forall l x, (forall y, In y l -> x <<< y) -> Inf x l.
  Proof using .
    apply InA_InfA; eauto with typeclass_instances.
  Qed.

  Lemma Inf_alt :
    forall l x, Sort l -> (Inf x l <-> (forall y, In y l -> x <<< y)).
  Proof using .
    apply InfA_alt; eauto with typeclass_instances.
  Qed.

  Lemma Sort_NoDup : forall l, Sort l -> NoDup l.
  Proof using .
    apply SortA_NoDupA; eauto with typeclass_instances.
  Qed.
End ForNotations.
Unset Implicit Arguments.
Hint Resolve @ListIn_In @Sort_NoDup @Inf_lt.
Hint Immediate @In_eq @Inf_lt.

Module KeyOrderedType.
Section KeyOrderedType.
  Set Implicit Arguments.
  Unset Strict Implicit.

  Variable key : Type.
  Hypothesis (key_OT : OrderedType key).
  Variable elt : Type.

  Definition eqk (p p':key*elt) := fst p === fst p'.
  Definition eqke (p p':key*elt) :=
    fst p === fst p' /\ (snd p) = (snd p').
  Definition ltk (p p':key*elt) := fst p <<< fst p'.

  Local Instance eqk_Equiv : Equivalence eqk.
  Proof using .
    constructor; repeat intro; unfold eqk in *; eauto.
    transitivity (fst y); auto.
  Qed.
  Local Instance eqke_Equiv : Equivalence eqke.
  Proof using .
    constructor; repeat intro; unfold eqke in *; intuition.
    transitivity (fst y); auto.
    congruence.
  Qed.
  Local Instance ltk_SO : RelationClasses.StrictOrder ltk.
  Proof using .
    constructor; repeat intro; unfold ltk in *; intuition order.
  Qed.
  Local Instance ltk_m : Proper (eqk ==> eqk ==> iff) ltk.
  Proof using .
    repeat intro; unfold ltk, eqk in *; intuition order.
  Qed.
  Ltac teauto := eauto with typeclass_instances.

  Hint Unfold eqk eqke ltk.
  Hint Extern 2 (eqke ?a ?b) => split.

  (* eqke is stricter than eqk *)
  Lemma eqke_eqk : forall x x', eqke x x' -> eqk x x'.
  Proof using .
    unfold eqk, eqke; intuition.
  Qed.

  (* ltk ignore the second components *)
  Lemma ltk_right_r : forall x k e e', ltk x (k,e) -> ltk x (k,e').
  Proof using . auto. Qed.

  Lemma ltk_right_l : forall x k e e', ltk (k,e) x -> ltk (k,e') x.
  Proof using . auto. Qed.
  Hint Immediate ltk_right_r ltk_right_l.

  (* eqk, eqke are equalities, ltk is a strict order *)
  Lemma eqk_refl : forall e, eqk e e.
  Proof using . auto. Qed.

  Lemma eqke_refl : forall e, eqke e e.
  Proof using . auto. Qed.

  Lemma eqk_sym : forall e e', eqk e e' -> eqk e' e.
  Proof using . auto. Qed.

  Lemma eqke_sym : forall e e', eqke e e' -> eqke e' e.
  Proof using . unfold eqke; intuition. Qed.

  Lemma eqk_trans : forall e e' e'', eqk e e' -> eqk e' e'' -> eqk e e''.
  Proof using .
    intros; unfold eqk in *; auto; transitivity (fst e'); auto.
  Qed.

  Lemma eqke_trans : forall e e' e'', eqke e e' -> eqke e' e'' -> eqke e e''.
  Proof using .
    unfold eqke; intuition; [ eauto | congruence ].
    transitivity (fst (a0, b0)); auto.
  Qed.

  Lemma ltk_trans : forall e e' e'', ltk e e' -> ltk e' e'' -> ltk e e''.
  Proof using .
    intros; unfold ltk in *; auto; transitivity (fst e'); auto.
  Qed.

  Lemma ltk_not_eqk : forall e e', ltk e e' -> ~ eqk e e'.
  Proof using .
    unfold eqk, ltk; auto; intros; apply lt_not_eq; auto.
  Qed.

  Lemma ltk_not_eqke : forall e e', ltk e e' -> ~eqke e e'.
  Proof using .
    unfold eqke, ltk; intuition; simpl in *; subst.
    exact (lt_not_eq H H1).
  Qed.

  Hint Resolve eqk_trans eqke_trans eqk_refl eqke_refl.
  Hint Resolve ltk_trans ltk_not_eqk ltk_not_eqke.
  Hint Immediate eqk_sym eqke_sym.

  (* Additionnal facts *)

  Lemma eqk_not_ltk : forall x x', eqk x x' -> ~ltk x x'.
  Proof using .
    unfold eqk, ltk; simpl; auto.
    intros; apply eq_not_lt; auto.
  Qed.

  Lemma ltk_eqk : forall e e' e'', ltk e e' -> eqk e' e'' -> ltk e e''.
  Proof using .
    intros; unfold ltk, eqk in *; auto; order.
  Qed.

  Lemma eqk_ltk : forall e e' e'', eqk e e' -> ltk e' e'' -> ltk e e''.
  Proof using .
      intros (k,e) (k',e') (k'',e'').
      unfold ltk, eqk; simpl; eauto; order.
  Qed.
  Hint Resolve eqk_not_ltk.
  Hint Immediate ltk_eqk eqk_ltk.

  Lemma InA_eqke_eqk :
     forall x m, InA eqke x m -> InA eqk x m.
  Proof using .
    unfold eqke; induction 1; intuition.
  Qed.
  Hint Resolve InA_eqke_eqk.

  Definition MapsTo (k:key)(e:elt):= InA eqke (k,e).
  Definition In k m := exists e:elt, MapsTo k e m.
  Notation Sort := (sort ltk).
  Notation Inf := (lelistA ltk).

  Hint Unfold MapsTo In.

  (* An alternative formulation for [In k l] is [exists e, InA eqk (k,e) l] *)
  Lemma In_alt : forall k l, In k l <-> exists e, InA eqk (k,e) l.
  Proof using .
    firstorder.
    exists x; auto.
    induction H.
    destruct y.
    exists e; auto.
    destruct IHInA as [e H0].
    exists e; auto.
  Qed.

  Lemma MapsTo_eq : forall l x y e, x === y -> MapsTo x e l -> MapsTo y e l.
  Proof using .
    intros; unfold MapsTo in *; apply InA_eqA with (x,e); teauto.
  Qed.

  Lemma In_eq : forall l x y, x === y -> In x l -> In y l.
  Proof using .
    destruct 2 as (e,E); exists e; eapply MapsTo_eq; eauto.
  Qed.

  Lemma Inf_eq : forall l x x', eqk x x' -> Inf x' l -> Inf x l.
  Proof using . apply InfA_eqA; teauto. Qed.

  Lemma Inf_lt : forall l x x', ltk x x' -> Inf x' l -> Inf x l.
  Proof using . apply InfA_ltA; teauto. Qed.

  Hint Immediate Inf_eq.
  Hint Resolve Inf_lt.

  Lemma Sort_Inf_In :
      forall l p q, Sort l -> Inf q l -> InA eqk p l -> ltk q p.
  Proof using .
    apply SortA_InfA_InA; teauto.
  Qed.

  Lemma Sort_Inf_NotIn :
      forall l k e, Sort l -> Inf (k,e) l ->  ~In k l.
  Proof using .
    intros; red; intros.
    destruct H1 as [e' H2].
    elim (@ltk_not_eqk (k,e) (k,e')).
    eapply Sort_Inf_In; eauto.
    red; simpl; auto.
  Qed.

  Lemma Sort_NoDupA: forall l, Sort l -> NoDupA eqk l.
  Proof using .
    apply SortA_NoDupA; teauto.
  Qed.

  Lemma Sort_In_cons_1 : forall e l e', Sort (e::l) -> InA eqk e' l -> ltk e e'.
  Proof using .
   inversion 1; intros; eapply Sort_Inf_In; eauto.
  Qed.

  Lemma Sort_In_cons_2 : forall l e e', Sort (e::l) -> InA eqk e' (e::l) ->
      ltk e e' \/ eqk e e'.
  Proof using .
    inversion_clear 2; auto.
    left; apply Sort_In_cons_1 with l; auto.
  Qed.

  Lemma Sort_In_cons_3 :
    forall x l k e, Sort ((k,e)::l) -> In x l -> x =/= k.
  Proof using .
    inversion_clear 1; red; intros.
    exact (Sort_Inf_NotIn H0 H1 (In_eq H2 H)).
  Qed.

  Lemma In_inv : forall k k' e l, In k ((k',e) :: l) -> k === k' \/ In k l.
  Proof using .
    inversion 1.
    inversion_clear H0; eauto.
    destruct H1; simpl in *; intuition.
  Qed.

  Lemma In_inv_2 : forall k k' e e' l,
      InA eqk (k, e) ((k', e') :: l) -> k =/= k' -> InA eqk (k, e) l.
  Proof using .
   inversion_clear 1; unfold eqk in H0; simpl in H0; order.
  Qed.

  Lemma In_inv_3 : forall x x' l,
      InA eqke x (x' :: l) -> ~eqk x x' -> InA eqke x l.
  Proof using .
   inversion_clear 1; compute in H0; intuition.
  Qed.

End KeyOrderedType.
Hint Unfold eqk eqke ltk.
Hint Extern 2 (eqke ?a ?b) => split.
Hint Resolve eqk_trans eqke_trans eqk_refl eqke_refl.
Hint Resolve ltk_trans ltk_not_eqk ltk_not_eqke.
Hint Immediate eqk_sym eqke_sym.
Hint Resolve eqk_not_ltk.
Hint Immediate ltk_eqk eqk_ltk.
Hint Resolve InA_eqke_eqk.
Hint Unfold MapsTo In.
Hint Immediate Inf_eq.
Hint Resolve Inf_lt.
Hint Resolve Sort_Inf_NotIn.
Hint Resolve In_inv_2 In_inv_3.

Arguments eqk [key] [key_OT] [elt].
Arguments eqke [key] [key_OT] [elt].
Arguments ltk [key] [key_OT] [elt].
Arguments MapsTo [key] [key_OT] [elt].
Arguments In [key] [key_OT] [elt].
End KeyOrderedType.


Set Implicit Arguments.

Inductive exp : Set :=
| Nat : nat -> exp
| Plus : exp -> exp -> exp
| Bool : bool -> exp
| And : exp -> exp -> exp.

Inductive type : Set := TNat | TBool.

Locate "+".

Print sumbool.

(*
Inductive sumbool (A B : Prop) : Set :=
    left : A -> {A} + {B} | right : B -> {A} + {B}
*)

Definition eq_type_dec: forall (t1 t2:type), {t1=t2}+{t1<>t2}.
decide equality.
Qed.

Print eq_type_dec.

Inductive hasType : exp -> type -> Prop :=
| HtNat : forall n,
  hasType (Nat n) TNat
| HtPlus : forall e1 e2,
  hasType e1 TNat
  -> hasType e2 TNat
  -> hasType (Plus e1 e2) TNat
| HtBool : forall b,
  hasType (Bool b) TBool
| HtAnd : forall e1 e2,
  hasType e1 TBool
  -> hasType e2 TBool
  -> hasType (And e1 e2) TBool.

Lemma hasType_det : forall e t1, hasType e t1 ->
 forall t2, hasType e t2 -> t1 = t2.
  induction e.
  inversion 1.
  inversion 1;auto.
  inversion 1.
  inversion 1;auto.
  inversion 1.
  inversion 1;auto.
  inversion 1.
  inversion 1;auto.
Restart.
  induction 1.
  inversion 1; auto.
  inversion 1;auto.
  inversion 1;auto.
  inversion 1;auto.
Restart.
  induction 1;  inversion 1; auto.
Qed.


(** Church Number ~ nat *)

Require Import Arith.
Require Export FunctionalExtensionality.
Require Export ProofIrrelevance.

Notation cnat_ctt := (forall (X : Type), (X -> X) -> X -> X).

    Inductive valid_cnat : cnat_ctt -> Prop :=
    | Ocnat : valid_cnat (fun (X : Type) (f : X -> X) (x : X) => x)
    | Scnat (c : cnat_ctt) (H : valid_cnat c) : valid_cnat (fun (X : Type) (f : X -> X) (x : X) => f (c X f x)).

    (** There is a practical example: Church numbers. *)
    Record cnat := mk_cnat {
        cn :> cnat_ctt;
        cn_proof : valid_cnat cn;
    }.

    Lemma cnat_eq : forall c1 c2 : cnat, c1 = c2 <-> (cn c1) = (cn c2).
    Proof.
        move => c1 c2. split. by move => ->.
        destruct c1 as [c1 p1], c2 as [c2 p2] => //= H.
        move : p1 p2. rewrite H => p1 p2. by rewrite (proof_irrelevance _ p1 p2).
    Qed.

    Definition cnat2nat (c : cnat) : nat := c nat S O.

    Fixpoint nat2cnat_cn (n : nat) : forall X : Type, (X -> X) -> X -> X :=
        fun (X : Type) (f : X -> X) (x : X) =>
            match n with
            | O => x
            | S n' => f (nat2cnat_cn n' f x)
            end.

    Definition nat2cnat (n : nat) : cnat.
    Proof.
        refine (@mk_cnat (nat2cnat_cn n) _).
        elim: n. apply Ocnat.
        move => n IHn. apply Scnat. apply IHn.
    Defined.

    Lemma bijection_nat2cnat : bijective nat2cnat.
    Proof. apply inv_is_bij. rewrite /invertible. exists cnat2nat. split.

        elim => //=. move => n. by rewrite /cnat2nat => ->.

        move => [y Hy]. apply cnat_eq => //=.
        apply functional_extensionality_dep => X.
        apply functional_extensionality => f.
        apply functional_extensionality => x.
        elim : Hy => //=.
        move => c _ IHc.  by rewrite IHc.
    Qed.

    Theorem cnat_nat_iso : isomorphic nat cnat.
    Proof. exists nat2cnat. by apply bijection_nat2cnat. Qed.

    Theorem cnat_nat_eq : nat:Type = cnat.
    Proof. apply isomorphic_extensionality. by apply cnat_nat_iso. Qed.

    Coercion cnat2nat : cnat >-> nat.

    Coercion nat2cnat : nat >-> cnat.

    Compute (10 _ S 0).
    Compute (10 _ (fun x => 2*x + 1) 0).

Goal inhabited cnat.
Proof.
    Fail rewrite -cnat_nat_eq.
    (** M@GIC *)
    case cnat_nat_eq.
    constructor. by exact 1.
Qed.

(** This [theory_functor] can be considered as a `functor', meaning a `theory' about
    T. *)
    Definition theory_functor (T : Type) : Prop :=
        exists add_op : T -> T -> T, (forall a b, add_op a b = add_op b a).

    Lemma theory_functor_nat : theory_functor nat.
    Proof. exists Nat.add. apply Nat.add_comm. Qed.

    Lemma theory_functor_cnat : theory_functor cnat.
    Proof. case cnat_nat_eq. apply theory_functor_nat. Qed.

    (** We have transported the theories from [nat] to [cnat]. *)


(*
Adresse email des TDmen : [Prenom].[Nom]@ens-lyon.fr

Pour avoir les raccourcis comme il faut :
- Lancer "coqide"
- Edit > Preferences > Shortcuts > Modifiers for Navigation Menu
- Changer vers <alt> uniquement (en sélectionnant/désélectionnant les cases)
- Cliquer sur OK
- Quitter coqide
- Relancer coqide
*)

(* Table des matières du TP:
	1. Découverte de coq
	2. Démonstrations élémentaires
	3. Inductions structurelles
	4. Calcul Propositionnel
	5. Arithmétique *)

(** TP n°1 : Introduction à Coq **)

(** Partie 1 : Découverte de coq **)

(* Toutes les expressions bien formées de Coq ont un type que l'on
peut demander à l'interpréteur grâce à la commande "Check" : *)

Check 3. (* "nat" : type des entiers naturels *)
Check 2 + 2.
Check (plus 2 2). (* + est une notation "infixe" de la fonction plus *)
Check plus.  (* fonction qui prend deux "nat"s et renvoie un "nat" *)

(* Les types sont eux-mêmes des expressions bien formées de Coq, elles
ont donc également un type. *)

Check nat. (* "Set" est le type des types de données. *)

Check nat -> nat -> nat.

(* On peut également demander à Coq de nous donner la définition d'une
d'une expression déjà définie; on utilise pour ça la commande "Print". *)

Print nat.
Print plus.

(* On peut bien sûr définir de nouvelles fonctions *)

Definition facteur_deux (n : nat) := 2 * n.
Check facteur_deux.
Print facteur_deux.

(* Et on utilise la syntaxe suivante pour faire des définitions
récursives: *)

Fixpoint double (n : nat) :=
  match n with
    | 0 => 0
    | S p => S (S (double p))
  end.

Print double.

(* Sur le même modèle implémentez la fonction [somme_jusqu_a : nat -> nat] qui
calcule la somme des premiers entiers *)

Fixpoint somme_jusqu_a (n : nat ) :=
    match n with
    |0 => 0
    |S p => n + somme_jusqu_a p
    end.
(* ... Complétez ici ... *)

Eval compute in somme_jusqu_a 10.

(** Partie 2 : Démonstrations élementaires **)

(* En plus des types de données et des programmes, coq permet également
de manipuler des formules. À commencer par les égalités : *)

Check 0 = 0. (* "Prop" : type des formules logiques. *)
Check 0 = 1. (* "Prop" : type des formules logiques, même si elles sont fausses! *)

(* Enfin, Coq permet de prouver les formules à l'aide d'un système de
   "tactiques" de preuves.
   Voici la liste des tactiques que nous allons explorer:
    reflexivity , intros , simpl , rewrite , induction
    (l'utilisation de toute autre tactique, trouvée sur internet par exemple, est prohibée) *)
Lemma zero_egale_zero :
  0 = 0.
Proof.
reflexivity. (* Comme on le verra plus tard, c'est la tactique qui
                  résout les égalités triviales. *)
Qed.

Lemma deux_plus_deux_egale_quatre :
  2+2 = 4.
Proof.
simpl. (* Cette tactique nous sera très utile dans la suite, elle
                  sert à effectuer les pas de calcul dans les buts. *)
reflexivity.
Qed.

(* On dispose également de quantificateurs pour fabriquer les formules :*)
Check (forall x y : nat, x+y = y + x). (* Une formule qui nous dit que + est commutatif. *)

(* Il y a quelques tactiques qu'il faudra apprendre à utiliser.
   Voici un exemple de preuve un peu moins triviales. Pouvez-vous
   retranscrire cette preuve simple en "mathématiques informelles" ? *)

(* On dispose également d'une égalité entre les termes de
   coq qui vient avec trois tactiques pour les manipuler:
      - [reflexivity] : permet de prouver les but de la forme t=t.
      - [symmetry] : permet de transformer un but t₁ = t₂ en t₂ = t₁.
      - [rewrite H] : si H est une hypothèse de la forme "t₁ = t₂"
        cette tactique remplace dans le but courant les sous-termes
        de la forme t₁ par t₂.
      - [rewrite <-H] : si H est une hypothèse de la forme "t₁ = t₂"
        cette tactique remplace dans le but courant les sous-termes
        de la forme t₂ par t₁.  *)

Lemma double_egale_multiple_de_deux :
  forall n, double n = n * 2.
intros n. (*soit n entier*)
induction n. (*par récurrence sur n*)
+ simpl. (*initialisation par calcul*)
  reflexivity. (*par réflexivité*)
+ simpl. (*heredite, calcul*)
  rewrite IHn. (*par hypothese de recurrence*)
  reflexivity. (*par reflexivite*)
Qed.

(* "+", "*" ou "-" en début de ligne servent uniquement à mettre structurer et indenter la preuve;
   mathématiquement, cela revient à ne rien faire *)

(* Les deux tactiques centrales de COQ sont
     - [intros H] : l'équivalent de "soit H" et de "supposons que..."
                   dans les maths informelles, [intros H] introduit une
                   hypothèse H dans le contexte.
       (notez qu'il est également permis d'invoquer [intros H1 H2 H3]
       à la place de [intros A. intros B. intros C.]  pour faire des
       intros successifs)
     - [apply H] : permet d'invoquer l'hypothèse nommée H. *)

Lemma egalite_transitive :
  forall (x y z : nat), x = y -> y = z -> x = z.
Proof.
    intros.
    rewrite H.
    rewrite H0.
    reflexivity.
Qed.

(** Partie 3: Définitions inductives, inductions structurelles *)

(* Jusqu'ici, on a utilisés la commande induction
   pour réaliser des récurrences sur les entiers;
   cependant, les entiers sont des types inductifs! Regardez à nouveau: *)

Print nat.
Print plus.

(* De facon informelle, quand on definit un type inductif on donne
toutes les manières de construire un élément de ce type.  Un entier
naturel est soit zéro (construit par le constructeur "O"), soit le
successeur d'un autre entier naturel (construit par le constructeur
"S").

                      n : nat
   ----------      --------------
    0 : nat          S n : nat

Un autre exemple : le type "bool" des booleens est également inductif:

    -----------          ------------
    true : bool          false : bool      *)

Print bool.

(* Un booléen est soit 0, soit 1; soit vrai, soit faux. *)

(* En coq, on peut aussi définir de nouveaux types inductifs! Par exemple, les listes. La
définition ressemble à celle que l'on aurait fait en Caml: *)

Inductive liste_nat :=
 | liste_vide : liste_nat
 | cons : nat -> liste_nat -> liste_nat.

(* On définit le type "liste_nat" de liste des entiers naturels avec deux
constructeurs : "liste_vide" qui permet de construire la liste vide et
"cons_nat" qui permet de construire une nouvele liste à partir d'un
entier et une liste.
                                      l : liste_nat                 n : nat
   ------------------------         -----------------------------------------
    liste_vide : liste_nat                  cons_nat n l : liste_nat
*)

(* Et on peut définir comment concaténer deux listes, comme on a fait plus tôt pour
calculer le double d'un entier: *)

Fixpoint concat (l l' : liste_nat) := match l with
 | liste_vide => l'
 | cons n l'' => cons n (concat l'' l')
end.

(* Complétez la définition de la mesure de la longueur d'une liste d'entiers: *)

Fixpoint longueur l := match l with
 | liste_vide => 0
 | cons n l' => 1 + longueur l'
end.

(* Chaque fois qu'on définit un type inductif, Coq génère un principe
d'induction pour ce type. *)

Check liste_nat_ind.
Check nat_ind.
Check bool_ind.

(* Ce principe va être automatiquement invoqué quand on utilise la
tactique [induction]. Morale : on peut utiliser [induction] pour faire
de preuves sur tous les types inductifs. *)

(* On peut désormais prouver les lemmes suivants : *)

Lemma concat_vide : forall (l : liste_nat), concat liste_vide l = l.
Proof.
    intros.
    simpl.
    reflexivity.
Qed.

Lemma vide_concat : forall (l : liste_nat), concat l liste_vide = l.
Proof.
   intros.
   induction l.
   * simpl.
   reflexivity.
   *
   simpl.
   rewrite IHl.
   reflexivity.
Qed.

Lemma longueur_concat : forall (l l' : liste_nat), longueur (concat l l') = longueur l + longueur l'.
Proof.
    intros.
    induction l.
    *
    simpl.
    reflexivity.
    *
    simpl.
    rewrite IHl.
    reflexivity.
Qed.

(** Partie 4 : Calcul propositionnel **)

(* A vous de jouer maintenant! *)

Lemma trivial1 : forall P : Prop, P -> P.
Proof.
    intros.
    apply H.
Qed.

Lemma trivial2: forall P Q R:Prop, (P -> Q -> R) -> (P -> Q) -> P -> R.
Proof.
    intros.
    apply H.
    *
    apply H1.
    *
    apply H0.
    apply H1.
Qed.

(* Coq fournit les connecteurs logiques usuels :
       connecteur ┃ destructeur ┃ constructeur
      ━━━━━━━━━━━━╋━━━━━━━━━━━━━╇━━━━━━━━━━━━━━━━━━━
          P /\ Q  ┃ [destruct]  ┆  [split]
          P \/ Q  ┃ [destruct]  ┆  [left] et [right]
  exists x:nat, P ┃ [destruct]  ┆  [exists t]
          False   ┃ [destruct]  ┆  aucun

  Il est donc désormais autorisé d'utiliser, en plus des tactiques déjà explorées, les tactiques suivantes:
   apply , destruct , split , left , right , exists

  Mais, encore une fois, aucune autre tactique n'est autorisée!
*)

Lemma conj1: forall P Q:Prop, P /\ Q -> P.
Proof.
    intros.
    destruct H.
    apply H.
Qed.

Lemma conj2: forall P Q:Prop, P /\ Q -> Q.
Proof.
    intros.
    destruct H.
    apply H0.
Qed.

Lemma conj3: forall P Q:Prop, P -> Q -> P /\ Q.
Proof.
    intros.
    split.
    apply H.
    apply H0.
Qed.

Lemma or1 : forall P Q:Prop, P -> P \/ Q.
Proof.
    intros.
    left.
    apply H.
Qed.

Lemma or2 : forall P Q:Prop, Q -> P \/ Q.
Proof.
    intros.
    right.
    apply H.
Qed.

Lemma or3 : forall P Q R:Prop, P \/ Q -> (P -> R) -> (Q -> R) -> R.
Proof.
    intros.
    destruct H.
    * apply H0.
    apply H.
    *
    apply H1.
    apply H.
Qed.

(* En COQ, la proposition fausse, ou "l'absurde", est appelée "False". *)

Lemma ex_falso: forall P:Prop, False -> P. (* si on suppose l'absurde, on peut tout démontrer *)
Proof.
    intros.
    destruct H.
Qed.

Notation "~ P" := (P -> False). (* On définit la négation ainsi: la proposition "Non P", notée ~ P,
                                   est vraie si supposer P permet de prouver l'absurde *)

Lemma not_not : forall P:Prop, P -> ~~P.
Proof.
    intros P H H0.
    apply H0.
    apply H.
Qed.

Lemma morgan1 : forall P Q:Prop,
  ~P \/ ~Q -> ~(P /\ Q).
Proof.
    intros.
    intros H0.
    destruct H0.
    destruct H.
    *
    apply H.
    apply H0.
    *
    apply H.
    apply H1.
Qed.

Lemma morgan2 : forall P Q:Prop,
  ~P /\ ~Q -> ~(P \/ Q).
Proof.
    intros.
    intros H1.
    destruct H.
    destruct H1.
    *
    apply H.
    apply H1.
    *
    apply H0.
    apply H1.
Qed.

(* En coq on peut également définition des propositions
   qui dépendent de paramètre. Cela permet de représenter
   d'autres relations que l'égalité *)

Definition leq (n m : nat) := exists k, n+k = m.
Check leq. (* Méditez le type de la relation. *)

Lemma leq_reflexive :
  forall x, leq x x.
Proof.
    intros.
    exists 0.
    induction x.
    *
    simpl.
    apply zero_egale_zero.
    *
    simpl.
    rewrite IHx.
    reflexivity.
Qed.

Lemma plus_associative:
  forall x y z, x+(y+z)=(x+y)+z.
Proof.
  intros.
  induction x.
  *simpl.
   reflexivity.
  *simpl.
   rewrite IHx.
   reflexivity.
Qed.

Lemma leq_transitive :
  forall x y z, leq x y -> leq y z -> leq x z.
Proof.
  intros.
  destruct H.
  destruct H0.
  exists (x0+x1).
  rewrite<- H0.
  rewrite<- H.
  apply plus_associative.
Qed.
(** Partie 5 : Arithmétique **)

(* Rappel: on utilise la tactique simpl, pour simplifier les calculs. *)
Lemma zero_plus : forall x:nat, 0 + x = x.
Proof.
  simpl.
  reflexivity.
Qed.

Lemma exists_factor :
  exists n, exists m , n * (m+1) = 35.
Proof.
  exists 5.
  exists 6.
  simpl.
  reflexivity.
Qed.

(* La tactique simpl ne marche par pour prouver la proposition
   suivante. Pourquoi ? *)

Lemma plus_zero : forall x:nat, x + 0 = x.
Proof.

(* Il va nous faloir démontrer le résultat par récurrence sur la
   forme de x.
   La tactique [induction x] invoque automatiquement le
   principe d'induction pour prouver un but par induction sur
   la variable x. *)

  induction x.
  *
    reflexivity.
  *
    simpl.
    rewrite IHx.
    reflexivity.
(* Il faut ensuite prouver le cas de base et l'hérédité...*)

Qed.

Lemma plus_assoc : forall a b c, (a + b) + c = a + (b + c).
Proof.
  symmetry.
  apply plus_associative.
Qed.

Lemma mult_zero : forall a, a*0 = 0.
Proof.
  induction a.
  *
    simpl.
    reflexivity.
  *
    simpl.
    apply IHa.
Qed.

(** Pour aller plus loin **)

(* Pour finir, quelques exercices pour occuper les plus rapides d'entre vous :*)

(* N'hésitez pas à faire des lemmes intermédiaires !*)

(* Ce  n'est pas aussi trivial qu'il n'y paraît. *)

Lemma add1_trv : forall a, S a = 1+a.
Proof.
  simpl.
  reflexivity.
Qed.

Lemma add1_comm : forall a, S a = a+1.
Proof.
  intros.
  induction a.
  *
    apply zero_plus.
  *
    simpl.
    rewrite IHa.
    reflexivity.
Qed.

Lemma plus_comm : forall a b, a + b = b + a.
Proof.
  induction b.
  *
    simpl.
    apply plus_zero.
  *
    rewrite add1_trv.
    rewrite plus_associative.
    rewrite<- add1_comm.
    simpl.
    rewrite IHb.
    reflexivity.
Qed.

Lemma mult_distrib_gauche : forall a b c, a * (b + c) = a * b + a * c.
Proof.
  induction a.
  *
  simpl.
  reflexivity.
  *
    simpl.
    intros.
    rewrite IHa.
    rewrite plus_assoc.
    rewrite
Qed.

Lemma mult_distrib_droite : forall a b c, (b + c) * a = b * a + c * a.
Proof.
...
Qed.

Lemma mult_comm : forall a b, a * b = b * a.
Proof.
  induction a.
  *
    simpl.
    symmetry.
    apply mult_zero.
  *
    intros.
    simpl.
    Print Nat.mul.
    rewrite.
Qed.

Lemma identite :
  forall a b, (a + b)*(a+b) = a*a + 2*a*b + b*b.
Proof.
...
Qed.

(* Écrivez la fonction [power] qui calcule les puissances entières : *)
Fixpoint power a b :=
...

Infix "^" := power.

Lemma power_exp:
  forall a n m, a^(n + m) = a^n * a^m.
Proof.
...
Qed.

Lemma closed:
  forall n a b c, 3 <= n -> a^n + b^n = c^n -> a = c \/ b = c.
Proof.
...
Qed.


Require Import Nat_utils.
Require Import Validity.
Require Import ZArith.
Require Import Z_utils.
Require Import Coeff_utils.
Require Import Coeff.
Import Z.

(* Question 1.2.c *)

Fixpoint eval_base (p : poly) (f : nat -> Z) : Z :=
match p with
| Cst z => z
| Poly p1 i p2 => eval_base p1 f + (f i) * (eval_base p2 f)
end.

Definition eval (p : valid_poly) (f : nat -> Z) : Z :=
  eval_base (VP_value p) f.

(* Question 1.2.d *)

Lemma invariance_i (p : poly) (i : nat) (f g : nat -> Z) :
  valid_bool_i p i = true ->
  (forall (j : nat), (i <=? j) = true -> f j = g j) ->
  eval_base p f = eval_base p g.
Proof.
  revert i.
  induction p.
  intros.
  unfold eval_base.
  reflexivity.
  intros.
  simpl eval_base.
  apply Bool.andb_true_iff in H.
  destruct H.
  apply Bool.andb_true_iff in H1.
  destruct H1.
  apply Bool.andb_true_iff in H2.
  destruct H2.
  rewrite IHp1 with (i := i).
  rewrite IHp2 with (i := i).
  rewrite H0 with (j := n).
  reflexivity.
  assumption.
  apply valid_leb with (p := p2) (m := i) (n := n).
  assumption.
  assumption.
  assumption.
  apply valid_leb with (p := p1) (m := i) (n := S n).
  apply leb_trans with (n := n).
  assumption.
  apply leb_succ.
  assumption.
  assumption.
Qed.

Lemma non_constant_poly (p : poly) (i : nat) (z : Z) :
  valid_bool_i p i = true ->
  p <> Cst z ->
  exists (f : nat -> Z) (n0 : Z),
  forall (n : Z), (n0 <= n)%Z ->
  eval_base p (fun (j : nat) => if j =? i then n else f j) <> z.
Proof.
  revert i z.
  induction p.
  intros.
  exists (fun _ => Z.zero).
  exists Z.zero.
  intros.
  intro.
  apply H0.
  apply f_equal with (f := Cst).
  assumption.

  intros.
  simpl valid_bool_i in H.
  apply Bool.andb_true_iff in H.
  destruct H.
  apply Bool.andb_true_iff in H1.
  destruct H1.
  apply Bool.andb_true_iff in H2.
  destruct H2.

  destruct ltb_compare_dec with (m := n) (n := i).
  exfalso.
  revert H4.
  apply Bool.not_true_iff_false.
  apply ltb_leb.
  assumption.
  destruct H4.
  destruct IHp2 with (i := n) (z := 0%Z).
  assumption.
  apply Bool.negb_true_iff in H1.
  apply Bool.not_true_iff_false in H1.
  intro.
  apply H1.
  apply is_null_iff.
  assumption.
  destruct H5.
  exists (fun j => if j=? n then (max x0 (succ (abs (eval_base p1 x - z)))%Z) else x j).
  exists 0%Z.
  intros.
  simpl eval_base.
  rewrite <- invariance_i with (p := p1) (i := S n) (f := x) (g := fun  (j : nat) => if (j =? i)%nat then n0 else if (j =? n)%nat then max x0 (succ (abs (eval_base p1 x - z))) else x j).
  rewrite ltb_is_neqb2 with (m := i) (n := n).
  rewrite Nat.eqb_refl with (x := n).
  rewrite <- invariance_i with (p := p2) (i := n) (f := fun (j : nat) => if (j =? n)%nat then max x0 (succ (abs (eval_base p1 x - z))) else x j) (g := fun (j : nat) => if (j =? i)%nat then n0 else if (j =? n)%nat then max x0 (succ (abs (eval_base p1 x - z))) else x j).
  intro.
  apply f_equal with (f := fun (x : Z) => Z.sub x z) in H7.
  revert H7.
  rewrite Z.sub_diag.
  rewrite <- Z.add_opp_r.
  rewrite <- Z.add_assoc.
  rewrite Z.add_comm with (m := (-z)%Z).
  rewrite Z.add_assoc.
  rewrite Z.add_opp_r.
  apply z_abs_lt.
  apply Z.lt_le_trans with (m := (succ (abs (eval_base p1 x - z)))%Z).
  apply Z.lt_succ_diag_r.
  apply Z.le_max_r.
  apply H5 with (n := (max x0 (succ (abs (eval_base p1 x - z))))%Z).
  apply Z.le_max_l.
  assumption.
  intros.
  rewrite ltb_is_neqb2 with (m := i) (n := j).
  reflexivity.
  apply leb_trans with (n := n).
  assumption.
  assumption.
  assumption.
  assumption.
  intros.
  rewrite ltb_is_neqb2 with (m := i) (n := j).
  rewrite ltb_is_neqb2 with (m := n) (n := j).
  reflexivity.
  assumption.
  apply leb_trans with (n := n).
  assumption.
  apply leb_trans with (n := S n).
  apply leb_succ.
  assumption.

  rewrite <- H4.
  destruct IHp2 with (i := n) (z := 0%Z).
  assumption.
  apply Bool.negb_true_iff in H1.
  apply Bool.not_true_iff_false in H1.
  intro.
  apply H1.
  apply is_null_iff.
  assumption.
  destruct H5.
  exists x.
  exists (max x0 (succ (abs (eval_base p1 x - z)))%Z).
  intros.
  simpl eval_base.
  rewrite Nat.eqb_refl with (x := n).
  rewrite <- invariance_i with (p := p1) (i := S n) (f := x) (g := fun  (j : nat) => if (j =? n)%nat then n0 else x j).
  intro.
  apply f_equal with (f := fun (x : Z) => Z.sub x z) in H7.
  revert H7.
  rewrite Z.sub_diag.
  rewrite <- Z.add_opp_r.
  rewrite <- Z.add_assoc.
  rewrite Z.add_comm with (m := (-z)%Z).
  rewrite Z.add_assoc.
  rewrite Z.add_opp_r.
  apply z_abs_lt.
  apply Z.lt_le_trans with (m := (succ (abs (eval_base p1 x - z)))%Z).
  apply Z.lt_succ_diag_r.
  apply Z.le_trans with (m := (max x0 (succ (abs (eval_base p1 x - z))))%Z).
  apply Z.le_max_r.
  assumption.
  apply H5 with (n := n0).
  apply Z.le_trans with (m := (max x0 (succ (abs (eval_base p1 x - z))))%Z).
  apply Z.le_max_l.
  assumption.
  assumption.
  intros.
  rewrite ltb_is_neqb2 with (m := n) (n := j).
  reflexivity.
  assumption.
Qed.

Lemma diff_poly (p q : poly) (i : nat) :
  valid_bool_i p i = true ->
  valid_bool_i q i = true ->
  p <> q ->
  exists (f : nat -> Z) (n0 : Z), forall (n : Z), (n0 <= n)%Z ->
  eval_base p (fun (j : nat) => if j =? i then n else f j) <> eval_base q (fun (j : nat) => if j =? i then n else f j).
Proof.
  revert i q.
  induction p.
  induction q.
  intros.
  exists (fun _ => Z.zero).
  exists 0%Z.
  intros.
  intro.
  apply H1.
  apply f_equal with (f := Cst).
  assumption.

  intros.
  simpl eval_base.
  destruct non_constant_poly with (p := Poly q1 n q2) (i := i) (z := z).
  assumption.
  intro.
  apply H1.
  symmetry.
  assumption.
  exists x.
  destruct H2.
  exists x0.
  intros.
  intro.
  symmetry in H4.
  revert H4.
  apply H2 with (n := n0).
  assumption.

  induction q.
  intros.
  simpl eval_base.
  apply non_constant_poly with (p := Poly p1 n p2) (i := i) (z := z).
  assumption.
  assumption.

  intros.
  destruct ltb_compare_dec with (m := n) (n := n0).
  simpl valid_bool_i in H.
  apply Bool.andb_true_iff in H.
  destruct H.
  apply Bool.andb_true_iff in H3.
  destruct H3.
  apply Bool.andb_true_iff in H4.
  destruct H4.
  destruct non_constant_poly with (p := p2) (i := n) (z := 0%Z).
  assumption.
  apply Bool.negb_true_iff in H3.
  apply Bool.not_true_iff_false in H3.
  intro.
  apply H3.
  apply is_null_iff.
  assumption.
  destruct H6.
  exists (fun j => if j =? n then (max x0 (succ (abs (eval_base p1 x - eval_base (Poly q1 n0 q2) x))))%Z else x j).
  exists (max x0 (succ (abs (eval_base p1 x - eval_base (Poly q1 n0 q2) x))))%Z.
  intros.
  rewrite <- invariance_i with (p := Poly q1 n0 q2) (i := n0) (f := x) (g := fun (j : nat) =>
   if j =? i then n1 else if j =? n then (max x0 (succ (abs (eval_base p1 x - eval_base (Poly q1 n0 q2) x))))%Z else x j).
  simpl eval_base.
  rewrite <- invariance_i with (p := p1) (i := S n) (f := x) (g := fun (j : nat) =>
   if j =? i then n1 else if j =? n then (max x0 (succ (abs (eval_base p1 x - (eval_base q1 x + x n0 * eval_base q2 x)))))%Z else x j).
  intro.
  apply f_equal with (f := fun y => (y - (eval_base q1 x + x n0 * eval_base q2 x))%Z) in H8.
  revert H8.
  rewrite Z.sub_diag.
  rewrite <- Z.add_opp_r.
  rewrite <- Z.add_assoc.
  rewrite Z.add_comm with (m := (-(eval_base q1 x + x n0 * eval_base q2 x))%Z).
  rewrite Z.add_assoc.
  rewrite Z.add_opp_r.
  apply z_abs_lt.
  apply Z.lt_le_trans with (m := (max x0 (succ (abs (eval_base p1 x - eval_base (Poly q1 n0 q2) x))))%Z).
  apply Z.lt_le_trans with (m := (succ (abs (eval_base p1 x - eval_base (Poly q1 n0 q2) x)))%Z).
  apply Z.lt_succ_diag_r.
  apply Z.le_max_r.
  elim (n =? i).
  assumption.
  rewrite Nat.eqb_refl with (x := n).
  apply Z.le_refl.
  destruct ltb_compare_dec with (m := n) (n := i).
  exfalso.
  revert H8.
  apply Bool.not_true_iff_false.
  apply ltb_leb.
  assumption.
  destruct H8.
  rewrite <- invariance_i with (p := p2) (i := n) (f := fun (j : nat) => if j =? n then (max x0 (succ (abs (eval_base p1 x - (eval_base q1 x + x n0 * eval_base q2 x)))))%Z else x j).
  apply H6 with (n := (max x0 (succ (abs (eval_base p1 x - (eval_base q1 x + x n0 * eval_base q2 x)))))%Z).
  apply Z.le_max_l.
  assumption.
  intros.
  rewrite ltb_is_neqb2 with (m := i) (n := j).
  reflexivity.
  apply leb_trans with (n := n).
  assumption.
  assumption.
  rewrite <- H8.
  rewrite <- invariance_i with (p := p2) (i := n) (f := fun (j : nat) => if j =? n then n1 else x j).
  apply H6 with (n := n1).
  apply Z.le_trans with (m := (max x0 (succ (abs (eval_base p1 x - eval_base (Poly q1 n0 q2) x))))%Z).
  apply Z.le_max_l.
  assumption.
  assumption.
  intros.
  elim (j =? n).
  reflexivity.
  reflexivity.
  assumption.
  intros.
  rewrite ltb_is_neqb2 with (m := i) (n := j).
  rewrite ltb_is_neqb2 with (m := n) (n := j).
  reflexivity.
  assumption.
  apply leb_trans with (n := S n).
  assumption.
  assumption.
  simpl valid_bool_i in H0.
  apply Bool.andb_true_iff in H0.
  destruct H0.
  simpl valid_bool_i.
  apply Bool.andb_true_iff.
  split.
  apply Nat_utils.leb_refl.
  assumption.
  intros.
  rewrite ltb_is_neqb2 with (m := i) (n := j).
  rewrite ltb_is_neqb2 with (m := n) (n := j).
  reflexivity.
  apply leb_trans with (n := n0).
  assumption.
  assumption.
  apply leb_trans with (n := n0).
  apply leb_trans with (n := S n).
  assumption.
  assumption.
  assumption.

  destruct H2.
  simpl valid_bool_i in H0.
  apply Bool.andb_true_iff in H0.
  destruct H0.
  apply Bool.andb_true_iff in H3.
  destruct H3.
  apply Bool.andb_true_iff in H4.
  destruct H4.
  destruct non_constant_poly with (p := q2) (i := n0) (z := 0%Z).
  assumption.
  apply Bool.negb_true_iff in H3.
  apply Bool.not_true_iff_false in H3.
  intro.
  apply H3.
  apply is_null_iff.
  assumption.
  destruct H6.
  exists (fun j => if j =? n0 then (max x0 (succ (abs (eval_base q1 x - eval_base (Poly p1 n p2) x))))%Z else x j).
  exists (max x0 (succ (abs (eval_base q1 x - eval_base (Poly p1 n p2) x))))%Z.
  intros.
  rewrite <- invariance_i with (p := Poly p1 n p2) (i := n) (f := x) (g := fun (j : nat) =>
   if j =? i then n1 else if j =? n0 then (max x0 (succ (abs (eval_base q1 x - eval_base (Poly p1 n p2) x))))%Z else x j).
  simpl eval_base.
  rewrite <- invariance_i with (p := q1) (i := S n0) (f := x) (g := fun (j : nat) =>
   if j =? i then n1 else if j =? n0 then (max x0 (succ (abs (eval_base q1 x - (eval_base p1 x + x n * eval_base p2 x)))))%Z else x j).
  intro.
  apply f_equal with (f := fun y => (y - (eval_base p1 x + x n * eval_base p2 x))%Z) in H8.
  symmetry in H8.
  revert H8.
  rewrite Z.sub_diag.
  rewrite <- Z.add_opp_r.
  rewrite <- Z.add_assoc.
  rewrite Z.add_comm with (m := (-(eval_base p1 x + x n * eval_base p2 x))%Z).
  rewrite Z.add_assoc.
  rewrite Z.add_opp_r.
  apply z_abs_lt.
  apply Z.lt_le_trans with (m := (max x0 (succ (abs (eval_base q1 x - eval_base (Poly p1 n p2) x))))%Z).
  apply Z.lt_le_trans with (m := (succ (abs (eval_base q1 x - eval_base (Poly p1 n p2) x)))%Z).
  apply Z.lt_succ_diag_r.
  apply Z.le_max_r.
  elim (n0 =? i).
  assumption.
  rewrite Nat.eqb_refl with (x := n0).
  apply Z.le_refl.
  destruct ltb_compare_dec with (m := n0) (n := i).
  exfalso.
  revert H8.
  apply Bool.not_true_iff_false.
  apply ltb_leb.
  assumption.
  destruct H8.
  rewrite <- invariance_i with (p := q2) (i := n0) (f := fun (j : nat) => if j =? n0 then (max x0 (succ (abs (eval_base q1 x - (eval_base p1 x + x n * eval_base p2 x)))))%Z else x j).
  apply H6 with (n := (max x0 (succ (abs (eval_base q1 x - (eval_base p1 x + x n * eval_base p2 x)))))%Z).
  apply Z.le_max_l.
  assumption.
  intros.
  rewrite ltb_is_neqb2 with (m := i) (n := j).
  reflexivity.
  apply leb_trans with (n := n0).
  assumption.
  assumption.
  rewrite <- H8.
  rewrite <- invariance_i with (p := q2) (i := n0) (f := fun (j : nat) => if j =? n0 then n1 else x j).
  apply H6 with (n := n1).
  apply Z.le_trans with (m := (max x0 (succ (abs (eval_base q1 x - eval_base (Poly p1 n p2) x))))%Z).
  apply Z.le_max_l.
  assumption.
  assumption.
  intros.
  elim (j =? n0).
  reflexivity.
  reflexivity.
  assumption.
  intros.
  rewrite ltb_is_neqb2 with (m := i) (n := j).
  rewrite ltb_is_neqb2 with (m := n0) (n := j).
  reflexivity.
  assumption.
  apply leb_trans with (n := S n0).
  assumption.
  assumption.
  simpl valid_bool_i in H.
  apply Bool.andb_true_iff in H.
  destruct H.
  simpl valid_bool_i.
  apply Bool.andb_true_iff.
  split.
  apply Nat_utils.leb_refl.
  assumption.
  intros.
  rewrite ltb_is_neqb2 with (m := i) (n := j).
  rewrite ltb_is_neqb2 with (m := n0) (n := j).
  reflexivity.
  apply leb_trans with (n := n).
  assumption.
  assumption.
  apply leb_trans with (n := n).
  apply leb_trans with (n := S n0).
  assumption.
  assumption.
  assumption.

  simpl valid_bool_i in H.
  apply Bool.andb_true_iff in H.
  destruct H.
  apply Bool.andb_true_iff in H3.
  destruct H3.
  apply Bool.andb_true_iff in H4.
  destruct H4.
  simpl valid_bool_i in H0.
  apply Bool.andb_true_iff in H0.
  destruct H0.
  apply Bool.andb_true_iff in H6.
  destruct H6.
  apply Bool.andb_true_iff in H7.
  destruct H7.
  destruct excluded_middle_poly with (p := p2) (q := q2).
  destruct excluded_middle_poly with (p := p1) (q := q1).
  destruct H1.
  apply f_equal3 with (f := Poly).
  assumption.
  assumption.
  assumption.
  destruct IHp1 with (i := i) (q := q1).
  apply valid_leb with (n := S n).
  apply leb_trans with (n := n).
  assumption.
  apply leb_succ.
  assumption.
  apply valid_leb with (n := S n0).
  apply leb_trans with (n := n0).
  assumption.
  apply leb_succ.
  assumption.
  assumption.
  destruct H11.
  exists x.
  exists x0.
  intros.
  rewrite <- H2.
  rewrite <- H9.
  simpl eval_base.
  intro.
  apply f_equal with (f := fun (y : Z) => (y - (if (n =? i)%nat then n1 else x n) * eval_base p2 (fun j : nat => if (j =? i)%nat then n1 else x j))%Z) in H13.
  revert H13.
  rewrite Z.add_simpl_r.
  rewrite Z.add_simpl_r.
  apply H11 with (n := n1).
  assumption.
  rewrite <- H2.
  destruct IHp2 with (i := n) (q := q2).
  assumption.
  rewrite H2.
  assumption.
  assumption.
  destruct H10.
  exists (fun (j : nat) => if j =? n then (max x0 (succ (abs (eval_base p1 x - eval_base q1 x))))%Z else x j).
  exists (max x0 (succ (abs (eval_base p1 x - eval_base q1 x))))%Z.
  intros.
  simpl eval_base.
  rewrite <- invariance_i with (p := p1) (i := S n) (f := x) (g := fun (j : nat) =>
   if j =? i then n1 else if j =? n then (max x0 (succ (abs (eval_base p1 x - eval_base q1 x))))%Z else x j).
  rewrite <- invariance_i with (p := q1) (i := S n) (f := x) (g := fun (j : nat) =>
   if j =? i then n1 else if j =? n then (max x0 (succ (abs (eval_base p1 x - eval_base q1 x))))%Z else x j).
  rewrite Nat.eqb_refl with (x := n).
  intro.
  apply f_equal with (f := fun (y : Z) => (y-(eval_base q1 x +
       (if (n =? i)%nat then n1 else max x0 (succ (abs (eval_base p1 x - eval_base q1 x)))) *
       eval_base q2
         (fun j : nat =>
          if (j =? i)%nat
          then n1
          else if (j =? n)%nat then max x0 (succ (abs (eval_base p1 x - eval_base q1 x))) else x j)))%Z) in H12.
  revert H12.
  rewrite Z.sub_diag.
  rewrite <- Z.add_opp_r.
  rewrite Z.opp_add_distr.
  rewrite Z.add_assoc.
  rewrite <- Z.add_assoc with (p := (- eval_base q1 x)%Z).
  rewrite Z.add_comm with (m := (- eval_base q1 x)%Z).
  rewrite Z.add_assoc with (m := (- eval_base q1 x)%Z).
  rewrite Z.add_opp_r with (n := eval_base p1 x).
  rewrite <- Z.add_assoc.
  rewrite Z.add_opp_r.
  rewrite <- Z.mul_sub_distr_l with (n := if (n =? i)%nat then n1 else max x0 (succ (abs (eval_base p1 x - eval_base q1 x)))).
  apply z_abs_lt.
  elim (n =? i).
  apply Z.lt_le_trans with (m := (succ (abs (eval_base p1 x - eval_base q1 x)))%Z).
  apply Z.lt_succ_diag_r.
  apply Z.le_trans with (m := (max x0 (succ (abs (eval_base p1 x - eval_base q1 x))))%Z).
  apply Z.le_max_r.
  assumption.
  apply Z.lt_le_trans with (m := (succ (abs (eval_base p1 x - eval_base q1 x)))%Z).
  apply Z.lt_succ_diag_r.
  apply Z.le_max_r.
  destruct ltb_compare_dec with (m := n) (n := i).
  exfalso.
  revert H12.
  apply Bool.not_true_iff_false.
  apply ltb_leb.
  assumption.
  destruct H12.
  rewrite <- invariance_i with (p := p2) (i := n) (f := fun (j : nat) => if (j =? n) then max x0 (succ (abs (eval_base p1 x - eval_base q1 x))) else x j).
  rewrite <- invariance_i with (p := q2) (i := n) (f := fun (j : nat) => if (j =? n) then max x0 (succ (abs (eval_base p1 x - eval_base q1 x))) else x j).
  intro.
  apply f_equal with (f := fun (y : Z) => (y + eval_base q2
         (fun j : nat => if (j =? n)%nat then max x0 (succ (abs (eval_base p1 x - eval_base q1 x))) else x j))%Z) in H13.
  revert H13.
  rewrite <- Z.add_opp_r.
  rewrite <- Z.add_assoc.
  rewrite Z.add_opp_diag_l.
  rewrite Z.add_0_r.
  rewrite Z.add_0_l.
  apply H10 with (n := (max x0 (succ (abs (eval_base p1 x - eval_base q1 x))))%Z).
  apply Z.le_max_l.
  rewrite H2.
  assumption.
  intros.
  rewrite ltb_is_neqb2 with (m := i) (n := j).
  reflexivity.
  apply leb_trans with (n := n).
  assumption.
  assumption.
  assumption.
  intros.
  rewrite ltb_is_neqb2 with (m := i) (n := j).
  reflexivity.
  apply leb_trans with (n := n).
  assumption.
  assumption.
  rewrite <- H12.
  rewrite <- invariance_i with (p := p2) (i := n) (f := fun (j : nat) => if j =? n then n1 else x j).
  rewrite <- invariance_i with (p := q2) (i := n) (f := fun (j : nat) => if j =? n then n1 else x j).
  intro.
  apply f_equal with (f := fun (y : Z) => (y + eval_base q2
         (fun j : nat => if (j =? n)%nat then n1 else x j))%Z) in H13.
  revert H13.
  rewrite <- Z.add_opp_r.
  rewrite <- Z.add_assoc.
  rewrite Z.add_opp_diag_l.
  rewrite Z.add_0_r.
  rewrite Z.add_0_l.
  apply H10 with (n := n1).
  apply Z.le_trans with (m := (max x0 (succ (abs (eval_base p1 x - eval_base q1 x))))%Z).
  apply Z.le_max_l.
  assumption.
  rewrite H2.
  assumption.
  intros.
  elim (j =? n).
  reflexivity.
  reflexivity.
  assumption.
  intros.
  elim (j =? n).
  reflexivity.
  reflexivity.
  rewrite H2.
  assumption.
  intros.
  rewrite ltb_is_neqb2 with (m := i) (n := j).
  rewrite ltb_is_neqb2 with (m := n) (n := j).
  reflexivity.
  assumption.
  apply leb_trans with (n := S n).
  assumption.
  assumption.
  assumption.
  intros.
  rewrite ltb_is_neqb2 with (m := i) (n := j).
  rewrite ltb_is_neqb2 with (m := n) (n := j).
  reflexivity.
  assumption.
  apply leb_trans with (n := S n).
  assumption.
  assumption.
Qed.

Theorem eval_eq (p q : valid_poly) :
  (forall (f : nat -> Z), eval p f = eval q f) -> p = q.
Proof.
  destruct p as [p p'].
  destruct q as [q q'].
  unfold eval.
  simpl.
  intro.
  apply leibniz.
  simpl.
  destruct excluded_middle_poly with (p := p) (q := q).
  assumption.
  destruct diff_poly with (p := p) (q := q) (i := 0).
  assumption.
  assumption.
  assumption.
  destruct H1.
  contradiction H1 with (n := x0).
  apply Z.le_refl.
  apply H with (f := fun (j : nat) => if j =? 0 then x0 else x j).
Qed.


Theorem DeMorgan1 : forall A B, negb (andb A B) = orb (negb A) (negb B).
Proof.
  intros. destruct A; destruct B; reflexivity. Qed.

Theorem DeMorgan2 : forall A B, negb (orb A B) = andb (negb A) (negb B).
Proof.
  intros. destruct A; destruct B; reflexivity. Qed.

Check andb.
Check orb.
Print DeMorgan1.
(*DeMorgan1 =
fun A B : bool =>
if A as b return (negb (b && B) = (negb b || negb B)%bool)
then
 if B as b return (negb (true && b) = (negb true || negb b)%bool)
 then eq_refl
 else eq_refl
else
 if B as b return (negb (false && b) = (negb false || negb b)%bool)
 then eq_refl
 else eq_refl
     : forall A B : bool, negb (A && B) = (negb A || negb B)%bool *)


Inductive day : Type :=
  | monday : day
  | tuesday : day
  | wednesday : day
  | thursday : day
  | friday : day
  | saturday : day
  | sunday : day.

Definition next_weekday (d:day) : day :=
  match d with
  | monday => tuesday
  | tuesday => wednesday
  | wednesday => thursday
  | thursday => friday
  | friday => monday
  | saturday => monday
  | sunday => monday
  end.

Eval simpl in (next_weekday friday).
Eval simpl in (next_weekday (next_weekday saturday)).

Example test_next_weekday:
  (next_weekday (next_weekday saturday)) = tuesday.

Proof. simpl. reflexivity.  Qed.

Inductive bool : Type :=
  | true : bool
  | false : bool.

Definition negb (b:bool) : bool :=
  match b with
  | true => false
  | false => true
  end.

Definition andb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => b2
  | false => false
  end.

Definition orb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => true
  | false => b2
  end.

Example test_orb1:  (orb true  false) = true.
Proof. simpl. reflexivity.  Qed.
Example test_orb2:  (orb false false) = false.
Proof. simpl. reflexivity.  Qed.
Example test_orb3:  (orb false true ) = true.
Proof. simpl. reflexivity.  Qed.
Example test_orb4:  (orb true  true ) = true.
Proof. simpl. reflexivity.  Qed.

Definition nandb (b1:bool) (b2:bool) : bool :=
  negb (andb b1 b2).

Example test_nandb1: (nandb true false) = true.
Proof.
  simpl.
  reflexivity.
Qed.

Example test_nandb2: (nandb false false) = true.
Proof.
  simpl.
  reflexivity.
Qed.

Example test_nandb3: (nandb false true) = true.
Proof.
  simpl.
  reflexivity.
Qed.

Example test_nandb4: (nandb true true) = false.
Proof.
  simpl.
  reflexivity.
Qed.

Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool :=
  andb b1 (andb b2 b3).

Example test_andb31: (andb3 true true true) = true.
Proof.
  simpl.
  reflexivity.
Qed.

Example test_andb32: (andb3 false true true) = false.
Proof.
  simpl.
  reflexivity.
Qed.

Example test_andb33: (andb3 true false true) = false.
Proof.
  simpl.
  reflexivity.
Qed.

Example test_andb34: (andb3 true true false) = false.
Proof.
  simpl.
  reflexivity.
Qed.

Check (negb true).

Check negb.

Module Playground1.
  Inductive nat : Type :=
  | O : nat
  | S : nat -> nat.

  Definition pred (n : nat) : nat :=
    match n with
      | O => O
      | S n' => n'
    end.
End Playground1.

Definition minustwo (n:nat) : nat :=
  match n with
    | O => O
    | S O => O
    | S (S n') => n'
  end.

Check (S (S (S (S O)))).
Eval simpl in (minustwo 4).

Check S.
Check pred.
Check minustwo.

Fixpoint evenb (n:nat) : bool :=
  match n with
    | O => true
    | S O => false
    | S (S n') => evenb n'
  end.

Definition oddb (n:nat) : bool := negb (evenb n).

Example test_oddb1: (oddb (S O)) = true.
Proof. simpl. reflexivity. Qed.
Example test_oddb2: (oddb (S (S (S (S O))))) = false.
Proof. simpl. reflexivity. Qed.

Module Playground2.
  Fixpoint plus (n : nat) (m : nat) : nat :=
    match n with
      | O => m
      | S n' => S (plus n' m)
    end.

  Eval simpl in (plus (S (S (S O))) (S (S O))).

  Fixpoint mult (n m : nat) : nat :=
    match n with
      | O => O
      | S n' => plus m (mult n' m)
    end.

  Fixpoint minus (n m:nat) : nat :=
    match n, m with
      | O   , _  => O
      | S _ , O  => n
      | S n', S m' => minus n' m'
    end.

  Eval simpl in (minus (S (S (S O))) (S (S O))).
  Eval simpl in (minus (S (S O)) (S (S (S O)))).

End Playground2.

Fixpoint exp (base power : nat): nat :=
  match power with
    | O => S O
    | S p => mult base (exp base p)
  end.

Fixpoint factorial (n:nat) : nat :=
  match n with
    | O => S O
    | S n' => mult n (factorial n')
  end.

Example test_factorial1: (factorial 3) = 6.
Proof.
  simpl.
  reflexivity.
Qed.

Example test_factorial2: (factorial 5) = (mult 10 12).
Proof.
  simpl.
  reflexivity.
Qed.

Notation "x + y" := (plus  x y) (at level 50, left associativity) : nat_scope.
Notation "x - y" := (minus x y) (at level 50, left associativity) : nat_scope.
Notation "x * y" := (mult  x y) (at level 40, left associativity) : nat_scope.

Check ((0 + 1) + 1).

Fixpoint beq_nat (n m:nat) : bool :=
  match n with
    |O => match m with
            | O => true
            | S m' => false
          end
    | S n' => match m with
                | O => false
                | S m' => beq_nat n' m'
              end
  end.

Fixpoint ble_nat (n m : nat) : bool :=
  match n with
    | O => true
    | S n' =>
      match m with
          | O => false
          | S m' => ble_nat n' m'
      end
  end.

Example test_ble_nat1:             (ble_nat 2 2) = true.
Proof. simpl. reflexivity.  Qed.
Example test_ble_nat2:             (ble_nat 2 4) = true.
Proof. simpl. reflexivity.  Qed.
Example test_ble_nat3:             (ble_nat 4 2) = false.
Proof. simpl. reflexivity.  Qed.

Definition blt_nat (n m : nat) : bool :=
  andb (ble_nat n m) (negb (beq_nat n m)).

Example test_blt_nat1: (blt_nat 2 2) = false.
Proof. simpl. reflexivity. Qed.

Example test_blt_nat2: (blt_nat 2 4) = true.
Proof. simpl. reflexivity. Qed.

Example test_blt_nat3: (blt_nat 4 2) = false.
Proof. simpl. reflexivity. Qed.

Theorem plus_O_n: forall n:nat, 0 + n = n.
Proof. simpl. reflexivity. Qed.

Eval simpl in (forall n:nat, n + 0 = n).

Eval simpl in (forall n:nat, 0 + n = n).

Theorem plus_O_n'' : forall n:nat, 0+n=n.
Proof.
  intros n. reflexivity. Qed.

Theorem plus_1_l : forall n:nat, 1 + n = S n.
Proof.
  intros n. reflexivity.  Qed.

Theorem mult_0_l : forall n:nat, 0 * n = 0.
Proof.
  intros n. reflexivity.  Qed.

Theorem plus_id_example : forall n m:nat,
  n = m ->
  n + n = m + m.
Proof.
  intros n m.
  intros H.
  rewrite -> H.
  reflexivity.
Qed.

Theorem plus_id_exercise :
  forall n m o:nat, n = m -> m = o -> n + m = m + o.
Proof.
  intros n m o.
  intros H1 H2.
  rewrite -> H1.
  rewrite <- H2.
  reflexivity.
Qed.

Theorem mult_0_l_plus:
  forall n m:nat, (0+n)*m = n*m.
Proof.
  intros n m.
  rewrite -> plus_O_n.
  reflexivity.
Qed.

Theorem mult_1_plus:
  forall n m:nat, (1 + n) * m = m + (n * m).
  intros n m.
  rewrite -> plus_1_l.
  simpl.
  reflexivity.
Qed.

Theorem plus_1_neq_0 :
  forall n : nat, beq_nat (n + 1) 0 = false.
Proof.
  intro n.
  destruct n as [|n'].
  reflexivity.
  reflexivity.
Qed.

Theorem negb_involutive :
  forall b : bool, negb (negb b) = b.
Proof.
  intros b.
  destruct b.
  reflexivity.
  reflexivity.
Qed.

Theorem zero_nbeq_plus_1:
  forall n : nat, beq_nat 0 (n+1) = false.
Proof.
  intros n.
  destruct n as [|n'].
  reflexivity.
  reflexivity.
Qed.

Require String. Open Scope string_scope.

Ltac move_to_top x :=
  match reverse goal with
  | H : _ |- _ => try move x after H
  end.

Tactic Notation "assert_eq" ident(x) constr(v) :=
  let H := fresh in
  assert (x = v) as H by reflexivity;
  clear H.

Tactic Notation "Case_aux" ident(x) constr(name) :=
  first [
    set (x := name); move_to_top x
  | assert_eq x name; move_to_top x
  | fail 1 "because we are working on a different case" ].

Tactic Notation "Case" constr(name) := Case_aux Case name.
Tactic Notation "SCase" constr(name) := Case_aux SCase name.
Tactic Notation "SSCase" constr(name) := Case_aux SSCase name.
Tactic Notation "SSSCase" constr(name) := Case_aux SSSCase name.
Tactic Notation "SSSSCase" constr(name) := Case_aux SSSSCase name.
Tactic Notation "SSSSSCase" constr(name) := Case_aux SSSSSCase name.
Tactic Notation "SSSSSSCase" constr(name) := Case_aux SSSSSSCase name.
Tactic Notation "SSSSSSSCase" constr(name) := Case_aux SSSSSSSCase name.

Theorem andb_true_elim1:
  forall b c : bool, andb b c = true -> b = true.
  intros b c H.
  destruct b.
  Case "b = true".
  reflexivity.
  Case "b = false".
  rewrite <- H.
  reflexivity.
Qed.

Theorem andb_true_elim2:
  forall b c : bool, andb b c = true -> c = true.
Proof.
  intros b c H.
  destruct c.
  Case "c = true".
  reflexivity.
  Case "c = false".
  rewrite <- H.
  destruct b.
  SCase "b = true".
  reflexivity.
  SCase "b = false".
  reflexivity.
Qed.

Theorem plus_0_r :
  forall n:nat, n + 0 = n.
Proof.
  intros n.
  induction n as [|n'].
  Case "n = 0". reflexivity.
  Case "n = S n'". simpl. rewrite -> IHn'. reflexivity.
Qed.

Theorem minus_diag :
  forall n, minus n n = 0.
Proof.
  intros n. induction n as [|n'].
  Case "n = 0". reflexivity.
  Case "n = S n'". simpl. rewrite -> IHn'. reflexivity.
Qed.

Theorem mult_0_r : forall n:nat,
  n * 0 = 0.
Proof.
  intros n. induction n as [|n'].
  Case "n = 0".
  reflexivity.
  Case "n = S n'".
  simpl.
  rewrite -> IHn'.
  reflexivity.
Qed.

Theorem plus_n_Sm : forall n m : nat,
  S (n + m) = n + (S m).
Proof.
  intros n m. induction n as [|n'].
  Case "n = 0".
  simpl.
  reflexivity.
  Case "n = S n'".
  simpl.
  rewrite -> IHn'.
  reflexivity.
Qed.

Theorem plus_comm : forall n m : nat,
  n + m = m + n.
Proof.
  intros n m.
  induction n as [|n'].
  Case "n = 0".
  simpl.
  rewrite -> plus_0_r.
  reflexivity.
  Case "n = S n'".
  simpl.
  rewrite <- plus_n_Sm.
  rewrite -> IHn'.
  reflexivity.
Qed.

Fixpoint double (n:nat) :=
  match n with
  | O => O
  | S n' => S (S (double n'))
  end.

Lemma double_plus :
  forall n, double n = n + n .
Proof.
  intro n.
  induction n as [|n'].
  Case "n = 0".
  simpl.
  reflexivity.
  Case "n = S n'".
  simpl.
  rewrite -> IHn'.
  rewrite -> plus_n_Sm.
  reflexivity.
Qed.

Theorem plus_assoc : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  intros n m p. induction n as [| n'].
  Case "n = 0".
    reflexivity.
  Case "n = S n'".
  simpl. rewrite -> IHn'. reflexivity.
Qed.

Theorem beq_nat_refl :
  forall n : nat, true = beq_nat n n.
Proof.
  intros n.
  induction n as [|n'].
  Case "n = 0".
  simpl.
  reflexivity.
  Case "n = S n'".
  simpl.
  rewrite <- IHn'.
  reflexivity.
Qed.

Theorem mult_0_plus' : forall n m : nat,
  (0 + n) * m = n * m.
Proof.
  intros n m.
  assert (H: 0 + n = n).
    Case "Proof of assertion". reflexivity.
  rewrite -> H.
  reflexivity.
Qed.

Theorem plus_rearrange : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  assert (H: n + m = m + n).
  Case "Proof of assertion".
  rewrite -> plus_comm. reflexivity.
  rewrite -> H. reflexivity.
Qed.

Theorem plus_swap : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  intros n m p.
  assert (H1: n + (m + p) = (n + m) + p).
  Case "Proof of assertion H1".
  rewrite -> plus_assoc.
  reflexivity.
  assert (H2: m + (n + p) = (m + n) + p).
  Case "Proof of assertion H2".
  rewrite -> plus_assoc.
  reflexivity.
  assert (H3: n + m = m + n).
  Case "Proof of assertion H3".
  rewrite -> plus_comm.
  reflexivity.
  rewrite -> H1.
  rewrite -> H2.
  rewrite -> H3.
  reflexivity.
Qed.

Theorem mult_comm :
  forall m n : nat, m * n = n * m.
Proof.
  assert (mult_n_Sm: forall n m : nat, n + n * m = n * (S m)).
  intros n m.
  induction n as [|n'].
  Case "n = 0".
  simpl.
  reflexivity.
  Case "n = S n'".
  simpl.
  rewrite <- IHn'.
  rewrite <- plus_swap.
  reflexivity.
  intros n m.
  induction n as [|n'].
  Case "n = 0".
  simpl.
  rewrite -> mult_0_r.
  reflexivity.
  Case "n = S n'".
  simpl.
  rewrite <- mult_n_Sm.
  rewrite -> IHn'.
  reflexivity.
Qed.

Theorem ble_nat_refl : forall n:nat,
  true = ble_nat n n.
Proof.
  intros n.
  induction n as [|n'].
  simpl.
  reflexivity.
  simpl.
  rewrite -> IHn'.
  reflexivity.
Qed.

Theorem zero_nbeq_S : forall n:nat,
  beq_nat 0 (S n) = false.
Proof.
  intros n.
  simpl.
  reflexivity.
Qed.

Theorem andb_false_r : forall b : bool,
  andb b false = false.
Proof.
  intros b.
  destruct b as [|b'].
  simpl.
  reflexivity.
  simpl.
  reflexivity.
Qed.

Theorem plus_ble_compat_l : forall n m p : nat,
  ble_nat n m = true -> ble_nat (p + n) (p + m) = true.
Proof.
  intros n m p H1.
  induction p as [|p'].
  simpl.
  rewrite -> H1.
  reflexivity.
  simpl.
  rewrite -> IHp'.
  reflexivity.
Qed.

Theorem S_nbeq_0 : forall n:nat,
  beq_nat (S n) 0 = false.
Proof.
  intros n.
  simpl.
  reflexivity.
Qed.

Theorem mult_1_l : forall n:nat, 1 * n = n.
Proof.
  intros n.
  simpl.
  assert (plus_0_r: forall m : nat, m + 0 = m).
  induction m as [|m'].
  simpl.
  reflexivity.
  simpl.
  rewrite -> IHm'.
  reflexivity.
  rewrite -> plus_0_r.
  reflexivity.
Qed.

Theorem all3_spec : forall b c : bool,
    orb
      (andb b c)
      (orb (negb b)
               (negb c))
  = true.
Proof.
  intros b c.
  destruct b as [|b'].
  Case "b = true".
  destruct c as [|c'].
  SCase "c = true".
  simpl.
  reflexivity.
  SCase "c = false".
  simpl.
  reflexivity.
  Case "b = false".
  destruct c as [|c'].
  SCase "c = true".
  simpl.
  reflexivity.
  SCase "c = false".
  simpl.
  reflexivity.
Qed.

Theorem mult_plus_distr_r : forall n m p : nat,
  (n + m) * p = (n * p) + (m * p).
Proof.
  intros n m p.
  induction n as [|n'].
  Case "n = 0".
  simpl.
  reflexivity.
  Case "n = S n'".
  simpl.
  rewrite -> IHn'.
  rewrite -> plus_assoc.
  reflexivity.
Qed.

Theorem mult_assoc : forall n m p : nat,
  n * (m * p) = (n * m) * p.
Proof.
  intros n m p.
  induction n as [|n'].
  Case "n = 0".
  simpl.
  reflexivity.
  Case "n = S n'".
  simpl.
  rewrite -> IHn'.
  rewrite -> mult_plus_distr_r.
  reflexivity.
Qed.

Theorem plus_swap' :
  forall n m p : nat, n + (m + p) = m + (n + p).
Proof.
  intros n m p.
  rewrite -> plus_assoc.
  rewrite -> plus_assoc.
  replace (m + n) with (n + m).
  reflexivity.
  rewrite -> plus_comm.
  reflexivity.
Qed.

(** binary **)

Module Binary.

  Inductive bin : Type :=
  | Zero  : bin
  | Twice : bin -> bin
  | TwicePlusOne : bin -> bin.

Fixpoint inc (b:bin) : bin :=
  match b with
      | Zero => TwicePlusOne Zero
      | Twice b' => TwicePlusOne b'
      | TwicePlusOne b' => Twice (inc b')
  end.

Fixpoint bin_to_nat (b:bin) : nat :=
  match b with
      | Zero => O
      | Twice b' => 2 * (bin_to_nat b')
      | TwicePlusOne b' => 1 + 2 * (bin_to_nat b')
  end.

Check inc.
Eval simpl in (inc Zero).
Eval simpl in (inc (inc Zero)).
Eval simpl in bin_to_nat (inc (inc (inc Zero))).
Eval simpl in (inc (inc (inc (inc Zero)))).
Eval simpl in bin_to_nat (inc (inc (inc (inc Zero)))).

Theorem bin_nat_comm:
  forall b:bin, bin_to_nat (inc b) = 1 + (bin_to_nat b).
Proof.
  intros b.
  induction b as [|b1|b2].
  Case "b = Zero".
  simpl.
  reflexivity.
  Case "b = Twice b'".
  simpl.
  reflexivity.
  Case "b = TwicePlusOne b'".
  simpl.
  rewrite -> plus_0_r.
  rewrite -> plus_0_r.
  rewrite -> IHb2.
  simpl.
  rewrite <- plus_n_Sm.
  reflexivity.
Qed.

Fixpoint nat_to_bin (n:nat) : bin:=
  match n with
    | O => Zero
    | S n' => inc (nat_to_bin n')
  end.

Eval simpl in (inc Zero).
Eval simpl in nat_to_bin 1.
Eval simpl in (inc (inc Zero)).
Eval simpl in nat_to_bin 2.
Eval simpl in (inc (inc (inc Zero))).
Eval simpl in bin_to_nat (nat_to_bin 3).

Theorem nat_bin_comm:
  forall n:nat, bin_to_nat (nat_to_bin n) = n.
Proof.
  intros n.
  induction n as [|n'].
  Case "n = 0".
  simpl.
  reflexivity.
  Case "n = S n'".
  simpl.
  rewrite -> bin_nat_comm.
  simpl.
  rewrite -> IHn'.
  reflexivity.
Qed.

End Binary.


From Coq Require Import Arith.Arith.
From Coq Require Import Bool.Bool.
Require Export Coq.Strings.String.
From Coq Require Import Logic.FunctionalExtensionality.
From Coq Require Import Lists.List.
Import ListNotations.

Example apply_ex1:forall P Q:Prop,
(P->Q)->P->Q.
Proof.
  intros P Q P_imply_Q P_holds.
  (*apply P_imply_Q in P_holds.*) (* 正向推理 结果为将P_holds变为Q*)
  apply P_imply_Q.
  apply P_holds.
Qed.

Theorem silly1 : forall (n m o p : nat),
     n = m  ->
     [n;o] = [n;p] ->
     [n;o] = [m;p].
Proof.
  intros n m o p eq1 eq2.
  rewrite <- eq1.
  apply eq2.  Qed.

Theorem silly2 : forall (n m o p : nat),
     n = m  ->
     (forall (q r : nat), q = r -> [q;o] = [r;p]) ->
     [n;o] = [m;p].
Proof.
  intros n m o p eq1 eq2.
  apply eq2. apply eq1.  Qed.

Theorem trans_eq : forall (X:Type) (n m o : X),
  n = m -> m = o -> n = o.
Proof.
  intros X n m o eq1 eq2. rewrite -> eq1. rewrite -> eq2.
  reflexivity.  Qed.

Example trans_eq_example' : forall (a b c d e f : nat),
     [a;b] = [c;d] ->
     [c;d] = [e;f] ->
     [a;b] = [e;f].
Proof.
  intros a b c d e f eq1 eq2.
  apply trans_eq with (m:=[c;d]).
  apply eq1. apply eq2.   Qed.

Theorem trans_eq_2 : forall (X:Type) (n m o p : X),
  n = m -> m = p -> p = o -> n = o.
Proof.
Admitted.

Example trans_eq_example'_2 : forall (a b c d e f h i: nat),
     [a;b] = [c;d] ->
     [c;d] = [e;f] ->
     [e;f] = [h;i] ->
     [a;b] = [h;i].
Proof.
  intros a b c d e f h i eq1 eq2 eq3.
  apply trans_eq_2 with (m:=[c;d]) (p:=[e;f]).
  apply eq1. apply eq2. apply eq3.
Qed.

(*通过在此处编写injection H
我们命令Coq使用构造子的单射性来产生所有它能从H所推出的等式
每一个产生的等式都作为一个前件附加在目标上
在这个例子中 附加了前件n=m*)
Theorem S_injective' : forall (n m : nat),
  S n = S m ->
  n = m.
Proof.
  intros n m H.
  injection H. intros Hnm. apply Hnm.
Qed.

(*爆炸原理可能令你费解
那么请记住上述证明并不肯定其后件
而是说明:倘若荒谬的前件成立 则会得出荒谬的结论*)
Theorem discriminate_ex2 : forall (n m : nat),
  false = true ->
  [n] = [m].
Proof.
  intros n m contra. discriminate contra. Qed.


Inductive list (X:Type) : Type :=
  | nil
  | cons (x : X) (l : list X).

Arguments nil {X}.
Arguments cons {X}.

Fixpoint app {X : Type} (l1 l2 : list X) : list X :=
  match l1 with
  | nil => l2
  | cons h t => cons h (app t l2)
  end.
Fixpoint rev {X:Type} (l:list X) : list X :=
  match l with
  | nil => nil
  | cons h t => app (rev t) (cons h nil)
  end.
Fixpoint length {X : Type} (l : list X) : nat :=
  match l with
  | nil => 0
  | cons _ l' => S (length l')
  end.

Notation "x :: y" := (cons x y)
                     (at level 60, right associativity).
Notation "[ ]" := nil.
Notation "[ x ; .. ; y ]" := (cons x .. (cons y []) ..).
Notation "x ++ y" := (app x y)
                     (at level 60, right associativity).

Inductive prod (X Y : Type) : Type :=
| pair (x : X) (y : Y).
Arguments pair {X} {Y}.
Notation "( x , y )" := (pair x y).
Notation "X * Y" := (prod X Y) : type_scope.
Fixpoint even (n:nat) : bool :=
  match n with
  | O => true
  | S O => false
  | S (S n') => even n'
  end.
Fixpoint eqb (n m : nat) : bool :=
  match n with
  | O => match m with
         | O => true
         | S m' => false
         end
  | S n' => match m with
            | O => false
            | S m' => eqb n' m'
            end
  end.
Notation "x =? y" := (eqb x y) (at level 70) : nat_scope.
Fixpoint filter {X:Type} (test: X -> bool) (l:list X) : list X :=
  match l with
  | [] => []
  | h :: t =>
    if test h then h :: (filter test t)
    else filter test t
  end.
  Fixpoint leb (n m : nat) : bool :=
    match n with
    | O => true
    | S n' =>
        match m with
        | O => false
        | S m' => leb n' m'
        end
    end.
Definition negb (b : bool) : bool :=
    match b with
    | true => false
    | false => true
    end.
Definition odd (n:nat) : bool :=
  negb (even n).

(* Given a set X, a predicate of type X → bool and a list X, partition should return a pair of lists. The first member of the pair is the sublist of the original list containing the elements that satisfy the test, and the second is the sublist containing those that fail the test. The order of elements in the two sublists should be the same as their order in the original list. *)
Definition partition {X : Type} (test : X -> bool) (l : list X) : list X * list X :=
    (filter test l, filter (fun n => negb (test n)) l).

Example test_partition1: partition odd [1;2;3;4;5] = ([1;3;5], [2;4]).
Proof. reflexivity. Qed.
Example test_partition2: partition (fun x => false) [5;9;0] = ([], [5;9;0]).
Proof. reflexivity. Qed.

(* very easy 3 star imo *)


Inductive ev: nat -> Prop :=
| ev_0: ev 0
| ev_SS: forall n: nat, ev n -> ev (S (S n)).

(** **** Exercise: 1 star (eight_is_even)  *)
Theorem ev_8: ev 8.
Proof.
  apply ev_SS.
  apply ev_SS.
  apply ev_SS.
  apply ev_SS.
  apply ev_0.
Qed.

Print ev_8.

Definition ev_8' : ev 8 := ev_SS 6 (ev_SS 4 (ev_SS 2 (ev_SS 0 ev_0))).

(** **** Exercise: 2 stars, optional (conj_fact)  *)
Theorem test: forall P Q R, P /\ Q -> Q /\ R -> P /\ R.
Proof.
  intros P Q R H1 H2.
  split.
  - apply H1.
  - apply H2.
Qed.

Print test.

Definition conj_fact: forall P Q R, P /\ Q -> Q /\ R -> P /\ R :=
  fun (P Q R: Prop)(H1: P /\ Q)(H2: Q /\ R) =>
    conj
      (let H := match H1 with
                | conj x _ => x
                end : P in H)
      (let H := match H2 with
                | conj _ x0 => x0
                end : R in H).


(* This file illustrates two approaches to C verification,
  described in Section III of this paper:

 Modular Verification for Computer Security,
 by Andrew W. Appel, in IEEE Computer Security Foundations conference (CSF'16),
 June 2016.
 http://www.cs.princeton.edu/~appel/papers/modsec.pdf
*)

Require Import floyd.proofauto.
Require Import progs.min.
Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs.  mk_varspecs prog. Defined.

Require Import ZArith.
Require Import List.
Import ListNotations.
Open Scope Z.

Theorem fold_min_general:
  forall (al: list Z)(i: Z),
  In i (al) ->
  forall x, List.fold_right Z.min x al <= i.
Proof.
induction al; intros.
inversion H.
destruct H.
subst a.
simpl.
apply Z.le_min_l.
simpl. rewrite Z.le_min_r.
apply IHal.
apply H.
Qed.

Theorem fold_min:
  forall (al: list Z)(i: Z),
  In i (al) ->
  List.fold_right Z.min (hd 0 al) al <= i.
Proof.
intros.
apply fold_min_general.
apply H.
Qed.

Lemma Forall_fold_min:
  forall (f: Z -> Prop) (x: Z) (al: list Z),
    f x -> Forall f al -> f (fold_right Z.min x al).
Proof.
 intros.
 induction H0.
 simpl. auto.
 simpl.
 unfold Z.min at 1.
 destruct (Z.compare x0 (fold_right Z.min x l)) eqn:?; auto.
Qed.

Lemma fold_min_another:
  forall x al y,
    fold_right Z.min x (al ++ [y]) = Z.min (fold_right Z.min x al) y.
Proof.
 intros.
 revert x; induction al; simpl; intros.
 apply Z.min_comm.
 rewrite <- Z.min_assoc. f_equal.
 apply IHal.
Qed.

Lemma is_int_I32_Znth_map_Vint:
 forall i s al v,
  0 <= i < Zlength al ->
  is_int I32 s (Znth i (map Vint al) v).
Proof.
intros. rewrite Znth_map with (d':= Int.zero); auto.
Qed.
Hint Extern 3 (is_int I32 _ (Znth _ (map Vint _) _)) =>
  (apply  is_int_I32_Znth_map_Vint; rewrite ?Zlength_map; omega).

Definition minimum_spec :=
 DECLARE _minimum
  WITH a: val, n: Z, al: list Z
  PRE [ _a OF tptr tint , _n OF tint ]
    PROP  (1 <= n <= Int.max_signed; Forall repable_signed al)
    LOCAL (temp _a a; temp _n (Vint (Int.repr n)))
    SEP   (data_at Ews (tarray tint n) (map Vint (map Int.repr al)) a)
  POST [ tint ]
    PROP ()
    LOCAL(temp ret_temp  (Vint (Int.repr (fold_right Z.min (hd 0 al) al))))
    SEP   (data_at Ews (tarray tint n) (map Vint (map Int.repr al)) a).

Definition Gprog : funspecs :=
      ltac:(with_library prog [minimum_spec]).

(* First approach from "Modular Verification for Computer Security",
  proved using forward_for_simple_bound *)
Lemma body_min: semax_body Vprog Gprog f_minimum minimum_spec.
Proof.
start_function.
assert_PROP (Zlength al = n). {
  entailer!. autorewrite with sublist; auto.
}
revert POSTCONDITION;
 replace (hd 0 al) with (Znth 0 al 0) by (destruct al; reflexivity);
 intro POSTCONDITION.
forward.  (* min = a[0]; *)
autorewrite with sublist.
forward_for_simple_bound n
  (EX i:Z,
    PROP()
    LOCAL(temp _min (Vint (Int.repr (fold_right Z.min (Znth 0 al 0) (sublist 0 i al))));
          temp _a a;
          temp _n (Vint (Int.repr n)))
    SEP(data_at Ews (tarray tint n) (map Vint (map Int.repr al)) a)).
* (* Prove that the precondition implies the loop invariant *)
 entailer!.
*
 forward. (* j = a[i]; *)
 assert (repable_signed (Znth i al 0))
     by (apply Forall_Znth; auto; omega).
 assert (repable_signed (fold_right Z.min (Znth 0 al 0) (sublist 0 i al)))
   by (apply Forall_fold_min;
          [apply Forall_Znth; auto; omega
          |apply Forall_sublist; auto]).
 autorewrite with sublist.
 subst POSTCONDITION; unfold abbreviate.
 rewrite (sublist_split 0 i (i+1)) by omega.
 rewrite (sublist_one i (i+1) al 0) by omega.
 rewrite fold_min_another.
 forward_if.
 +
 forward. (* min = j; *)
 entailer!. rewrite Z.min_r; auto; omega.
 +
 forward. (* skip; *)
 entailer!. rewrite Z.min_l; auto; omega.
*
 forward. (* return *)
 entailer!.
 autorewrite with sublist. auto.
Qed.

(* Demonstration of the same theorem, but using
    forward_for  instead of forward_for_simple_bound *)
Lemma body_min': semax_body Vprog Gprog f_minimum minimum_spec.
Proof.
start_function.
assert_PROP (Zlength al = n). {
  entailer!. autorewrite with sublist; auto.
}
revert POSTCONDITION;
 replace (hd 0 al) with (Znth 0 al 0) by (destruct al; reflexivity);
 intro POSTCONDITION.
forward.  (* min = a[0]; *)
pose (Inv d (f: Z->Prop) (i: Z) :=
    PROP(0 <= i <= n; f i)
    LOCAL(temp _min (Vint (Int.repr (fold_right Z.min (Znth 0 al 0) (sublist 0 (i+d) al))));
          temp _a a; temp _i (Vint (Int.repr i));
          temp _n (Vint (Int.repr n)))
    SEP(data_at Ews (tarray tint n) (map Vint (map Int.repr al)) a)).
forward_for (Inv 0 (fun _ => True)) (Inv 1 (Z.gt n)).
*
forward.
Exists 0. unfold Inv; entailer!.
*
entailer!.
*
rename a0 into i.
 forward. (* j = a[i]; *)
 assert (repable_signed (Znth i al 0))
     by (apply Forall_Znth; auto; omega).
 assert (repable_signed (fold_right Z.min (Znth 0 al 0) (sublist 0 i al)))
   by (apply Forall_fold_min;
          [apply Forall_Znth; auto; omega
          |apply Forall_sublist; auto]).
 autorewrite with sublist.
 apply semax_post_flipped with  (normal_ret_assert (Inv 1 (Z.gt n) i)).
 unfold Inv.
 rewrite (sublist_split 0 i (i+1)) by omega.
 rewrite (sublist_one i (i+1) al 0) by omega.
 rewrite fold_min_another.
 forward_if.
 +
 forward. (* min = j; *)
 entailer!. rewrite Z.min_r; auto; omega.
 +
 forward. (* skip; *)
 entailer!. rewrite Z.min_l; auto; omega.
 +
 intros.
 subst POSTCONDITION; unfold abbreviate. (* TODO: some of these lines should all be done by forward_if *)
 unfold normal_ret_assert. normalize. autorewrite with ret_assert.
 (* TODO: entailer! fails here with a misleading error message *)
 Exists i. apply andp_left2. normalize.
*
 rename a0 into i.
 forward.
 Exists (i+1).
 entailer!.
*
 autorewrite with sublist.
 forward.
Qed.

Definition minimum_spec2 :=
 DECLARE _minimum
  WITH a: val, n: Z, al: list Z
  PRE [ _a OF tptr tint , _n OF tint ]
    PROP  (1 <= n <= Int.max_signed; Forall repable_signed al)
    LOCAL (temp _a a; temp _n (Vint (Int.repr n)))
    SEP   (data_at Ews (tarray tint n) (map Vint (map Int.repr al)) a)
  POST [ tint ]
   EX j: Z,
    PROP (In j al; Forall (fun x => j<=x) al)
    LOCAL(temp ret_temp  (Vint (Int.repr j)))
    SEP   (data_at Ews (tarray tint n) (map Vint (map Int.repr al)) a).

(* Second approach from "Modular Verification for Computer Security",
  proved using forward_for_simple_bound *)
Lemma body_min2: semax_body Vprog Gprog f_minimum minimum_spec2.
Proof.
start_function.
assert_PROP (Zlength al = n). {
  entailer!. autorewrite with sublist; auto.
}
forward.  (* min = a[0]; *)
autorewrite with sublist.
forward_for_simple_bound n
  (EX i:Z, EX j:Z,
    PROP(
         In j (sublist 0 (Z.max 1 i) al);
         Forall (Z.le j) (sublist 0 i al))
    LOCAL(
          temp _min (Vint (Int.repr j));
          temp _a a;
          temp _n (Vint (Int.repr n)))
    SEP(data_at Ews (tarray tint n) (map Vint (map Int.repr al)) a)).
* (* Show that the precondition entails the loop invariant *)
Exists (Znth 0 al 0).
autorewrite with sublist.
entailer!.
rewrite sublist_one with (d:=0) by omega.
constructor; auto.
* (* Show that the loop body preserves the loop invariant *)
Intros.
forward. (* j = a[i]; *)
assert (repable_signed (Znth i al 0))
   by (apply Forall_Znth; auto; omega).
autorewrite with sublist in *.
assert (repable_signed x)
   by (eapply Forall_forall; [ | eassumption]; apply Forall_sublist; auto).
forward_if.
 + (* Then clause *)
 forward. (* min = j; *)
 Exists (Znth i al 0).
 entailer!.
 rewrite Z.max_r by omega.
 rewrite (sublist_split 0 i (i+1)) by omega.
 rewrite (sublist_one i (i+1) al 0) by omega.
 split.
 apply in_app; right; constructor; auto.
 apply Forall_app; split.
 eapply Forall_impl; try apply H4.
 intros; omega.
 constructor; auto. omega.
 + (* Else clause *)
 forward. (* skip; *)
 Exists x.
 autorewrite with sublist.
 entailer!.
 split.
 destruct (zlt 1 i).
 rewrite Z.max_r in H3 by omega.
 rewrite (sublist_split 0 i (i+1)) by omega.
 apply in_app; left; auto.
 rewrite Z.max_l in H3 by omega.
 rewrite (sublist_split 0 1 (i+1)) by omega.
 apply in_app; left; auto.
 rewrite (sublist_split 0 i (i+1)) by omega.
 apply Forall_app. split; auto.
 rewrite (sublist_one _ _ _ 0) by omega.
 repeat constructor. omega.
* (* After the loop *)
 Intros x.
 autorewrite with sublist in *.
 forward. (* return *)
 Exists x.
 entailer!.
Qed.


Require Export ssreflect.

Axiom ExcludedMiddle :
  forall P, P \/ ~ P.

Theorem DoubleNegative (P : Prop) :
  ~~ P <-> P.
Proof.
  split.
  + intro notP.
    case (ExcludedMiddle P) as [p  | notp].
  - apply p.
  - case (notP notp).
    + intros p notp.
      apply (notp p).
Qed.

Theorem DeMorgan_notand (A B : Prop) :
  ~ (A /\ B) <-> ~ A \/ ~ B.
Proof.
  split => [H | H].
  + case (ExcludedMiddle A) as [a | nota].
  - apply or_intror.
    intro b.
    apply (H (conj a b)).
  - apply (or_introl nota).
    + intro ab.
      induction ab as [a b].
      induction H as [nota | notb].
  - apply (nota a).
  - apply (notb b).
Qed.

Theorem DeMorgan_notor (A B : Prop) :
  ~ (A \/ B) <-> ~ A /\ ~ B.
Proof.
  split => [H | H].
  + split.
  - intro a.
    apply (H (or_introl a)).
  - intro b.
    apply (H (or_intror b)).
    + induction H as [nota notb].
      intro ab.
      induction ab as [a | b].
  - apply (nota a).
  - apply (notb b).
Qed.

Theorem contrapositive (A B : Prop) :
  (A -> B) <-> (~ B -> ~ A).
Proof.
  split => [H | H].
  + intros notb a.
    apply (notb (H a)).
  + intro a.
    apply DoubleNegative.
    intro notb.
    apply ((H notb) a).
Qed.

Theorem notall_existsnot (X : Type) (P : X -> Prop) :
  ~ (forall x, P x) <-> exists x, ~ P x.
Proof.
  split.
  + apply contrapositive.
    intros H.
    apply DoubleNegative.
    intro x.
    case (ExcludedMiddle (P x)) as [Px | notPx ].
  - done.
  - assert (Px : exists x, ~ P x).
    * exists x.
      apply notPx.
    * case (H Px).
    + intros H allPx.
      induction H as [x notPx].
      specialize (allPx x) as Px.
      apply (notPx Px).
Qed.

Theorem allnot_notexists (X : Type) (P : X  -> Prop) :
  (forall x, ~ P x) <->  ~ exists x, P x.
Proof.
  split.
  + apply contrapositive.
    intro H.
    apply (DoubleNegative (exists x, P x)) in H.
    apply (notall_existsnot X (fun x => ~ P x)).
    induction H as [x Px].
    exists x.
      by apply DoubleNegative.
  + intros H x Px.
    apply H.
    exists x.
    apply Px.
Qed.


(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Unset Positivity Checking.
Unset Guard Checking.

Inductive nat : Set :=
| O : nat
| S : nat -> nat.

Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) {struct plus_arg0}
  : natural :=
  match plus_arg0 with
  | Zero => plus_arg1
  | Succ n => Succ (plus n plus_arg1)
  end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) {struct mult_arg0}
  : natural :=
  match mult_arg0 with
  | Zero => Zero
  | Succ n => plus (mult n mult_arg1) mult_arg1
  end.

Definition synth (y : natural) (x : natural) : natural := mult (Succ y) (Succ x).


Require Import ZArith.
Definition szam (k:Z):Z:=
  k.

Print Z.

Eval compute in szam (Zneg 10).

Inductive Z_btree : Set :=
  | leaf : Z -> Z_btree
  | bnode : Z -> Z_btree-> Z_btree -> Z_btree.

Eval compute in szam 0.

Type (leaf 0).

Fixpoint vannulla(t:Z_btree):bool:=
  match t with
  | leaf 0=> true
  | leaf _=> false
  | bnode 0 t1 t2 => true
  | bnode _ t3 t4 => orb(vannulla(t3))(vannulla(t4))
  end.

Require Import BinPos BinInt Decidable Zcompare.
Require Import Arith_base.
Local Open Scope Z_scope.
Notation dec_eq := Z.eq_decidable (only parsing).
Notation dec_Zle := Z.le_decidable (only parsing).
Notation dec_Zlt := Z.lt_decidable (only parsing).

Print Z.eqb.

Eval compute in Z.eqb (0)(0).

Eval compute in vannulla(bnode (-1) (leaf 10)(leaf (0))).

Fixpoint vanbennek(t:Z_btree)(k:Z):bool:=
  match t with
  | leaf m=> Z.eqb(k)(m)
  | bnode u t1 t2 => match Z.eqb(k)(u) with
                       | true => true
                       | false => orb(vanbennek(t1)(k))(vanbennek(t2)(k))
                        end
  end.

Eval compute in vanbennek(bnode (-1) (leaf 10)(leaf (0)))(10).