From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Axiom replace_with_your_solution_here : forall {A : Type}, A.

(** * Exercise: finish the development we started at the last seminar *)

(** * Odd and even numbers *)

(** ** Part 1: Definitions *)

Section OddAndEven.

(** The goal of this exercise is to build a system of canonical structures
    so that the following statement about some properties of
    odd natural numbers can be proved with a couple of simple rewrites:

    Example test_odd (n : odd_nat) :
      ~~ (odd 6) && odd (n * 3).
    Proof. by rewrite oddP evenP. Qed.

    See the definitions of [odd_nat], [oddP], and [evenP] below.
    If you do everything the right way the example at the end of the section will work.
    In other words, the goal of this exercise is not to prove a statement,
    but rather make the given proof work.
    Please, DO NOT CHANGE the proof (I can assure you it works if the right canonical structures are given)
 *)

(** Let us define a structure defining the notion of odd numbers *)
Structure odd_nat := Odd {
  oval : nat;            (** [oval] is a natural number *)
  oprop : odd oval       (** [oprop] is the proof it is odd *)
}.

(** Example: [42 - 1] is an odd number *)

Definition o41 : odd_nat := @Odd 41 isT.

(** One issue here is that we cannot, for instance, add two odd naturals: *)
Fail Check o41 + o41.

(** Let's declare [oval] a coercion to work with terms of type [odd_nat]
    as if those were just regular naturals.
 *)
Coercion oval : odd_nat >-> nat.

Check o41 + o41.    (** Notice the result type is [nat] here: to use [odd_nat] as [nat] we forget the
                        extra information about oddity *)

(** Prove the main property of [odd_nat] *)
Lemma oddP {n : odd_nat} : odd n.
Proof.
  move : (oprop n).
  done.
Qed.

(** Let us do the analogous thing for the even numbers *)
Structure even_nat := Even {
  eval :> nat;
  eprop : ~~ (odd eval)
}.

(* Prove the main property of [even_nat] *)
Lemma evenP {n : even_nat} : ~~ (odd n).
Proof.
  move : (eprop n).
  done.
Qed.

(** Now we have all the definitions we referred to in the problem definition.  *)

(** The objective is to make it work: knowing that
    [n] is [odd] Coq should infer that [n * 3]
    is also [odd], and that [6] is even *)
Example test_odd (n : odd_nat) : ~~ (odd 6) && odd (n * 3).
Proof.
  Fail by rewrite oddP evenP.
Abort.

(** But Coq cannot infer it without any hints.
    The goal to provide the necessary hints in the form of canonical structure instances *)

(** Let's start by telling Coq that 0 is even *)

Print isT.
Canonical even_0 : even_nat := @Even 0 isT.

(** helper lemma *)
Lemma oddS n : ~~ (odd n) -> odd n.+1.
Proof.
  Show.
  case : n; rewrite //=.
Qed.

(** helper lemma *)
Lemma evenS n : (odd n) -> ~~ (odd n.+1).
Proof.
  case : n; rewrite //=.
  move => n.
  case : (odd n); rewrite //=.
Qed.

(** Here we teach Coq that if [m] is even,
    then [m.+1] is [odd] *)
Canonical odd_even (m : even_nat) : odd_nat :=
  @Odd m.+1 (oddS (eprop m)).

(** Implement the dual, teach Coq that if [m]
    is [odd] then [m.+1] is [even] *)
Canonical even_odd (m : odd_nat) : even_nat :=
  @Even m.+1 (evenS (oprop m)).

Unset Printing Notations.
Set Printing Notations.

(** Now let's deal with multiplication:
    DO NOT USE [case] tactic or the square brackets to
    destruct [n] or [m] *)
Lemma odd_mulP {n m : odd_nat} : odd (n * m).
Proof.
(** (!) do not break up [n] or [m] *)
  rewrite oddM.
  set h1 := oprop n.
  set h2 := oprop m.
  rewrite h1 h2.
  done.
Qed.

  (** teach Coq that [*] preserves being [odd] *)

Canonical oddmul_Odd (n m : odd_nat) : odd_nat :=
  @Odd (muln n m) (@odd_mulP n m).

(** If the following proof works it means you did everything right: *)

Example test_odd (n : odd_nat) :
  ~~ (odd 6) && odd (n * 3).
Proof.
  rewrite //=.
  apply : odd_mulP.
Qed.

End OddAndEven.

(** ** Part 2: Equality for [odd_nat] *)

(** We cannot use [==] on [odd] natural numbers because
   [odd_nat] is not an [eqType] *)
Fail Check forall n : odd_nat, n == n.

(** * Optional exercise: define [eqType] instance for [odd_nat] *directly* *)

Definition eq_odd_nat (m n : odd_nat) : bool :=
 (oval m) == (oval n).
(* Hint: since you are comparing two structures you might think
   you need to check that both components of the structures are equal:
   this is not a problem for the first component of type [nat],
   but then you'll need to compare two *proofs* and this is
   tricky in general.
   However, here you actually don't need to compare the proofs at all:
   simply compare the first components and then you'll still be able
   to prove [Equality.axiom].
 *)

About Bool.reflect.

About eqP.

About eq_irrelevance.

Unset Printing All.
Set Printing Coercions.
Set Printing Implicit.
Unset Printing Notations.

About eq_irrelevance.

Lemma odK (x : odd_nat) : x = @Odd (oval x) (oprop x).
Proof.
  by case : x.
Qed.

Lemma eq_odd_axiom : Equality.axiom eq_odd_nat.
Proof.
  rewrite /Equality.axiom /eq_odd_nat.
  move => x y.
  case : x.
  case : y.
  move => n nodd m modd.
  case : eqP; rewrite //= => h1; constructor; move : nodd modd.
  - rewrite h1 => nodd modd.
      by rewrite (eq_irrelevance modd nodd).
  - rewrite /not.
    move => nodd modd.
    case.
    apply h1.
Qed.

(*
 Hint 1: use [case: eqP] to case analyse on equality between natural numbers
         (you might need to do some definition unfolding before you can use it).

 Hint 2: use [eq_irrelevance] lemma (you might need to specify the exact
         occurence you want to rewrite like so rewrite [proof_name]eq_irrelevance).
*)

(** * Exercise: define [eqType] instance for [odd_nat] using [subType] *)

(* Since [odd_nat] is a subtype of natural numbers, i.e.
   a structure with a number and an additional (computable) constraint on it,
   we can use the [subType] machinery to derive equality (and not only equality)
   on it. *)
(* First, you derive [subType] instance by specifying the projection like: *)

Canonical oddnat_subType := Eval hnf in [subType for oval].

Print oddnat_subType.

(* Then you derive the equality mixin be specifying the type: *)

Definition oddnat_eqMixin := Eval hnf in [eqMixin of odd_nat by <:].

(* Comment out the the line with [Canonical oddnat_subType] above and
   make sure deriving of [oddnat_eqMixin] fails. *)

(* Now finish the definition of [eqType] for [oddnat]: *)

(* ADD YOUR CODE HERE *)

Print Equality.Pack.

Canonical oddnat_eqType := Equality.Pack oddnat_eqMixin.

(* This should work now *)

Check forall n : odd_nat, n == n.

Lemma odd_nat_eq_refl (n : odd_nat) :
  n == n.
Proof. by rewrite eq_refl. Qed.

(** * Exercise: Now deal with [even_nat] *)
Fail Check forall (m : even_nat), m == m.

(* ADD CODE HERE *)

Canonical evennat_subType := Eval hnf in [subType for eval].
Definition evennat_eqMixin := Eval hnf in [eqMixin of even_nat by <:].
Canonical evennat_eqType := Equality.Pack evennat_eqMixin.

Check forall (m : even_nat), m == m.

Lemma even_nat_eq_refl (n : even_nat) :
  n == n.
Proof. by rewrite eq_refl. Qed.

(*

==== OPTIONAL EXERCISES ====

Exercises in this section are not related to canonical structures
*)

(** An optional exercise with a short and a bit tricky one-line solution (less than 70 characters): *)

Set Printing Notations.

Lemma triple_compb_long (f : bool -> bool) :
  f \o f \o f =1 f.
Proof.
  have h y : f y = true \/ f y = false. by case : (f y); intuition.
  by case : (h true) (h false); case => p; case => q; case; rewrite /comp ?p ?q ?p ?q.
Qed.

Lemma triple_compb (f : bool -> bool) :
  f \o f \o f =1 f.
Proof.
  by rewrite /comp; case; case E : (f true); case D : (f false); rewrite ?E ?D.
Qed.

(** Hint: use [case <identifier>: <term>] tactic
          to pattern match on [<term>] and keep the result
          as an equation <identifier> in the context.
          E.g. [case E: b] where [b : bool] creates two subgoals with two equations
          in the context: [E = true] and [E = false] corresponingly.
 *)

(** Optional exercises: provide one-line proofs *)
Section EckmannHilton.
(** Here is an explanation for this section:
    https://en.wikipedia.org/wiki/Eckmann–Hilton_argument
    Hint: you can find informal proofs in that wiki page,
          use it as a source of inspiration if you get stuck.
 *)

Context {X : Type}.
Variables f1 f2 : X -> X -> X.

Variable e1 : X.
Hypothesis U1 : left_id e1 f1 * right_id e1 f1.

Variables e2 : X.
Hypothesis U2 : left_id e2 f2 * right_id e2 f2.

Hypothesis I : interchange f1 f2.

Compute interchange f1 f2.

Compute left_id e1 f1.

Compute right_id e1 f1.

Lemma units_same :
  e1 = e2.
Proof.
  rewrite -[e1] U1 -{1}[e1] U2 -{2}[e1] (snd U2) I !U1 U2. done.
Qed.

Locate "=2".

Lemma operations_equal :
  f1 =2 f2.
Proof.
  move => x y; rewrite - {1}[x] (snd U2) -{1}[y] U2 I -units_same !U1.
  done.
Qed.

Lemma I1 : interchange f1 f1.
Proof.
  move => x y z w; rewrite operations_equal -I -![f2 _ _]operations_equal.
  done.
Qed.

Lemma operations_comm :
  commutative f1.
Proof.
  move => x y.
  rewrite operations_equal -{1}[y](snd U1) -{1}[x]U1 -I units_same !U2.
  done.
Qed.

Lemma operations_assoc :
  associative f1.
Proof.
  move => x y z. rewrite -{2}[z]U1 I1 U1. done.
Qed.

End EckmannHilton.


(* ================================================================== *)
Section EX.

Variables (A:Set) (P : A->Prop).
Variable Q:Prop.

(* Check the type of an expression. *)
Check P.
Check Set.
Check A -> Prop.

Variable a:A.

Check P a.

Lemma trivial : forall x:A, P x -> P x.
Proof.
  intros.
  assumption.
Qed.

Lemma trivial2 : forall x:A, P x -> P x.
Proof.
  intro y.
  intro I.
  assumption.
Qed.

(* Prints the definition of an identifier. *)
Print trivial.

Lemma example : forall x:A, (Q -> Q -> P x) -> Q -> P x.
Proof.
  intros x H H0.
  apply H.
  assumption.
  assumption.
Qed.

Print example.

Proposition nova : Q -> ~ ~ Q.
Proof.
  intros.
  unfold not.
  intros.
  apply H0.
  assumption.
Qed.           (* when we close the proof the definition of the identifier
                  "nova" goes to the global environment *)

Theorem demo : forall y,  Q -> (~ ~ Q -> P y) -> P y.
Proof.
  intros.
  apply H0.
  apply nova.   (* we can use a definition in the global environment *)
  assumption.
Qed.

End EX.

Print trivial.
Print example.
(* ================================================================== *)

(* ================================================================== *)
(* ====================== Propositional Logic ======================= *)
(* ================================================================== *)

Section ExamplesPL.

Variables Q P :Prop.

Lemma ex1 : (P -> Q) -> ~Q -> ~P.
Proof.
  tauto.
Qed.

Print ex1.

Lemma ex1' : (P -> Q) -> ~Q -> ~P.
Proof.
  intros.
  intro.
  apply H0.
  apply H.
  assumption.
Qed.

Print ex1'.

Lemma ex2 : P /\ Q -> Q /\ P.
Proof.
  intro H.
  split.
  destruct H as [H1 H2].
  exact H2.
  destruct H; assumption. (*assumption.
  destruct H as [H1 H2].
  assumption.*)
Qed.

(* We can itemize the subgoals using - for each of them. Note that whem entering in this mode the other subgoals are not displayed. For nested item use the symbols -, +, *, --, ++, **, ... *)
Lemma ex2' : P /\ Q -> Q /\ P.
Proof.
  intro H.  split.
  - destruct H as [H1 H2]. exact H2. (*assumption.*)
  - destruct H; assumption.
Qed.

Lemma ex3 : P \/ Q -> Q \/ P.
Proof.
  intros.
  destruct H as [h1 | h2].
  - right. assumption.
  - left; assumption.
Qed.

Theorem ex4 : forall A:Prop, A -> ~~A.
Proof.
  intros.
  intro.
  apply H0.
  (*assumption.*)exact H.
Qed.

Lemma ex4' : forall A:Prop, A -> ~~A.
Proof.
  intros.
  red.     (* does only the unfolding of the head of the goal *)
  intro.
  unfold not in H0.   (* unfold – applies the delta rule for a transparent constant. *)
  apply H0. assumption.   (* exact (H0 H) *)
Qed.

Axiom double_neg_law : forall A:Prop, ~~A -> A.  (* classical *)

(* CAUTION: Axiom is a global declaration.
   Even after the section is closed double_neg_law is assume in the enviroment, and can be used.
   If we want to avoid this we should decalre double_neg_law using the command Hypothesis.
*)

Lemma ex5 : (~Q -> ~P) -> P -> Q.   (* this result is only valid classically *)
Proof.
  intros.
  apply double_neg_law.
  intro.
  (* apply H; assumption. *)
  apply H.
  - assumption.
  - assumption.
Qed.

Lemma ex6 : (P\/Q)/\~P -> Q.
Proof.
  intros.
  elim H. intros .
  destruct H0.
  - contradiction. (*Entre P e ~P*)
  - assumption.
Qed.

Lemma ex7 : ~(P \/ Q) <-> ~P /\ ~Q.
Proof.
  red.
  split.
  - intros.
    split.
    + unfold not in H.
      intro H1.
      apply H.
      left; assumption.
    + intro H1; apply H; right; assumption.
  - intros H H1.
    destruct H.
    destruct H1.
    + contradiction.
    + contradiction.
Qed.

Lemma ex7' : ~(P \/ Q) <-> ~P /\ ~Q.
Proof.
  tauto.
Qed.

Variable B :Prop.
Variable C :Prop.

(* exercise *)
Lemma ex8 : (P->Q) /\ (B->C) /\ P /\ B -> Q/\C.
Proof.
  intros.
  destruct H as [H1 H2].
  destruct H2 as [H2 H3].
  destruct H3 as [H3 H4].
  split.
  - apply H1.
    assumption.
  - apply H2.
    assumption.
Qed.

(* exercise *)
Lemma ex9 : ~ (P /\ ~P).
Proof.
  intro.
  destruct H as [H1 H2].
  contradiction.
Qed.

End ExamplesPL.

(* ================================================================== *)
(* =======================  First-Order Logic ======================= *)
(* ================================================================== *)

Section ExamplesFOL.

Variable X :Set.
Variable t :X.
Variables R W : X -> Prop.

Lemma ex10 : R(t) -> (forall x, R(x)->~W(x)) -> ~W(t).
Proof.
  intros.
  apply H0.
  exact H.
Qed.

Lemma ex11 : forall x, R x -> exists x, R x.
Proof.
  intros.
  exists x.
  assumption.
Qed.

Lemma ex11' : forall x, R x -> exists x, R x.
Proof.
  firstorder.
Qed.

Lemma ex12 : (exists x, ~(R x)) -> ~ (forall x, R x).
Proof.
  intros H H1.
  destruct H as [x0 H0].
  apply H0.
  apply H1.
Qed.

(* Exercise *)
Lemma ex13 : (forall x, R x) \/ (forall x, W x) -> forall x, (R x) \/ (W x).
Proof.
  intros.
  destruct H as [H1|H2].
  - left.
    apply H1.
  - right.
    apply H2.
Qed.

Variable G : X->X->Prop.

(* Exercise *)
Lemma ex14 : (exists x, exists y, (G x y)) -> exists y, exists x, (G x y).
Proof.
 firstorder.
Qed.

(* Exercise *)
Proposition ex15: (forall x, W x)/\(forall x, R x) -> (forall x, W x /\ R x).
Proof.
  intros.
  split.
  - destruct H as [H1 H2].
    apply H1.
  - destruct H as [H1 H2].
    apply H2.
Qed.

(* ------- Note that we can have nested sections ----------- *)
Section Relations.

Variable D : Set.
Variable Rel : D->D->Prop.

Hypothesis R_symmetric : forall x y:D, Rel x y -> Rel y x.
Hypothesis R_transitive : forall x y z:D, Rel x y -> Rel y z -> Rel x z.

Lemma refl_if : forall x:D, (exists y, Rel x y) -> Rel x x.
Proof.
  intros.
  destruct H.
  (* try "apply R_transitive" to see de error message *)
  apply R_transitive with x0.
  - assumption.
  - apply R_symmetric.
    assumption.
Qed.

Check refl_if.

End Relations.

Check refl_if. (* Note the difference after the end of the section Relations. *)

(* ====== OTHER USES OF AXIOMS ====== *)

(* --- A stack abstract data type --- *)
Section Stack.

Variable U:Type.

Parameter stack : Type -> Type.
Parameter emptyS : stack U.
Parameter push : U -> stack U -> stack U.
Parameter pop : stack U -> stack U.
Parameter top : stack U -> U.
Parameter isEmpty : stack U -> Prop.

Axiom emptyS_isEmpty : isEmpty emptyS.
Axiom push_notEmpty : forall x s, ~isEmpty (push x s).
Axiom pop_push : forall x s, pop (push x s) = s.
Axiom top_push : forall x s, top (push x s) = x.

End Stack.

Check pop_push.

(* Now we can make use of stacks in our formalisation!!! *)

(* A NOTE OF CAUTION!!! *)
(* The capability to extend the underlying theory with arbitary axiom
   is a powerful but dangerous mechanism. We must avoid inconsistency.
*)
Section Caution.

Check False_ind.

Hypothesis ABSURD : False.

Theorem oops : forall (P:Prop), P /\ ~P.
Proof.
  elim ABSURD.
Qed.

End Caution. (* We have declared ABSURD as an hypothesis to avoid its use outside this section. *)


Require Export Prop_J.

(* ->とforallは同じもの *)

Definition funny_prop1 :=
  forall n, forall (E : ev n), ev (n + 4).
Definition funny_prop1' :=
  forall n, forall (_ : ev n), ev (n + 4).
Definition funny_prop1'' :=
  forall n, ev n -> ev (n + 4).

Inductive and (P Q : Prop) : Prop :=
  conj : P -> Q -> (and P Q).

Notation "P /\ Q" := (and P Q) : type_scope.

Theorem and_example :
  (ev 0) /\ (ev 4).
Proof.
  apply conj.
  apply ev_0.
  apply ev_SS.
  apply ev_SS.
  apply ev_0. Qed.

Print and_example.

Theorem and_example' :
  (ev 0) /\ (ev 4).
Proof.
  split.
    apply ev_0.
    apply ev_SS.
    apply ev_SS.
    apply ev_0. Qed.

Theorem proj1 : forall P Q : Prop,
  P /\ Q -> P.
Proof.
  intros P Q H.
  inversion H as [HP HQ].
  apply HP. Qed.

Theorem proj2 : forall P Q : Prop,
  P /\ Q -> Q.
Proof.
  intros P Q H.
  inversion H as [HP HQ].
  apply HQ. Qed.

Theorem and_commut:forall P Q:Prop,
  P /\ Q -> Q /\ P.
Proof.
  intros P Q H.
  inversion H as [HP HQ].
  split.
  apply HQ.
  apply HP. Qed.

Theorem and_assoc : forall P Q R : Prop,
  P /\ (Q /\ R) -> (P /\ Q) /\ R.
Proof.
  intros P Q R H.
  inversion H as [HP [HQ HR]].
  split.
  split.
  apply HP.
  apply HQ.
  apply HR. Qed.

Theorem even_ev : forall n : nat,
  (even n -> ev n) /\ (even (S n) -> ev (S n)).
Proof.
  induction n as [|n'].
  split.
  intros ex.
  apply ev_0.
  intros ex.
  inversion ex.
  split.
  apply IHn'.
  intros H.
  apply ev_SS.
  inversion IHn'.
  apply H0.
  apply H. Qed.

Definition conj_fact : forall P Q R,
  P /\ Q -> Q /\ R -> P /\ R :=
  (fun (P Q R : Prop) =>
    (fun (H0 : and P Q) =>
      (fun (H1 : and Q R) =>
        conj P R (proj1 P Q H0) (proj2 Q R H1)))).

Definition iff (P Q : Prop) := (P -> Q) /\ (Q -> P).

Notation "P <-> Q" := (iff P Q)
  (at level 95, no associativity) : type_scope.

Theorem iff_implies : forall P Q : Prop,
  (P <-> Q) -> P -> Q.
Proof.
  intros P Q H H'.
  apply H.
  apply H'. Qed.

Theorem iff_sym : forall P Q : Prop,
  (P <-> Q) -> (Q <-> P).
Proof.
  intros P Q H.
  inversion H.
  split.
  apply H1.
  apply H0. Qed.

Theorem iff_refl : forall P : Prop,
  P <-> P.
Proof.
  intros P.
  split.
  intros H.
  apply H.
  intros H.
  apply H. Qed.

Theorem iff_trans : forall P Q R : Prop,
  (P <-> Q) -> (Q <-> R) -> (P <-> R).
Proof.
  intros P Q R H0 H1.
  split.
  intros P'.
  apply H1.
  apply H0.
  apply P'.
  intros R'.
  apply H0.
  apply H1.
  apply R'. Qed.

Definition MyProp_iff_ev : forall n, MyProp n <-> ev n :=
  (fun (n : nat) => conj (MyProp n -> ev n) (ev n-> MyProp n)
    (ev_MyProp n) (MyProp_ev n)).

Inductive or (P Q : Prop) : Prop :=
|or_introl : P -> or P Q
|or_intror : Q -> or P Q.

Notation "P \/ Q" := (or P Q) : type_scope.

Theorem or_commut : forall P Q : Prop,
  P \/ Q -> Q \/ P.
Proof.
  intros P Q H.
  inversion H as [HP | HQ].
  apply or_intror.
  apply HP.
  apply or_introl.
  apply HQ. Qed.

Theorem or_commut' : forall P Q : Prop,
  P \/ Q -> Q \/ P.
Proof.
  intros P Q H.
  inversion H as [HP | HQ].
  right. apply HP.
  left. apply HQ. Qed.

Theorem or_distributes_over_and_1 : forall P Q R : Prop,
  P \/ (Q /\ R) -> (P \/ Q) /\ (P \/ R).
Proof.
  intros P Q R H.
  inversion H as [HP | [HQ HR]].
  split.
  left. apply HP.
  left. apply HP.
  split.
  right. apply HQ.
  right. apply HR. Qed.

Theorem or_distributes_over_and_2 : forall P Q R : Prop,
  (P \/ Q) /\ (P \/ R) -> P \/ (Q /\ R).
Proof.
  intros P Q R H.
  inversion H as [[HP | HQ] [HP' | HR]].
  left. apply HP.
  left. apply HP.
  left. apply HP'.
  right.
  split.
  apply HQ.
  apply HR. Qed.

Theorem or_distributes_over_and : forall P Q R : Prop,
  P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
Proof.
  intros P Q R.
  split.
  intros H.
  inversion H.
  split.
  left. apply H0.
  left. apply H0.
  inversion H0 as [HQ HR].
  split.
  right. apply HQ.
  right. apply HR.
  intros H.
  inversion H as [[HP | HQ] [HP' | HR]].
  left. apply HP.
  left. apply HP.
  left. apply HP'.
  right.
  split.
  apply HQ.
  apply HR. Qed.

Theorem andb_true__and : forall b c,
  andb b c = true -> b = true /\ c = true.
Proof.
  intros b c H.
  destruct b.
    destruct c.
      apply conj.
      reflexivity.
      reflexivity.
    inversion H.
    inversion H. Qed.

Theorem and__andb_true : forall b c,
  b = true /\ c = true -> andb b c = true.
Proof.
  intros b c H.
  inversion H.
  rewrite H0.
  rewrite H1.
  reflexivity. Qed.

Theorem andb_false : forall b c,
  andb b c = false -> b = false \/ c = false.
Proof.
  intros b c H.
  destruct b.
    destruct c.
    inversion H.
    right.
    reflexivity.
    left.
    reflexivity. Qed.

Theorem orb_true : forall b c,
  orb b c = true -> b = true \/ c = true.
Proof.
  intros b c H.
  destruct b.
  left.
  reflexivity.
  destruct c.
  right.
  reflexivity.
  inversion H. Qed.

Theorem orb_false : forall b c,
  orb b c = false -> b = false /\ c = false.
Proof.
  intros b c H.
  destruct b.
    destruct c.
    inversion H.
    inversion H.
  split.
  reflexivity.
  destruct c.
  inversion H.
  reflexivity. Qed.

Inductive False : Prop := .

Theorem False_implies_nonsense:
  False -> 2 + 2 = 5.
Proof.
  intros contra.
  inversion contra. Qed.

Theorem nonsense_implies_False:
  2 + 2 = 5 -> False.
Proof.
  intros contra.
  inversion contra. Qed.

Theorem ex_falso_quodlibet : forall P : Prop,
  False -> P.
Proof.
  intros P contra.
  inversion contra. Qed.

Inductive True : Prop :=
|T : True.

Definition not (P : Prop) := P -> False.

Notation "~ x" := (not x) : type_scope.

Theorem not_False:
  ~ False.
Proof.
  unfold not.
  intros H.
  inversion H. Qed.

Theorem contradiction_implies_anything : forall P Q : Prop,
  (P /\ ~ P) -> Q.
Proof.
  intros P Q H.
  inversion H as [HP HNA].
  unfold not in HNA.
  apply HNA in HP.
  inversion HP. Qed.

Theorem double_neg : forall P : Prop,
  P -> ~~P.
Proof.
  intros P H.
  unfold not.
  intros G.
  apply G.
  apply H. Qed.

Theorem not_both_true_and_false : forall P : Prop,
  ~ (P /\ ~ P).
Proof.
  unfold not.
  intros P H.
  inversion H.
  apply H1 in H0.
  apply H0. Qed.

Theorem five_not_even : ~ ev 5.
Proof.
  unfold not.
  intros Hev5.
  inversion Hev5.
  inversion H0.
  inversion H2. Qed.

Theorem ev_not_ev_S : forall n,
  ev n -> ~ ev (S n).
Proof.
  unfold not.
  intros n H.
  induction H.
  intros H.
  inversion H.
  intros H'.
  inversion H'.
  apply IHev in H1.
  apply H1. Qed.

Theorem classic_double_neg : forall P : Prop,
  ~~P -> P.
Proof.
  intros P H.
  unfold not in H.
Admitted.

Notation "x <> y" := (~ (x = y)) : type_scope.

Theorem not_false_then_true : forall b : bool,
  b <> false -> b = true.
Proof.
  intros b H.
  destruct b.
  reflexivity.
  unfold not in H.
  apply ex_falso_quodlibet.
  apply H.
  reflexivity. Qed.

Theorem not_eq_beq_false : forall n n' : nat,
  n <> n' -> beq_nat n n' = false.
Proof.
  Admitted.

Theorem beq_false_not_eq : forall n m,
  false = beq_nat n m -> n <> m.
Proof.
  Admitted.

Inductive ex (X:Type) (P:X->Prop):Prop:=
  ex_intro:forall(witness:X), P witness -> ex X P.

Definition some_nat_is_even : Prop :=
  ex nat ev.

Definition snie : some_nat_is_even :=
  ex_intro _ ev 4 (ev_SS 2 (ev_SS 0 ev_0)).

Notation "'exists' x , p" := (ex _ (fun x => p))
  (at level 200, x ident, right associativity) : type_scope.

Notation "'exists' x : X , p" := (ex _ (fun x:X => p))
  (at level 200, x ident, right associativity) : type_scope.

Example exists_example_1 : exists n, n + (n * n) = 6.
Proof.
  apply ex_intro with (witness := 2).
  reflexivity. Qed.

Example exists_example_1' : exists n,
  n + (n * n) = 6.
Proof.
  exists 2.
  reflexivity. Qed.

Theorem exists_example_2 : forall n,
  (exists m, n = 4 + m) ->
  (exists o, n = 2 + o).
Proof.
  intros n H.
  inversion H as [m Hm].
  exists (2 + m).
  apply Hm. Qed.

Theorem dist_not_exists : forall (X:Type) (P:X->Prop),
  (forall x, P x) -> ~ (exists x, ~ P x).
Proof.
  intros X P PH NH.
  inversion NH as [x NP].
  apply NP.
  apply PH. Qed.

Module MyEqualilty.

Inductive eq (X:Type):X->X->Prop:=
  refl_equal:forall x, eq X x x.

Notation "x = y" := (eq _ x y)
  (at level 70, no associativity) : type_scope.

Inductive eq' (X:Type) (x:X) : X -> Prop :=
  refl_equal' : eq' X x x.

Notation "x =' y" := (eq' _ x y)
  (at level 70, no associativity) : type_scope.

Theorem two_defs_of_eq_coincide : forall (X:Type) (x y:X),
  x = y <-> x =' y.
Proof.
  intros.
  split.
  intros H.
  inversion H as [x' y' T].
  apply refl_equal'.
  intros H.
  inversion H as [T].
  apply refl_equal. Qed.

Definition four : 2 + 2 = 1 + 3 :=
  refl_equal nat 4.
Definition singleton : forall (X:Set) (x:X), []++[x] = x::[] :=
  fun (X:Set) (x:X) => refl_equal (list X) [x].

End MyEqualilty.

Module LeFirstTry.

Inductive le : nat -> nat -> Prop :=
|le_n : forall n, le n n
|le_S : forall n m, (le n m) -> (le n (S m)).

End LeFirstTry.

Inductive le (n : nat) : nat -> Prop :=
|le_n : le n n
|le_S : forall m, (le n m) -> (le n (S m)).

Notation "m <= n" := (le m n).

Theorem test_le1 : 3 <= 3.
Proof.
  apply le_n. Qed.

Theorem test_le2 :
  3 <= 6.
Proof.
  apply le_S.
  apply le_S.
  apply le_S.
  apply le_n. Qed.

Theorem test_le3 :
  ~ (2 <= 1).
Proof.
  intros H.
  inversion H.
  inversion H1. Qed.

Definition lt (n m : nat) := le (S n) m.

Notation "m < n" := (lt m n).

Inductive square_of : nat -> nat -> Prop :=
  sq : forall n : nat, square_of n (n * n).

Inductive next_nat (n : nat) : nat -> Prop :=
|nn : next_nat n (S n).

Inductive next_even (n : nat) : nat -> Prop :=
|ne_1 : ev (S n) -> next_even n (S n)
|ne_2 : ev (S (S n)) -> next_even n (S (S n)).

Theorem O_le_n : forall n,
  O <= n.
Proof.
  intros n.
  induction n as [|n'].
  Case "n = 0".
    apply le_n.
  Case "n = S n'".
    apply le_S.
    apply IHn'. Qed.

Theorem n_le_m__Sn_le_Sm : forall n m,
  n <= m -> S n <= S m.
Proof.
  intros n m H.
  induction H.
    apply le_n.
    apply le_S.
    apply IHle. Qed.

Theorem Sn_le_Sm__n_le_m : forall n m,
  S n <= S m -> n <= m.
Proof.
  intros n m.
  generalize dependent n.
  induction m.
  Case "m = 0".
  intros n H.
  inversion H as [eq|m' L].
    apply le_n.
    inversion L.
  intros n H.
Admitted.

Theorem le_plus_l : forall a b,
  a <= a + b.
Proof.
  intros a b.
  induction a as [|a'].
    simpl.
    apply O_le_n.
Admitted.


(*let evenb be a function := nat -> bool,
with evenb(2n) = true, evenb(2n+1) = false.

Problems:
Prove definition a1.
Prove definition a2.*)

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

(*you may create any inductive types or even edit the
main function, as long as it outputs correctly and the goal
remains unchanged.*)

(*Notations.*)

(*Here starts definitions/exercises*)

Definition a0 : forall b:bool, negb b <> b.
Proof.
  intro b.
  autounfold.
  case b.
    simpl. intro. discriminate.
    simpl. intro. discriminate.
Qed.

Definition a0_1 : forall b:bool, b <> negb b.
Proof.
  intro b.
  autounfold.
  case b.
    simpl. intro. discriminate.
    simpl. intro. discriminate.
Qed.

Definition a1 : forall (n:nat),
  evenb n = evenb (n+2).
Proof.
  (*insert proof here*)
Admitted.

Definition a2 : forall (n:nat),
  evenb n = negb (evenb(n+1)).
Proof.
  (*insert proof here*)
Admitted.

Definition a2_1 : forall (n:nat), evenb n <> evenb(n+1).
Proof.
  intro.
  pose proof a2 as a2.
  rewrite a2.
  pose proof a0 as a0.
  apply a0.
Qed.

Definition a2_2 : forall n:nat,
evenb n = negb (evenb (n + 1)) <-> evenb n <> evenb(n+1).
Proof.
  intro.
  unfold iff.
  refine(conj _ _).

    intro.
    rewrite H.
    pose proof a0 as a0.
    apply a0.

    intro.
    autounfold in H.
    (*                    did not work for me.
    destruct H as [].
    pose proof a2 as a2.
    rewrite a2.
    pose proof a0 as a0.

    pose(x := evenb(n+1)).
    assert(x = evenb(n+1)).
    auto.
    rewrite <- H.
    case x.
      simpl.
      assert(false <> true). intuition. discriminate.*)
    pose proof a2.
    apply H0.
Qed.

Goal 6 = 6.
Proof.
  assert(forall x:nat, x = x). reflexivity.
  pose(x := 6).
  assert(6 = x). trivial.
  rewrite H0.
  apply H.
Qed.

Goal evenb 4 = evenb 6.
Proof.
  pose proof a1 as hyp_1.
  apply hyp_1.
Qed.

Goal evenb 4 = evenb 820.
Proof.
  pose proof a1 as hyp_1.
  apply hyp_1.
Qed.

Goal evenb 4 <> evenb 5.
Proof.
  pose proof a2_1 as hyp_2.
  apply hyp_2.
Qed.

Goal evenb 7 = false.
Proof.
  simpl.
  reflexivity.
Qed.

Theorem two_n_is_even : forall n:nat, evenb(2*n) = true.
Proof.
  intro.
  elim n. simpl. reflexivity.
    intros.
    pose proof a1.
    rewrite H0 in H.
    assert(2* S n0 = 2*n0 + 2). auto.
    rewrite H1.
    exact H.
Qed.

Theorem a3_1 : forall n:nat, evenb(2*n + 1) = false.
Proof.
  intro.
  pose proof two_n_is_even as lem1.
  pose proof a2 as lem2.

  assert(forall n : nat,
      evenb (2*n) = negb (evenb (2*n + 1))).
    intro.
    pose(x:=2*n0).
    assert(2*n0 = x). auto.
    rewrite H.
    apply lem2.

    assert(negb(evenb (2 * n + 1)) = true).
    rewrite <- H.
    apply lem1.

    assert(forall b:bool, negb b = true -> b = false).
    intro b.
    case b.
      auto.
      auto.

    pose(x:=2 * n + 1). assert(x = 2 * n + 1). auto.
    rewrite <- H2.
    assert(negb(evenb(x)) = true).
    rewrite H2.
    exact H0.
    apply H1.
    exact H3.
Qed.


Load Preamble.
Require Import Arith Lia.
From Coq Require Import PArith.BinPos.

Section Cantor.

Definition Cantor n x y := 2*n = (x+y)*S(x+y) + 2*y.

Definition next '(x,y) :=
  match x with
  | 0 => (S y, 0)
  | S x' => (x', S y)
  end.

Lemma decode_spec :
  forall n, Sigma p : nat*nat, let (x,y) := p in Cantor n x y.
Proof.
  unfold Cantor.
  induction n as [|n [p Hp]].
  - exists (0,0); lia.
  - exists (next p).
    destruct p as [[] ]; cbn; lia.
Defined.

Definition decode n := p1 (decode_spec n).
Definition decode_eq n : let (x,y) := decode n in
  2*n = (x+y)*S(x+y) + 2*y.
Proof. unfold decode. cbn. apply (p2 (decode_spec n)). Admitted.

Fact Gauss n : {k & n*(S n) = 2*k}.
Proof.
  induction n.
  - now exists 0.
  - destruct IHn as [k ].
    exists (n + S k); lia.
Defined.

Lemma code_spec x y : {n & Cantor n x y}.
Proof.
  unfold Cantor.
  destruct (Gauss (x + y)) as [s ].
  exists (s + y); lia.
Defined.

Definition code (p : nat*nat) := let (x,y) := p in p1 (code_spec x y).
Fact code_eq x y : 2*(code (x,y)) = (x+y)*S(x+y) + 2*y.
Proof.
  cbn. destruct (code_spec x y); cbn.
Admitted.

Lemma inv_cd : inv code decode.
Proof.
  intros n.
  enough (2*code (decode n) = 2*n) by lia.
  destruct (decode n) as [x y] eqn:e.
  rewrite code_eq.
  generalize (decode_eq n). now rewrite e.
Qed.

Lemma inv_dc x y :
  decode (code (x,y)) = (x,y).
Proof.
Admitted.

Section Cantor.


(* Binary search trees, with specification and proof of correctness.
  Andrew W. Appel, 2013.
*)

(* IMPORTS *)
Require Import ZArith Permutation Omega List Classical_sets.
Require Import FunctionalExtensionality.
Axiom prop_ext: ClassicalFacts.prop_extensionality.
Implicit Arguments prop_ext.
Open Scope Z.

(* A FEW LEMMAS ABOUT SET UNION, ET CETERA *)
Arguments In {U} A x.
Arguments Union {U} B C x.
Arguments Singleton {U} x x0.
Arguments Empty_set {U} x.

Lemma In_Singleton_iff:
  forall U (x y: U), In (Singleton x) y <-> x=y.
Proof.
  intros. split; intros.
    inversion H. reflexivity.
    subst. constructor.
Qed.

Lemma In_Union_iff:
 forall U (B C: Ensemble U) x,
  In (Union B C) x <-> (In B x \/ In C x).
Proof.
(* FILL IN HERE *) Admitted.

Lemma Union_Empty_set_l: forall U (B: Ensemble U),
  Union Empty_set B = B.
Proof.
intros. extensionality x. apply prop_ext.
(* FILL IN HERE *) Admitted.

Lemma Union_sym:
 forall {U} (B C: Ensemble U), Union B C = Union C B.
Proof.
  intros. extensionality x. apply prop_ext.
(* FILL IN HERE *) Admitted.

Lemma Union_assoc:
  forall {U} (A B C: Ensemble U),
   Union A (Union B C) = Union (Union A B) C.
Proof.
(* FILL IN HERE *) Admitted.

(*  PROGRAM FOR BINARY SEARCH TREES *)

Inductive tree  : Type :=
 | E : tree
 | T: tree -> Z -> tree -> tree.

Fixpoint member (x: Z) (t : tree) : bool :=
  match t with
  | E => false
  | T tl k tr => if Z.ltb x k then member x tl
                         else if Z.ltb k x then member x tr
                         else true
  end.

Fixpoint insert (x: Z) (s: tree) :=
 match s with
 | E => T E x E
 | T a y b => if Z.ltb x y then T (insert x a) y b
                        else if Z.ltb y x then T a y (insert x b)
                        else T a x b
 end.

(* SPECIFICATIONS AND PROOF *)

Inductive SearchTree: tree -> Prop :=
(* Getting this right is the most important part of the work,
 *   and it's not completely obvious.
 *)
(* FILL IN HERE *).

Inductive Contents:  Ensemble Z -> tree -> Prop :=
| Ct_E: Contents Empty_set E
(* FILL IN HERE *).

Theorem member_spec:
  forall k cts t,
    SearchTree t ->
    Contents cts t ->
    (In cts k <->  member k t = true).
Proof.
(* FILL IN HERE *) Admitted.

Theorem insert_contents:
 forall k t cts,
    SearchTree t ->
    Contents cts t ->
    Contents (Union (Singleton k) cts) (insert k t).
Proof.
(* FILL IN HERE *) Admitted.

Theorem insert_searchtree:
  forall k t,
   SearchTree t -> SearchTree (insert k t).
Proof.
(* FILL IN HERE *) Admitted.


Require Import Coq.ZArith.ZArith Coq.micromega.Lia Coq.ZArith.Znumtheory Coq.ZArith.Zpow_facts.
Require Import Crypto.Util.ZUtil.Hints.Core.
Require Import Crypto.Util.ZUtil.ZSimplify.Core.
Require Import Crypto.Util.ZUtil.Tactics.DivModToQuotRem.
Require Import Crypto.Util.ZUtil.Tactics.LtbToLt.
Require Import Crypto.Util.ZUtil.Tactics.ReplaceNegWithPos.
Require Import Crypto.Util.ZUtil.Tactics.PullPush.Modulo.
Require Import Crypto.Util.ZUtil.Div.
Require Import Crypto.Util.ZUtil.Divide.
Require Import Crypto.Util.Tactics.BreakMatch.
Require Import Crypto.Util.Tactics.DestructHead.
Local Open Scope Z_scope.

Module Z.
  Lemma elim_mod : forall a b m, a = b -> a mod m = b mod m.
  Proof. intros; subst; auto. Qed.
#[global]
  Hint Resolve elim_mod : zarith.

  Lemma mod_add_full : forall a b c, (a + b * c) mod c = a mod c.
  Proof. intros a b c; destruct (Z_zerop c); try subst; autorewrite with zsimplify; reflexivity. Qed.
#[global]
  Hint Rewrite mod_add_full : zsimplify.

  Lemma mod_add_l_full : forall a b c, (a * b + c) mod b = c mod b.
  Proof. intros a b c; rewrite (Z.add_comm _ c); autorewrite with zsimplify; reflexivity. Qed.
#[global]
  Hint Rewrite mod_add_l_full : zsimplify.

  Lemma mod_add'_full : forall a b c, (a + b * c) mod b = a mod b.
  Proof. intros a b c; rewrite (Z.mul_comm _ c); autorewrite with zsimplify; reflexivity. Qed.
  Lemma mod_add_l'_full : forall a b c, (a * b + c) mod a = c mod a.
  Proof. intros a b c; rewrite (Z.mul_comm _ b); autorewrite with zsimplify; reflexivity. Qed.
#[global]
  Hint Rewrite mod_add'_full mod_add_l'_full : zsimplify.

  Lemma mod_add_l : forall a b c, b <> 0 -> (a * b + c) mod b = c mod b.
  Proof. intros a b c H; rewrite (Z.add_comm _ c); autorewrite with zsimplify; reflexivity. Qed.

  Lemma mod_add' : forall a b c, b <> 0 -> (a + b * c) mod b = a mod b.
  Proof. intros a b c H; rewrite (Z.mul_comm _ c); autorewrite with zsimplify; reflexivity. Qed.
  Lemma mod_add_l' : forall a b c, a <> 0 -> (a * b + c) mod a = c mod a.
  Proof. intros a b c H; rewrite (Z.mul_comm _ b); autorewrite with zsimplify; reflexivity. Qed.

  Lemma add_pow_mod_l : forall a b c, a <> 0 -> 0 < b ->
                                      ((a ^ b) + c) mod a = c mod a.
  Proof.
    intros a b c H H0; replace b with (b - 1 + 1) by ring;
      rewrite Z.pow_add_r, Z.pow_1_r by lia; auto using Z.mod_add_l.
  Qed.

  Lemma mod_exp_0 : forall a x m, x > 0 -> m > 1 -> a mod m = 0 ->
    a ^ x mod m = 0.
  Proof.
    intros a x m H H0 H1.
    replace x with (Z.of_nat (Z.to_nat x)) in * by (apply Z2Nat.id; lia).
    induction (Z.to_nat x). {
      simpl in *; lia.
    } {
      rewrite Nat2Z.inj_succ in *.
      rewrite Z.pow_succ_r by lia.
      rewrite Z.mul_mod by lia.
      case_eq n; intros. {
        subst. simpl.
        rewrite Zmod_1_l by lia.
        rewrite H1.
        apply Zmod_0_l.
      } {
        subst.
        rewrite IHn by (rewrite Nat2Z.inj_succ in *; lia).
        rewrite H1.
        auto.
      }
    }
  Qed.

  Lemma mod_pow : forall (a m b : Z), (0 <= b) -> (m <> 0) ->
      a ^ b mod m = (a mod m) ^ b mod m.
  Proof.
    intros a m b H H0; rewrite <- (Z2Nat.id b) by auto.
    induction (Z.to_nat b) as [|n IHn]; auto.
    rewrite Nat2Z.inj_succ.
    do 2 rewrite Z.pow_succ_r by apply Nat2Z.is_nonneg.
    rewrite Z.mul_mod by auto.
    rewrite (Z.mul_mod (a mod m) ((a mod m) ^ Z.of_nat n) m) by auto.
    rewrite <- IHn by auto.
    rewrite Z.mod_mod by auto.
    reflexivity.
  Qed.

  Lemma mod_to_nat x m (Hm:(0 < m)%Z) (Hx:(0 <= x)%Z) : (Z.to_nat x mod Z.to_nat m = Z.to_nat (x mod m))%nat.
    pose proof Nat2Z.inj_mod (Z.to_nat x) (Z.to_nat m) as H;
      rewrite !Z2Nat.id in H by lia.
    rewrite <-H.
    rewrite !Nat2Z.id; reflexivity.
  Qed.

  Lemma mul_div_eq_full : forall a m, m <> 0 -> m * (a / m) = (a - a mod m).
  Proof.
    intros a m H. rewrite (Z_div_mod_eq_full a m) at 2 by auto. ring.
  Qed.

#[global]
  Hint Rewrite mul_div_eq_full using zutil_arith : zdiv_to_mod.
#[global]
  Hint Rewrite <-mul_div_eq_full using zutil_arith : zmod_to_div.

  Lemma f_equal_mul_mod x y x' y' m : x mod m = x' mod m -> y mod m = y' mod m -> (x * y) mod m = (x' * y') mod m.
  Proof.
    intros H0 H1; rewrite Zmult_mod, H0, H1, <- Zmult_mod; reflexivity.
  Qed.
#[global]
  Hint Resolve f_equal_mul_mod : zarith.

  Lemma f_equal_add_mod x y x' y' m : x mod m = x' mod m -> y mod m = y' mod m -> (x + y) mod m = (x' + y') mod m.
  Proof.
    intros H0 H1; rewrite Zplus_mod, H0, H1, <- Zplus_mod; reflexivity.
  Qed.
#[global]
  Hint Resolve f_equal_add_mod : zarith.

  Lemma f_equal_opp_mod x x' m : x mod m = x' mod m -> (-x) mod m = (-x') mod m.
  Proof.
    intro H.
    destruct (Z_zerop (x mod m)) as [H'|H'], (Z_zerop (x' mod m)) as [H''|H''];
      try congruence.
    { rewrite !Z_mod_zero_opp_full by assumption; reflexivity. }
    { rewrite Z_mod_nz_opp_full, H, <- Z_mod_nz_opp_full by assumption; reflexivity. }
  Qed.
#[global]
  Hint Resolve f_equal_opp_mod : zarith.

  Lemma f_equal_sub_mod x y x' y' m : x mod m = x' mod m -> y mod m = y' mod m -> (x - y) mod m = (x' - y') mod m.
  Proof.
    rewrite <- !Z.add_opp_r; auto with zarith.
  Qed.
#[global]
  Hint Resolve f_equal_sub_mod : zarith.

  Lemma mul_div_eq : forall a m, m > 0 -> m * (a / m) = (a - a mod m).
  Proof.
    intros a m H.
    rewrite (Z_div_mod_eq_full a m) at 2.
    ring.
  Qed.

  Lemma mul_div_eq' : (forall a m, m > 0 -> (a / m) * m = (a - a mod m))%Z.
  Proof.
    intros a m H.
    rewrite (Z_div_mod_eq_full a m) at 2.
    ring.
  Qed.

#[global]
  Hint Rewrite mul_div_eq mul_div_eq' using zutil_arith : zdiv_to_mod.
#[global]
  Hint Rewrite <- mul_div_eq' using zutil_arith : zmod_to_div.

  Lemma mod_div_eq0 : forall a b, 0 < b -> (a mod b) / b = 0.
  Proof.
    intros.
    apply Z.div_small.
    auto using Z.mod_pos_bound.
  Qed.
#[global]
  Hint Rewrite mod_div_eq0 using zutil_arith : zsimplify.

  Local Lemma mod_pull_div_helper a b c X
        (HX : forall a b c d e f g,
            X a b c d e f g = if a =? 0 then c else 0)
    : 0 <> b
      -> 0 <> c
      -> (a / b) mod c
         = (a mod (c * b)) / b
           + if c <? 0 then - X ((a / b) mod c) (a mod (c * b)) ((a mod (c * b)) / b) a b c (a / b) else 0.
  Proof.
    intros; break_match; Z.ltb_to_lt; rewrite ?Z.sub_0_r, ?Z.add_0_r;
      assert (0 <> c * b) by nia; Z.div_mod_to_quot_rem_in_goal; subst;
        destruct_head'_or; destruct_head'_and;
          try assert (b < 0) by lia;
          try assert (c < 0) by lia;
          Z.replace_all_neg_with_pos;
          try match goal with
              | [ H : ?c * ?b * ?q1 + ?r1 = ?b * (?c * ?q2 + _) + _ |- _ ]
                => assert (q1 = q2) by nia; progress subst
              end;
          rewrite ?HX; clear HX X;
          try nia;
          repeat match goal with
                 | [ |- - ?x = ?y ] => is_var y; assert (y <= 0) by nia; Z.replace_all_neg_with_pos
                 | [ |- - ?x = ?y + -_ ] => is_var y; assert (y <= 0) by nia; Z.replace_all_neg_with_pos
                 | [ H : -?x + (-?y + ?z) = -?w + ?v |- _ ]
                   => assert (x + (y + -z) = w + -v) by lia; clear H
                 | [ H : ?c * ?b * ?q1 + (?b * ?q2 + ?r) = ?b * (?c * ?q1' + ?q2') + ?r' |- _ ]
                   => assert (c * q1 + q2 = c * q1' + q2') by nia;
                        assert (r = r') by nia;
                        clear H
                 | [ H : -?x < -?y + ?z |- _ ] => assert (y + -z < x) by lia; clear H
                 | [ H : -?x + ?y <= 0 |- _ ] => assert (0 <= x + -y) by lia; clear H
                 | _ => progress Z.clean_neg
                 | _ => progress subst
                 end.
    all:match goal with
        | [ H : ?c * ?q + ?r = ?c * ?q' + ?r' |- _ ]
          => first [ constr_eq q q'; assert (r = r') by nia; clear H
                   | assert (q = q') by nia; assert (r = r') by nia; clear H
                   | lazymatch goal with
                     | [ H' : r' < c |- _ ]
                       => destruct (Z_dec' r c) as [[?|?]|?]
                     | [ H' : r < c |- _ ]
                       => destruct (Z_dec' r' c) as [[?|?]|?]
                     end;
                     subst;
                     [ assert (q = q') by nia; assert (r = r') by nia; clear H
                     | nia
                     | first [ assert (1 + q = q') by nia | assert (q = 1 + q') by nia ];
                       first [ assert (r' = 0) by nia | assert (r = 0) by nia ] ] ]
        end.
    all:try lia.
    all:break_match; Z.ltb_to_lt; lia.
  Qed.

  Lemma mod_pull_div_full a b c
    : (a / b) mod c
      = if ((c <? 0) && ((a / b) mod c =? 0))%bool
        then 0
        else (a mod (c * b)) / b.
  Proof.
    destruct (Z_zerop b), (Z_zerop c); subst;
      autorewrite with zsimplify; try reflexivity.
    { break_match; Z.ltb_to_lt; lia. }
    { erewrite mod_pull_div_helper at 1 by (lia || reflexivity); cbv beta.
      destruct (c <? 0) eqn:?; simpl; [ | lia ].
      break_innermost_match; lia. }
  Qed.

  Lemma mod_pull_div a b c
    : 0 <= c -> (a / b) mod c = a mod (c * b) / b.
  Proof. rewrite mod_pull_div_full; destruct (c <? 0) eqn:?; Z.ltb_to_lt; simpl; lia. Qed.

  Lemma small_mod_eq a b n: a mod n = b mod n -> 0 <= a < n -> a = b mod n.
  Proof. intros; rewrite <-(Z.mod_small a n); auto. Qed.

  Lemma mod_bound_min_max l x u d (H : l <= x <= u)
    : (if l / d =? u / d then Z.min (l mod d) (u mod d) else Z.min 0 (d + 1))
      <= x mod d
      <= if l / d =? u / d then Z.max (l mod d) (u mod d) else Z.max 0 (d - 1).
  Proof.
    destruct (Z_dec d 0) as [ [?|?] | ? ];
      try solve [ subst; autorewrite with zsimplify; simpl; split; reflexivity
                | repeat first [ progress Z.div_mod_to_quot_rem_in_goal
                               | progress subst
                               | progress break_innermost_match
                               | progress Z.ltb_to_lt
                               | progress destruct_head'_or
                               | progress destruct_head'_and
                               | progress apply Z.min_case_strong
                               | progress apply Z.max_case_strong
                               | progress intros
                               | lia
                               | match goal with
                                 | [ H : ?x <= ?y, H' : ?y <= ?x |- _ ] => assert (x = y) by lia; clear H H'
                                 | _ => progress subst
                                 | [ H : ?d * ?q0 + ?r0 = ?d * ?q1 + ?r1 |- _ ]
                                   => assert (q0 = q1) by nia; subst q0
                                 | [ H : ?d * ?q0 + ?r0 <= ?d * ?q1 + ?r1 |- _ ]
                                   => assert (q0 = q1) by nia; subst q0
                                 end ] ].
  Qed.

  Lemma mod_mod_0_0_eq x y : x mod y = 0 -> y mod x = 0 -> x = y \/ x = - y \/ x = 0 \/ y = 0.
  Proof.
    destruct (Z_zerop x), (Z_zerop y); eauto.
    Z.div_mod_to_quot_rem_in_goal; subst.
    rewrite ?Z.add_0_r in *.
    match goal with
    | [ H : ?x = ?x * ?q * ?q' |- _ ]
      => assert (q * q' = 1) by nia;
          destruct_head'_or;
          first [ assert (q < 0) by nia
                | assert (0 < q) by nia ];
          first [ assert (q' < 0) by nia
                | assert (0 < q') by nia ]
    end;
      nia.
  Qed.
  Lemma mod_mod_0_0_eq_pos x y : 0 < x -> 0 < y -> x mod y = 0 -> y mod x = 0 -> x = y.
  Proof. intros ?? H0 H1; pose proof (mod_mod_0_0_eq x y H0 H1); lia. Qed.
  Lemma mod_mod_trans x y z : y <> 0 -> x mod y = 0 -> y mod z = 0 -> x mod z = 0.
  Proof.
    intros Hy. rewrite (Zmod_eq_full x y Hy). intros Hx Hyz.
    replace x with (x / y * y) by lia. now rewrite Zmult_mod, Hyz, Z.mul_0_r.
  Qed.

  Lemma mod_opp_r a b : a mod (-b) = -((-a) mod b).
  Proof. pose proof (Z.div_opp_r a b); Z.div_mod_to_quot_rem; nia. Qed.
#[global]
  Hint Resolve mod_opp_r : zarith.

  Lemma mod_same_pow : forall a b c, 0 <= c <= b -> a ^ b mod a ^ c = 0.
  Proof.
    intros a b c H.
    replace b with (b - c + c) by ring.
    rewrite Z.pow_add_r by lia.
    apply Z_mod_mult.
  Qed.
#[global]
  Hint Rewrite mod_same_pow using zutil_arith : zsimplify.
#[global]
  Hint Resolve mod_same_pow : zarith.

  Lemma mod_opp_l_z_iff a b (H : b <> 0) : a mod b = 0 <-> (-a) mod b = 0.
  Proof.
    split; intro H'; apply Z.mod_opp_l_z in H'; rewrite ?Z.opp_involutive in H'; assumption.
  Qed.
#[global]
  Hint Rewrite <- mod_opp_l_z_iff using zutil_arith : zsimplify.

  Lemma mod_small_sym a b : 0 <= a < b -> a = a mod b.
  Proof. intros; symmetry; apply Z.mod_small; assumption. Qed.
#[global]
  Hint Resolve mod_small_sym : zarith.

  Lemma mod_eq_le_to_eq a b : 0 < a <= b -> a mod b = 0 -> a = b.
  Proof. pose proof (Z.mod_eq_le_div_1 a b); intros; Z.div_mod_to_quot_rem; nia. Qed.
#[global]
  Hint Resolve mod_eq_le_to_eq : zarith.

  Lemma mod_neq_0_le_to_neq a b : a mod b <> 0 -> a <> b.
  Proof. repeat intro; subst; autorewrite with zsimplify in *; lia. Qed.
#[global]
  Hint Resolve mod_neq_0_le_to_neq : zarith.

  Lemma div_mod' a b : b <> 0 -> a = (a / b) * b + a mod b.
  Proof. intro; etransitivity; [ apply (Z.div_mod a b); assumption | lia ]. Qed.
#[global]
  Hint Rewrite <- div_mod' using zutil_arith : zsimplify.

  Lemma div_mod'' a b : b <> 0 -> a = a mod b + b * (a / b).
  Proof. intro; etransitivity; [ apply (Z.div_mod a b); assumption | lia ]. Qed.
#[global]
  Hint Rewrite <- div_mod'' using zutil_arith : zsimplify.

  Lemma div_mod''' a b : b <> 0 -> a = a mod b + (a / b) * b.
  Proof. intro; etransitivity; [ apply (Z.div_mod a b); assumption | lia ]. Qed.
#[global]
  Hint Rewrite <- div_mod''' using zutil_arith : zsimplify.

  Lemma sub_mod_mod_0 x d : (x - x mod d) mod d = 0.
  Proof.
    destruct (Z_zerop d); subst; push_Zmod; autorewrite with zsimplify; reflexivity.
  Qed.
#[global]
  Hint Resolve sub_mod_mod_0 : zarith.
#[global]
  Hint Rewrite sub_mod_mod_0 : zsimplify.

  Lemma mod_small_n n a b : 0 <= n -> b <> 0 -> n * b <= a < (1 + n) * b -> a mod b = a - n * b.
  Proof. intros; erewrite Zmod_eq_full, Z.div_between by eassumption. reflexivity. Qed.
#[global]
  Hint Rewrite mod_small_n using zutil_arith : zsimplify.

  Lemma mod_small_1 a b : b <> 0 -> b <= a < 2 * b -> a mod b = a - b.
  Proof. intros; rewrite (mod_small_n 1) by lia; lia. Qed.
#[global]
  Hint Rewrite mod_small_1 using zutil_arith : zsimplify.

  Lemma mod_opp_small a m : 0 < a <= m -> (-a) mod m = m - a.
  Proof. intros; symmetry; apply Zmod_unique with (-1); lia. Qed.

  Lemma mod_neg_small a m : -m <= a < 0 -> a mod m = m + a.
  Proof. intros; symmetry; apply Zmod_unique with (-1); lia. Qed.

  Lemma mod_small_n_if n a b : 0 <= n -> b <> 0 -> n * b <= a < (2 + n) * b -> a mod b = a - (if (1 + n) * b <=? a then (1 + n) else n) * b.
  Proof. intros; erewrite Zmod_eq_full, Z.div_between_if by eassumption; autorewrite with zsimplify_const. reflexivity. Qed.

  Lemma mod_small_0_if a b : b <> 0 -> 0 <= a < 2 * b -> a mod b = a - if b <=? a then b else 0.
  Proof. intros; rewrite (mod_small_n_if 0) by lia; autorewrite with zsimplify_const. break_match; lia. Qed.

  Lemma mul_mod_distr_r_full a b c : (a * c) mod (b * c) = (a mod b * c).
  Proof.
    destruct (Z_zerop b); [ | destruct (Z_zerop c) ]; subst;
      autorewrite with zsimplify; auto using Z.mul_mod_distr_r.
  Qed.

  Lemma mul_mod_distr_l_full a b c : (c * a) mod (c * b) = c * (a mod b).
  Proof.
    destruct (Z_zerop b); [ | destruct (Z_zerop c) ]; subst;
      autorewrite with zsimplify; auto using Z.mul_mod_distr_l.
  Qed.

  Lemma lt_mul_2_mod_sub : forall a b, b <> 0 -> b <= a < 2 * b -> a mod b = a - b.
  Proof.
    intros a b H H0.
    replace (a mod b) with ((1 * b + (a - b)) mod b) by (f_equal; ring).
    rewrite Z.mod_add_l by auto.
    apply Z.mod_small.
    lia.
  Qed.

  Lemma mod_pow_r_split x b e1 e2 : 0 <= b -> 0 <= e1 <= e2 -> x mod b^e2 = (x mod b^e1) + (b^e1) * ((x / b^e1) mod b^(e2-e1)).
  Proof.
    destruct (Z_zerop b).
    { destruct (Z_zerop e1), (Z_zerop e2), (Z.eq_dec e1 e2); subst; intros; cbn; autorewrite with zsimplify_fast; destruct x; lia. }
    intros.
    replace (b^e2) with (b^e1 * b^(e2 - e1)) by (autorewrite with pull_Zpow; f_equal; lia).
    rewrite Z.rem_mul_r by auto with zarith.
    reflexivity.
  Qed.

  Lemma opp_mod2 a : a mod 2 = - a mod 2.
  Proof. rewrite !Zmod_odd, Z.odd_opp; reflexivity. Qed.

  Lemma mod_pow_same_base_larger a b n m :
    0 <= n < m -> 0 < b ->
    (a mod (b^n)) mod (b^m) = a mod b^n.
  Proof.
    intros.
    pose proof Z.mod_pos_bound a (b^n) ltac:(auto with zarith).
    assert (b^n <= b^m) by auto with zarith.
    apply Z.mod_small. auto with zarith.
  Qed.

  Lemma mod_pow_same_base_smaller a b n m :
    0 <= m <= n -> 0 < b ->
    (a mod (b^n)) mod (b^m) = a mod b^m.
  Proof.
    intros. replace n with (m+(n-m)) by lia.
    rewrite Z.pow_add_r, Z.rem_mul_r by auto with zarith.
    push_Zmod; pull_Zmod.
    autorewrite with zsimplify_fast; reflexivity.
  Qed.

  (* Useful lemma for add-get-carry patterns.
     This expression performs a bitwise or. In terms of bit ranges,
       b...a + a...c << a-b = b...c *)
  Lemma add_div_pow2 x a b :
    0 <= b <= a ->
    (x mod (2 ^ a)) / 2 ^ b + x / 2 ^ a * 2 ^ (a - b)
    = x / 2 ^ b.
  Proof.
    intros. rewrite Z.pow_sub_r by auto with zarith.
    rewrite <-Z.divide_div_mul_exact
      by auto using Z.divide_pow_le with zarith.
    rewrite <-Z.div_add by auto with zarith.
    rewrite Z.mul_div_eq', Z.mul_mod, Z.mod_same_pow by auto with zarith.
    autorewrite with zsimplify.
    Z.div_mod_to_quot_rem; nia.
  Qed.
End Z.


(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)

Require Import Arith Lia.

Set Implicit Arguments.

Section nat_rev_ind.

  (* A reverse recursion principle *)

  Variables (P : nat -> Prop)
            (HP : forall n, P (S n) -> P n).

  Theorem nat_rev_ind x y : x <= y -> P y -> P x.
  Proof using HP. induction 1; auto. Qed.

End nat_rev_ind.

Section nat_rev_ind'.

  (* A reverse recursion principle *)

  Variables (P : nat -> Prop) (k : nat)
            (HP : forall n, n < k -> P (S n) -> P n).

  Theorem nat_rev_ind' x y : x <= y <= k -> P y -> P x.
  Proof using HP.
    intros H1 H2.
    set (Q n := n <= k /\ P n).
    assert (forall x y, x <= y -> Q y -> Q x) as H.
      apply nat_rev_ind.
      intros n (H3 & H4); split.
      lia.
      revert H4; apply HP, H3.
    apply (H x y).
    lia.
    split; auto; lia.
  Qed.

End nat_rev_ind'.

Section minimizer_pred.

  Variable (P : nat -> Prop)
           (HP : forall p: { n | P n \/ ~ P n }, { P (proj1_sig p) } + { ~ P (proj1_sig p) }).

  Definition minimizer n := P n /\ forall i, i < n -> ~ P i.

  Inductive bar n : Prop :=
    | in_bar_0 : P n -> bar n
    | in_bar_1 : ~ P n -> bar (S n) -> bar n.

  Let bar_ex n : bar n -> P n \/ ~ P n.
  Proof. induction 1; auto. Qed.

  Let loop : forall n, bar n -> { k | P k /\ forall i, n <= i < k -> ~ P i }.
  Proof.
    refine (fix loop n Hn { struct Hn } := match HP (exist _ n (bar_ex Hn)) with
      | left H => exist _ n _
      | right H => match loop (S n) _ with
        | exist _ k Hk => exist _ k _
      end
    end).
    * split; auto; intros; lia.
    * destruct Hn; [ destruct H | ]; assumption.
    * destruct Hk as (H1 & H2).
      split; trivial; intros i Hi.
      destruct (eq_nat_dec i n).
      - subst; trivial.
      - apply H2; lia.
  Qed.

  Hypothesis Hmin : ex minimizer.

  Let bar_0 : bar 0.
  Proof.
    destruct Hmin as (k & H1 & H2).
    apply in_bar_0 in H1.
    clear HP.
    revert H1.
    apply nat_rev_ind' with (k := k).
    intros i H3.
    apply in_bar_1, H2; trivial.
    lia.
  Qed.

  Definition minimizer_pred : sig minimizer.
  Proof using Hmin loop.
    destruct (loop bar_0) as (k & H1 & H2).
    exists k; split; auto.
    intros; apply H2; lia.
  Defined.

End minimizer_pred.

(* Check minimizer_pred. *)
(* Print Assumptions minimizer_pred. *)

(* (* Let P be a computable predicate: *)
(*       - whenever P n has a value (P n or not P n) then that value can be computed *)
(*     Then minimizer P is computable as well: *)
(*       - whenever minimizer P holds for some n, then such an n can be computed *)
(*  *) *)

(* Corollary minimizer_alt (P : nat -> Prop) : *)
(*     (forall n, P n \/ ~ P n -> { P n } + { ~ P n }) -> ex (minimizer P) -> sig (minimizer P). *)
(* Proof. *)
(*   intro H; apply minimizer_pred. *)
(*   intros (n & Hn); apply H, Hn. *)
(* Defined. *)

(* Check minimizer_alt. *)
(* Print Assumptions minimizer_alt. *)

(* Section minimizer. *)

(*   Variable (R : nat -> nat -> Prop) *)
(*            (Rfun : forall n u v, R n u -> R n v -> u = v) *)
(*            (HR : forall n, ex (R n) -> sig (R n)). *)

(*   Definition minimizer' n := R n 0 /\ forall i, i < n -> exists u, R i (S u). *)

(*   Fact minimizer_fun n m : minimizer' n -> minimizer' m -> n = m. *)
(*   Proof. *)
(*     intros (H1 & H2) (H3 & H4). *)
(*     destruct (lt_eq_lt_dec n m) as [ [ H | ] | H ]; auto;  *)
(*       [ apply H4 in H | apply H2 in H ]; destruct H as (u & Hu); *)
(*       [ generalize (Rfun H1 Hu) | generalize (Rfun H3 Hu) ]; discriminate. *)
(*   Qed.  *)

(*   Inductive bar n : Prop := *)
(*     | in_bar_0 : R n 0 -> bar n *)
(*     | in_bar_1 : (exists u, R n (S u)) -> bar (S n) -> bar n. *)

(*   Let bar_ex n : bar n -> ex (R n). *)
(*   Proof. *)
(*     induction 1 as [ n Hn | n (k & Hk) _ _ ]. *)
(*     exists 0; auto. *)
(*     exists (S k); trivial. *)
(*   Qed. *)

(*   Let loop : forall n, bar n -> { k | R k 0 /\ forall i, n <= i < k -> exists u, R i (S u) }. *)
(*   Proof. *)
(*     refine (fix loop n Hn { struct Hn } := match HR (bar_ex Hn) with *)
(*         | exist _ u Hu => match u as m return R _ m -> _ with *)
(*             | 0   => fun H => exist _ n _ *)
(*             | S v => fun H => match loop (S n) _ with *)
(*                 | exist _ k Hk => exist _ k _ *)
(*               end *)
(*           end Hu *)
(*       end). *)
(*     * split; auto; intros; lia. *)
(*     * destruct Hn as [ Hn | ]; trivial; exfalso; generalize (Rfun H Hn); discriminate. *)
(*     * destruct Hk as (H1 & H2); split; trivial; intros i Hi. *)
(*       destruct (eq_nat_dec i n). *)
(*       - subst; exists v; trivial. *)
(*       - apply H2; lia. *)
(*   Qed. *)

(*   Hypothesis Hmin : ex minimizer. *)

(*   Let bar_0 : bar 0. *)
(*   Proof. *)
(*     destruct Hmin as (k & H1 & H2). *)
(*     apply in_bar_0 in H1. *)
(*     clear Hmin HR. *)
(*     revert H1. *)
(*     apply nat_rev_ind' with (k := k). *)
(*     intros i H3. *)
(*     apply in_bar_1, H2; trivial. *)
(*     lia. *)
(*   Qed. *)

(*   Definition minimizer_coq : sig minimizer. *)
(*   Proof. *)
(*     destruct (loop bar_0) as (k & H1 & H2). *)
(*     exists k; split; auto. *)
(*     intros; apply H2; lia. *)
(*   Defined. *)

(* End minimizer. *)

(* Check minimizer_coq. *)
(* Print Assumptions minimizer_coq. *)

(* Extraction "minimizer.ml" minimizer_coq. *)


(** * IndPrinciples: Induction Principles *)

(** With the Curry-Howard correspondence and its realization in Coq in
    mind, we can now take a deeper look at induction principles. *)

Set Warnings "-notation-overridden,-parsing".
Require Export ProofObjects.
Check evenb.
(* ################################################################# *)
(** * Basics *)

(** Every time we declare a new [Inductive] datatype, Coq
    automatically generates an _induction principle_ for this type.
    This induction principle is a theorem like any other: If [t] is
    defined inductively, the corresponding induction principle is
    called [t_ind].  Here is the one for natural numbers: *)

Check nat_ind.
(*  ===> nat_ind :
           forall P : nat -> Prop,
              P 0  ->
              (forall n : nat, P n -> P (S n))  ->
              forall n : nat, P n  *)

(** The [induction] tactic is a straightforward wrapper that, at its
    core, simply performs [apply t_ind].  To see this more clearly,
    let's experiment with directly using [apply nat_ind], instead of
    the [induction] tactic, to carry out some proofs.  Here, for
    example, is an alternate proof of a theorem that we saw in the
    [Basics] chapter. *)

Theorem mult_0_r' : forall n:nat,
  n * 0 = 0.
Proof.
  apply nat_ind.
  - (* n = O *) reflexivity.
  - (* n = S n' *) simpl. intros n' IHn'. rewrite -> IHn'.
    reflexivity.  Qed.

(** This proof is basically the same as the earlier one, but a
    few minor differences are worth noting.

    First, in the induction step of the proof (the ["S"] case), we
    have to do a little bookkeeping manually (the [intros]) that
    [induction] does automatically.

    Second, we do not introduce [n] into the context before applying
    [nat_ind] -- the conclusion of [nat_ind] is a quantified formula,
    and [apply] needs this conclusion to exactly match the shape of
    the goal state, including the quantifier.  By contrast, the
    [induction] tactic works either with a variable in the context or
    a quantified variable in the goal.

    These conveniences make [induction] nicer to use in practice than
    applying induction principles like [nat_ind] directly.  But it is
    important to realize that, modulo these bits of bookkeeping,
    applying [nat_ind] is what we are really doing. *)

(** **** Exercise: 2 stars, optional (plus_one_r')  *)
(** Complete this proof without using the [induction] tactic. *)

Theorem plus_one_r' : forall n:nat,
  n + 1 = S n.
Proof.
  apply nat_ind.
  - reflexivity.
  - simpl. intros. rewrite H. reflexivity.
Qed.
(** [] *)

(** Coq generates induction principles for every datatype defined with
    [Inductive], including those that aren't recursive.  Although of
    course we don't need induction to prove properties of
    non-recursive datatypes, the idea of an induction principle still
    makes sense for them: it gives a way to prove that a property
    holds for all values of the type.

    These generated principles follow a similar pattern. If we define
    a type [t] with constructors [c1] ... [cn], Coq generates a
    theorem with this shape:

    t_ind : forall P : t -> Prop,
              ... case for c1 ... ->
              ... case for c2 ... -> ...
              ... case for cn ... ->
              forall n : t, P n

    The specific shape of each case depends on the arguments to the
    corresponding constructor.  Before trying to write down a general
    rule, let's look at some more examples. First, an example where
    the constructors take no arguments: *)

Inductive yesno : Type :=
  | yes : yesno
  | no : yesno.

Check yesno_ind.
(* ===> yesno_ind : forall P : yesno -> Prop,
                      P yes  ->
                      P no  ->
                      forall y : yesno, P y *)

(** **** Exercise: 1 star, optional (rgb)  *)
(** Write out the induction principle that Coq will generate for the
    following datatype.  Write down your answer on paper or type it
    into a comment, and then compare it with what Coq prints. *)

(*rgb_ind: forall P: rgb -> Prop,
  P red -> P green -> P blue -> forall y:rgb, P y*)
Inductive rgb : Type :=
  | red : rgb
  | green : rgb
  | blue : rgb.
Check rgb_ind.
(** [] *)

(** Here's another example, this time with one of the constructors
    taking some arguments. *)

Inductive natlist : Type :=
  | nnil : natlist
  | ncons : nat -> natlist -> natlist.

Check natlist_ind.
(* ===> (modulo a little variable renaming)
   natlist_ind :
      forall P : natlist -> Prop,
         P nnil  ->
         (forall (n : nat) (l : natlist),
            P l -> P (ncons n l)) ->
         forall n : natlist, P n *)

(** **** Exercise: 1 star, optional (natlist1)  *)
(** Suppose we had written the above definition a little
   differently: *)

Inductive natlist1 : Type :=
  | nnil1 : natlist1
  | nsnoc1 : natlist1 -> nat -> natlist1.

Check natlist1_ind.

(** Now what will the induction principle look like? *)
(**
  natlist1_ind:
    forall P: natlist1 -> Prop,
      P nnil1 -> (forall n:natlist1, P n -> (forall n0:nat, P (nsnoc1 n n0)))
        -> forall n:natlist1, P n.

*)

(** From these examples, we can extract this general rule:

    - The type declaration gives several constructors; each
      corresponds to one clause of the induction principle.
    - Each constructor [c] takes argument types [a1] ... [an].
    - Each [ai] can be either [t] (the datatype we are defining) or
      some other type [s].
    - The corresponding case of the induction principle says:

        - "For all values [x1]...[xn] of types [a1]...[an], if [P]
          holds for each of the inductive arguments (each [xi] of type
          [t]), then [P] holds for [c x1 ... xn]".
*)

(** **** Exercise: 1 star, optional (byntree_ind)  *)
(** Write out the induction principle that Coq will generate for the
    following datatype.  (Again, write down your answer on paper or
    type it into a comment, and then compare it with what Coq
    prints.) *)

Inductive byntree : Type :=
 | bempty : byntree
 | bleaf  : yesno -> byntree
 | nbranch : yesno -> byntree -> byntree -> byntree.

(**
    byntree_ind
    : forall P: byntree -> Prop,
        P bempty -> (forall y:yesno, P (bleaf y)) ->
          (forall y:yesno (b byntree), P b -> forall b1:byntree, P b1 -> P (nbranch y b b1)) ->
            forall b:byntree, P b.

*)

(** **** Exercise: 1 star, optional (ex_set)  *)
(** Here is an induction principle for an inductively defined
    set.

      ExSet_ind :
         forall P : ExSet -> Prop,
             (forall b : bool, P (con1 b)) ->
             (forall (n : nat) (e : ExSet), P e -> P (con2 n e)) ->
             forall e : ExSet, P e

    Give an [Inductive] definition of [ExSet]: *)

Inductive ExSet : Type :=
  | con1: bool -> ExSet
  | con2: nat -> ExSet -> ExSet.
Check ExSet_ind.
(** [] *)

(* ################################################################# *)
(** * Polymorphism *)

(** Next, what about polymorphic datatypes?

    The inductive definition of polymorphic lists

      Inductive list (X:Type) : Type :=
        | nil : list X
        | cons : X -> list X -> list X.

    is very similar to that of [natlist].  The main difference is
    that, here, the whole definition is _parameterized_ on a set [X]:
    that is, we are defining a _family_ of inductive types [list X],
    one for each [X].  (Note that, wherever [list] appears in the body
    of the declaration, it is always applied to the parameter [X].)
    The induction principle is likewise parameterized on [X]:

      list_ind :
        forall (X : Type) (P : list X -> Prop),
           P [] ->
           (forall (x : X) (l : list X), P l -> P (x :: l)) ->
           forall l : list X, P l

    Note that the _whole_ induction principle is parameterized on
    [X].  That is, [list_ind] can be thought of as a polymorphic
    function that, when applied to a type [X], gives us back an
    induction principle specialized to the type [list X]. *)

(** **** Exercise: 1 star, optional (tree)  *)
(** Write out the induction principle that Coq will generate for
   the following datatype.  Compare your answer with what Coq
   prints. *)

Inductive tree (X:Type) : Type :=
  | leaf : X -> tree X
  | node : tree X -> tree X -> tree X.
Check tree_ind.
(**
  tree_ind :
    forall (X:Type) P: tree X -> Prop, (forall l:X, P (leaf X l)) ->
       (forall t:tree X, P t -> (forall t0:tree X, P t0) -> P (node X t t0)) ->
          forall t:tree X, P t.

*)

(** **** Exercise: 1 star, optional (mytype)  *)
(** Find an inductive definition that gives rise to the
    following induction principle:

      mytype_ind :
        forall (X : Type) (P : mytype X -> Prop),
            (forall x : X, P (constr1 X x)) ->
            (forall n : nat, P (constr2 X n)) ->
            (forall m : mytype X, P m ->
               forall n : nat, P (constr3 X m n)) ->
            forall m : mytype X, P m
*)
Inductive mytype (X:Type):Type :=
  | constr1 : X -> mytype X
  | constr2 : nat -> mytype X
  | constr3 : mytype X -> nat -> mytype X.
Check mytype_ind.

(** **** Exercise: 1 star, optional (foo)  *)
(** Find an inductive definition that gives rise to the
    following induction principle:

      foo_ind :
        forall (X Y : Type) (P : foo X Y -> Prop),
             (forall x : X, P (bar X Y x)) ->
             (forall y : Y, P (baz X Y y)) ->
             (forall f1 : nat -> foo X Y,
               (forall n : nat, P (f1 n)) -> P (quux X Y f1)) ->
             forall f2 : foo X Y, P f2
*)
(** [] *)

Inductive foo (X Y:Type):Type :=
  | bar : X -> foo X Y
  | baz : Y -> foo X Y
  | quux: (nat -> foo X Y)  -> foo X Y.
Check foo_ind.

(** **** Exercise: 1 star, optional (foo')  *)
(** Consider the following inductive definition: *)

Inductive foo' (X:Type) : Type :=
  | C1 : list X -> foo' X -> foo' X
  | C2 : foo' X.
Check foo'_ind.
(** What induction principle will Coq generate for [foo']?  Fill
   in the blanks, then check your answer with Coq.)

     foo'_ind :
        forall (X : Type) (P : foo' X -> Prop),
              (forall (l : list X) (f : foo' X),
                    ___, P f -> P (C1 X l f) ____________________ ->
                    _______________________   ) ->
             ______P (C2 X)_____________________________________ ->
             forall f : foo' X, ____P f____________________
*)

(** [] *)

(* ################################################################# *)
(** * Induction Hypotheses *)

(** Where does the phrase "induction hypothesis" fit into this story?

    The induction principle for numbers

       forall P : nat -> Prop,
            P 0  ->
            (forall n : nat, P n -> P (S n))  ->
            forall n : nat, P n

   is a generic statement that holds for all propositions
   [P] (or rather, strictly speaking, for all families of
   propositions [P] indexed by a number [n]).  Each time we
   use this principle, we are choosing [P] to be a particular
   expression of type [nat->Prop].

   We can make proofs by induction more explicit by giving
   this expression a name.  For example, instead of stating
   the theorem [mult_0_r] as "[forall n, n * 0 = 0]," we can
   write it as "[forall n, P_m0r n]", where [P_m0r] is defined
   as... *)

Definition P_m0r (n:nat) : Prop :=
  n * 0 = 0.

(** ... or equivalently: *)

Definition P_m0r' : nat->Prop :=
  fun n => n * 0 = 0.

(** Now it is easier to see where [P_m0r] appears in the proof. *)

Theorem mult_0_r'' : forall n:nat,
  P_m0r n.
Proof.
  apply nat_ind.
  - (* n = O *) reflexivity.
  - (* n = S n' *)
    (* Note the proof state at this point! *)
    intros n IHn.
    unfold P_m0r in IHn. unfold P_m0r. simpl. apply IHn. Qed.

(** This extra naming step isn't something that we do in
    normal proofs, but it is useful to do it explicitly for an example
    or two, because it allows us to see exactly what the induction
    hypothesis is.  If we prove [forall n, P_m0r n] by induction on
    [n] (using either [induction] or [apply nat_ind]), we see that the
    first subgoal requires us to prove [P_m0r 0] ("[P] holds for
    zero"), while the second subgoal requires us to prove [forall n',
    P_m0r n' -> P_m0r (S n')] (that is "[P] holds of [S n'] if it
    holds of [n']" or, more elegantly, "[P] is preserved by [S]").
    The _induction hypothesis_ is the premise of this latter
    implication -- the assumption that [P] holds of [n'], which we are
    allowed to use in proving that [P] holds for [S n']. *)

(* ################################################################# *)
(** * More on the [induction] Tactic *)

(** The [induction] tactic actually does even more low-level
    bookkeeping for us than we discussed above.

    Recall the informal statement of the induction principle for
    natural numbers:
      - If [P n] is some proposition involving a natural number n, and
        we want to show that P holds for _all_ numbers n, we can
        reason like this:
          - show that [P O] holds
          - show that, if [P n'] holds, then so does [P (S n')]
          - conclude that [P n] holds for all n.
    So, when we begin a proof with [intros n] and then [induction n],
    we are first telling Coq to consider a _particular_ [n] (by
    introducing it into the context) and then telling it to prove
    something about _all_ numbers (by using induction).

    What Coq actually does in this situation, internally, is to
    "re-generalize" the variable we perform induction on.  For
    example, in our original proof that [plus] is associative... *)

Theorem plus_assoc' : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  (* ...we first introduce all 3 variables into the context,
     which amounts to saying "Consider an arbitrary [n], [m], and
     [p]..." *)
  intros n m p.
  (* ...We now use the [induction] tactic to prove [P n] (that
     is, [n + (m + p) = (n + m) + p]) for _all_ [n],
     and hence also for the particular [n] that is in the context
     at the moment. *)
  induction n as [| n'].
  - (* n = O *) reflexivity.
  - (* n = S n' *)
    (* In the second subgoal generated by [induction] -- the
       "inductive step" -- we must prove that [P n'] implies
       [P (S n')] for all [n'].  The [induction] tactic
       automatically introduces [n'] and [P n'] into the context
       for us, leaving just [P (S n')] as the goal. *)
    simpl. rewrite -> IHn'. reflexivity.  Qed.

(** It also works to apply [induction] to a variable that is
    quantified in the goal. *)

Theorem plus_comm' : forall n m : nat,
  n + m = m + n.
Proof.
  induction n as [| n'].
  - (* n = O *) intros m. rewrite  plus_n_O. reflexivity.
  - (* n = S n' *) intros m. simpl. rewrite -> IHn'.
    rewrite <- plus_n_Sm. reflexivity.  Qed.

(** Note that [induction n] leaves [m] still bound in the goal --
    i.e., what we are proving inductively is a statement beginning
    with [forall m].

    If we do [induction] on a variable that is quantified in the goal
    _after_ some other quantifiers, the [induction] tactic will
    automatically introduce the variables bound by these quantifiers
    into the context. *)

Theorem plus_comm'' : forall n m : nat,
  n + m = m + n.
Proof.
  (* Let's do induction on [m] this time, instead of [n]... *)
  induction m as [| m'].
  - (* m = O *) simpl. rewrite <- plus_n_O. reflexivity.
  - (* m = S m' *) simpl. rewrite <- IHm'.
    rewrite <- plus_n_Sm. reflexivity.  Qed.

(** **** Exercise: 1 star, optional (plus_explicit_prop)  *)
(** Rewrite both [plus_assoc'] and [plus_comm'] and their proofs in
    the same style as [mult_0_r''] above -- that is, for each theorem,
    give an explicit [Definition] of the proposition being proved by
    induction, and state the theorem and proof in terms of this
    defined proposition.  *)
Definition P_pa (n m p:nat):Prop :=
    (n + m) + p = n + (m + p).

Theorem plus_assoc'': forall n m p, P_pa n m p.
Proof.
  intros n m p. induction n as [|n' IHn'].
  - unfold P_pa. simpl. reflexivity.
  - unfold P_pa. simpl. unfold P_pa in IHn'. rewrite IHn'. reflexivity.
Qed.

Definition P_pc (n m:nat) : Prop :=
    n + m = m + n.

Theorem plus_comm''': forall n m:nat, P_pc n m.
Proof.
  intros n m.
  induction n as [|n' IHn'].
  - unfold P_pc. rewrite plus_n_O. reflexivity.
  - unfold P_pc in IHn'. unfold P_pc. rewrite <- plus_n_Sm. simpl. rewrite IHn'.
     reflexivity.
Qed.
(** [] *)

(* ################################################################# *)
(** * Induction Principles in [Prop] *)

(** Earlier, we looked in detail at the induction principles that Coq
    generates for inductively defined _sets_.  The induction
    principles for inductively defined _propositions_ like [ev] are a
    tiny bit more complicated.  As with all induction principles, we
    want to use the induction principle on [ev] to prove things by
    inductively considering the possible shapes that something in [ev]
    can have.  Intuitively speaking, however, what we want to prove
    are not statements about _evidence_ but statements about
    _numbers_: accordingly, we want an induction principle that lets
    us prove properties of numbers by induction on evidence.

    For example, from what we've said so far, you might expect the
    inductive definition of [ev]...

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

    ...to give rise to an induction principle that looks like this...

    ev_ind_max : forall P : (forall n : nat, ev n -> Prop),
         P O ev_0 ->
         (forall (m : nat) (E : ev m),
            P m E ->
            P (S (S m)) (ev_SS m E)) ->
         forall (n : nat) (E : ev n),
         P n E

     ... because:

     - Since [ev] is indexed by a number [n] (every [ev] object [E] is
       a piece of evidence that some particular number [n] is even),
       the proposition [P] is parameterized by both [n] and [E] --
       that is, the induction principle can be used to prove
       assertions involving both an even number and the evidence that
       it is even.

     - Since there are two ways of giving evidence of evenness ([ev]
       has two constructors), applying the induction principle
       generates two subgoals:

         - We must prove that [P] holds for [O] and [ev_0].

         - We must prove that, whenever [n] is an even number and [E]
           is an evidence of its evenness, if [P] holds of [n] and
           [E], then it also holds of [S (S n)] and [ev_SS n E].

     - If these subgoals can be proved, then the induction principle
       tells us that [P] is true for _all_ even numbers [n] and
       evidence [E] of their evenness.

    This is more flexibility than we normally need or want: it is
    giving us a way to prove logical assertions where the assertion
    involves properties of some piece of _evidence_ of evenness, while
    all we really care about is proving properties of _numbers_ that
    are even -- we are interested in assertions about numbers, not
    about evidence.  It would therefore be more convenient to have an
    induction principle for proving propositions [P] that are
    parameterized just by [n] and whose conclusion establishes [P] for
    all even numbers [n]:

       forall P : nat -> Prop,
       ... ->
       forall n : nat,
       even n -> P n

    For this reason, Coq actually generates the following simplified
    induction principle for [ev]: *)

Check ev_ind.
(* ===> ev_ind
        : forall P : nat -> Prop,
          P 0 ->
          (forall n : nat, ev n -> P n -> P (S (S n))) ->
          forall n : nat,
          ev n -> P n *)

(** In particular, Coq has dropped the evidence term [E] as a
    parameter of the the proposition [P]. *)

(** In English, [ev_ind] says:

    - Suppose, [P] is a property of natural numbers (that is, [P n] is
      a [Prop] for every [n]).  To show that [P n] holds whenever [n]
      is even, it suffices to show:

      - [P] holds for [0],

      - for any [n], if [n] is even and [P] holds for [n], then [P]
        holds for [S (S n)]. *)

(** As expected, we can apply [ev_ind] directly instead of using
    [induction].  For example, we can use it to show that [ev'] (the
    slightly awkward alternate definition of evenness that we saw in
    an exercise in the \chap{IndProp} chapter) is equivalent to the
    cleaner inductive definition [ev]: *)
Theorem ev_ev' : forall n, ev n -> ev' n.
Proof.
  apply ev_ind.
  - (* ev_0 *)
    apply ev'_0.
  - (* ev_SS *)
    intros m Hm IH.
    apply (ev'_sum 2 m).
    + apply ev'_2.
    + apply IH.
Qed.

(** The precise form of an [Inductive] definition can affect the
    induction principle Coq generates.

    For example, in chapter [IndProp], we defined [<=] as: *)

(* Inductive le : nat -> nat -> Prop :=
     | le_n : forall n, le n n
     | le_S : forall n m, (le n m) -> (le n (S m)). *)

(** This definition can be streamlined a little by observing that the
    left-hand argument [n] is the same everywhere in the definition,
    so we can actually make it a "general parameter" to the whole
    definition, rather than an argument to each constructor. *)

Inductive le (n:nat) : nat -> Prop :=
  | le_n : le n n
  | le_S : forall m, (le n m) -> (le n (S m)).

Notation "m <= n" := (le m n).

(** The second one is better, even though it looks less symmetric.
    Why?  Because it gives us a simpler induction principle. *)

Check le_ind.
(* ===>  forall (n : nat) (P : nat -> Prop),
           P n ->
           (forall m : nat, n <= m -> P m -> P (S m)) ->
           forall n0 : nat, n <= n0 -> P n0 *)

(* ################################################################# *)
(** * Formal vs. Informal Proofs by Induction *)

(** Question: What is the relation between a formal proof of a
    proposition [P] and an informal proof of the same proposition [P]?

    Answer: The latter should _teach_ the reader how to produce the
    former.

    Question: How much detail is needed??

    Unfortunately, there is no single right answer; rather, there is a
    range of choices.

    At one end of the spectrum, we can essentially give the reader the
    whole formal proof (i.e., the "informal" proof will amount to just
    transcribing the formal one into words).  This may give the reader
    the ability to reproduce the formal one for themselves, but it
    probably doesn't _teach_ them anything much.

   At the other end of the spectrum, we can say "The theorem is true
   and you can figure out why for yourself if you think about it hard
   enough."  This is also not a good teaching strategy, because often
   writing the proof requires one or more significant insights into
   the thing we're proving, and most readers will give up before they
   rediscover all the same insights as we did.

   In the middle is the golden mean -- a proof that includes all of
   the essential insights (saving the reader the hard work that we
   went through to find the proof in the first place) plus high-level
   suggestions for the more routine parts to save the reader from
   spending too much time reconstructing these (e.g., what the IH says
   and what must be shown in each case of an inductive proof), but not
   so much detail that the main ideas are obscured.

   Since we've spent much of this chapter looking "under the hood" at
   formal proofs by induction, now is a good moment to talk a little
   about _informal_ proofs by induction.

   In the real world of mathematical communication, written proofs
   range from extremely longwinded and pedantic to extremely brief and
   telegraphic.  Although the ideal is somewhere in between, while one
   is getting used to the style it is better to start out at the
   pedantic end.  Also, during the learning phase, it is probably
   helpful to have a clear standard to compare against.  With this in
   mind, we offer two templates -- one for proofs by induction over
   _data_ (i.e., where the thing we're doing induction on lives in
   [Type]) and one for proofs by induction over _evidence_ (i.e.,
   where the inductively defined thing lives in [Prop]). *)

(* ================================================================= *)
(** ** Induction Over an Inductively Defined Set *)

(** _Template_:

       - _Theorem_: <Universally quantified proposition of the form
         "For all [n:S], [P(n)]," where [S] is some inductively defined
         set.>

         _Proof_: By induction on [n].

           <one case for each constructor [c] of [S]...>

           - Suppose [n = c a1 ... ak], where <...and here we state
             the IH for each of the [a]'s that has type [S], if any>.
             We must show <...and here we restate [P(c a1 ... ak)]>.

             <go on and prove [P(n)] to finish the case...>

           - <other cases similarly...>                        []

    _Example_:

      - _Theorem_: For all sets [X], lists [l : list X], and numbers
        [n], if [length l = n] then [index (S n) l = None].

        _Proof_: By induction on [l].

        - Suppose [l = []].  We must show, for all numbers [n],
          that, if [length [] = n], then [index (S n) [] =
          None].

          This follows immediately from the definition of [index].

        - Suppose [l = x :: l'] for some [x] and [l'], where
          [length l' = n'] implies [index (S n') l' = None], for
          any number [n'].  We must show, for all [n], that, if
          [length (x::l') = n] then [index (S n) (x::l') =
          None].

          Let [n] be a number with [length l = n].  Since

            length l = length (x::l') = S (length l'),

          it suffices to show that

            index (S (length l')) l' = None.

          But this follows directly from the induction hypothesis,
          picking [n'] to be [length l'].  [] *)

(* ================================================================= *)
(** ** Induction Over an Inductively Defined Proposition *)

(** Since inductively defined proof objects are often called
    "derivation trees," this form of proof is also known as _induction
    on derivations_.

    _Template_:

       - _Theorem_: <Proposition of the form "[Q -> P]," where [Q] is
         some inductively defined proposition (more generally,
         "For all [x] [y] [z], [Q x y z -> P x y z]")>

         _Proof_: By induction on a derivation of [Q].  <Or, more
         generally, "Suppose we are given [x], [y], and [z].  We
         show that [Q x y z] implies [P x y z], by induction on a
         derivation of [Q x y z]"...>

           <one case for each constructor [c] of [Q]...>

           - Suppose the final rule used to show [Q] is [c].  Then
             <...and here we state the types of all of the [a]'s
             together with any equalities that follow from the
             definition of the constructor and the IH for each of
             the [a]'s that has type [Q], if there are any>.  We must
             show <...and here we restate [P]>.

             <go on and prove [P] to finish the case...>

           - <other cases similarly...>                        []

    _Example_

       - _Theorem_: The [<=] relation is transitive -- i.e., for all
         numbers [n], [m], and [o], if [n <= m] and [m <= o], then
         [n <= o].

         _Proof_: By induction on a derivation of [m <= o].

           - Suppose the final rule used to show [m <= o] is
             [le_n]. Then [m = o] and we must show that [n <= m],
             which is immediate by hypothesis.

           - Suppose the final rule used to show [m <= o] is
             [le_S].  Then [o = S o'] for some [o'] with [m <= o'].
             We must show that [n <= S o'].
             By induction hypothesis, [n <= o'].

             But then, by [le_S], [n <= S o'].  [] *)


Goal forall P Q : nat -> Prop, P 0 -> (forall x , P x -> Q x) -> Q 0.
Proof.
  intros.
  apply H0.
  apply H.
Qed.

Goal forall P : nat -> Prop, P 2 -> (exists y, P (1 + y)).
Proof.
  intros.
  exists 1.
  apply H.
Qed.

Goal forall P : nat -> Prop, (forall n m, P n -> P m) -> (exists p, P p) -> forall q, P q.
Proof.
  intros.
  destruct H0.
  apply (H x q).
  apply H0.
Qed.


Require Import Coq.Reals.Reals.
Require Import Coq.setoid_ring.Ring_theory.
Require Import Ring Ring_tac.
Require Import Coq.Classes.RelationClasses.
Require Import Relation_Definitions Setoid.

Example whitehead {R : Type} {rO rI : R} {radd rmul rsub : R -> R -> R}
         {ropp : R -> R} {req : R -> R -> Prop} (req_eq : Equivalence req)
         (Rth : ring_theory rO rI radd rmul rsub ropp req) (Rth_proper : ring_eq_ext radd rmul ropp req):
         forall x : R, req (rmul (rmul (radd rI rI) x) (radd x rI)) (radd (rmul (radd rI rI) (rmul x x)) (rmul (radd rI rI) x)).
intros.
apply (@Equivalence_Transitive _ _ req_eq _ _ _ (Rmul_comm Rth (rmul (radd rI rI) x) (radd x rI))).
apply (@Equivalence_Transitive _ _ req_eq _ _ _ (Rdistr_l Rth _ _ _)).
apply (radd_ext Rth_proper).
apply (@Equivalence_Transitive _ _ req_eq _ _ _ (Rmul_assoc Rth _ _ _)).
apply (@Equivalence_Transitive _ _ req_eq _ _ _ (Rmul_comm Rth _ x)).
apply (@Equivalence_Transitive _ _ req_eq _ _ _ (Rmul_assoc Rth _ _ _)).
apply (Rmul_comm Rth (rmul x x) (radd rI rI)).
apply (Rmul_1_l Rth _).
Defined.

Open Scope R_scope.

Example whitehead_real : forall x : R, ((2 * x) * (x + 1)) = ((2 * (x * x)) + (2 * x)).
apply (whitehead (Eqsth _) RTheory).
split; cbv.
all: intros.
all: rewrite H.
3: reflexivity.
all: rewrite H0.
all: reflexivity.
Defined.


Require Import Nijn.Prelude.Checks.
Require Import Nijn.Prelude.Relations.WellfoundedRelation.
Require Import Nijn.Prelude.Orders.CompatibleRelation.

(** * The lexicographic order *)

Section Lexico.
  Context (X : CompatRel)
          {Y : Type}
          `{isCompatRel X}
          (RY : Y -> Y -> Type).

  (** Given a compatible relation and a type with a relation on it, then we can define the lexicographic order on the product. *)
  Definition lexico
    : X * Y -> X * Y -> Type
    := fun x y => ((gt (fst x) (fst y))
                   +
                   ((fst x >= fst y) * RY (snd x) (snd y)))%type.

  (** Transitivity for the lexicographic order *)
  Proposition lexico_trans
              (RYtrans : forall (y1 y2 y3 : Y),
                           RY y1 y2 -> RY y2 y3 -> RY y1 y3)
              {x y z : X * Y}
              (p : lexico x y)
              (q : lexico y z)
    : lexico x z.
  Proof.
    destruct p as [p | [p1 p2]], q as [q | [q1 q2]].
    - left.
      exact (gt_trans p q).
    - left.
      exact (gt_ge p q1).
    - left.
      exact (ge_gt p1 q).
    - right.
      split.
      + exact (ge_trans p1 q1).
      + exact (RYtrans _ _ _ p2 q2).
  Qed.

  (** Wellfoundedness of the lexicographic order *)
  Proposition lexico_Wf_help
              (x : X * Y)
              (z1 : X)
              (p : fst x >= z1)
              (HX : isWf lexico x)
    : isWf lexico (z1 , snd x).
  Proof.
    revert p.
    revert z1.
    induction HX as [[q1 q2] Hq IHq].
    simpl in *.
    intros z1 p.
    apply acc.
    intros [w1 w2] [H' | [H1 H2]] ; simpl in *.
    - refine (IHq (w1 , w2) _ w1 _) ; simpl.
      + left ; simpl.
        exact (ge_gt p H').
      + apply ge_refl.
    - refine (IHq (q1 , w2) _ w1 _).
      + right ; simpl.
        split.
        * apply ge_refl.
        * exact H2.
      + refine (ge_trans p H1).
  Qed.

  Proposition lexico_Wf
              (HX : Wf (fun (x y : X) => x > y))
              (HY : Wf RY)
    : Wf lexico.
  Proof.
    intros [x y].
    pose (HX x) as Hx.
    revert y.
    induction Hx as [x Hx IHx].
    intros y.
    pose (HY y) as Hy.
    induction Hy as [y Hy IHy].
    apply acc.
    intros [z1 z2] [Hz | [Hz1 Hz2]] ; simpl in *.
    - apply IHx.
      exact Hz.
    - refine (lexico_Wf_help (x , _) z1 Hz1 _).
      exact (IHy z2 Hz2).
  Qed.
End Lexico.


Require Import QArith.
Require Import Arith.
Require Import Omega.

(* RI x y = x + y√5 *)
Record ri : Set := RI { R : Q; I : Q }.

Definition RIred (r : ri) := RI (Qred (R r)) (Qred (I r)).

Definition RInegate (r : ri) := RI (0 - R r) (0 - I r).

Definition RIplus (r1 : ri) (r2 : ri) := RI (R r1 + R r2) (I r1 + I r2).

Definition RIminus (r1 : ri) (r2 : ri) := RIplus r1 (RInegate r2).

Definition RImult (r1 : ri) (r2 : ri) :=
  let w := R r1  in
  let x := I r1  in
  let y := R r2  in
  let z := I r2  in
  let a := 5 # 1 in
  RI (w * y + x * z * a) (w * z + x * y).

Fixpoint RIpower (r : ri) (n: nat) :=
  match n with
  | O => RI (1 # 1) (0 # 1)
  | S O => r
  | S n => RImult (RIpower r n) r
  end.

Notation "a ^ b" := (RIpower a b).
Notation "a * b" := (RImult  a b).
Notation "a + b" := (RIplus  a b).
Notation "a - b" := (RIminus a b).

Definition fib (n : nat) := RI 0 (1 # 5) * ((RI (1 # 2) (1 # 2)) ^ n - (RI (1 # 2) ((0 - 1) # 2)) ^ n).

Fixpoint fib' (n : nat) : nat
 := match n with
  | O => 0
  | S O => 1
  | S n => fib' n + fib' (pred n)
 end.

Definition prop : forall (n : nat), (Z.of_nat (fib' n)) # 1 = R (RIred (fib n)).
Proof.
intros.
induction n.
simpl.
reflexivity.
simpl in IHn.
simpl.


Require Import Nat Arith.

Inductive Lst : Type := cons : nat -> Lst -> Lst |  nil : Lst.

Fixpoint len (len_arg0 : Lst) : nat
           := match len_arg0 with
              | nil => 0
              | cons x y => plus 1 (len y)
              end.

Theorem theorem0 : forall (x : Lst), ge (len x) 0.
Proof.
   intros.
   induction x.
   - simpl. auto.
   - simpl. auto.
Qed.


From NaturalNumbers Require Export Base Tutorial Addition Multiplication.

Fixpoint pow (a p : mynat) : mynat :=
    match p with
    | O => I
    | S q => (pow a q) * a
    end.

Infix "^" := pow.
Notation "(^)" := pow (only parsing).
Notation "( f ^)" := (pow f) (only parsing).
Notation "(^ f )" := (fun g => pow g f) (only parsing).

Fact pow_zero (a : mynat) : a ^ 0 = 1.
Proof.
    (* unfold pow *)
    trivial.
Qed.

Fact pow_succ (a b : mynat) : a ^ S b = a ^ b * a.
Proof.
    (* unfold pow *)
    trivial.
Qed.

(* Level 0 data *)
(* name `zero_pow_zero` *)
(* tactics ring *)
(* theorems pow_succ *)
(* Level 0 prologue *)
(*
Power world it is! Let's define our power operator on `mynat` real quick,
and give you the following theorems to work with:
<ul>
    <li>`Fact pow_zero (a : mynat) : a ^ 0 = 1.`</li>
    <li>`Fact pow_succ (a b : mynat) : a ^ S b = a ^ b * a.`</li>
</ul>
We will not be needing any additional tactics in this world,
`rewrite`, `reflexivity` and `induction` should be enough, though
the `ring` tactic might come in handy!

I will leave you at it for this world, with all the theorems you
have so far you should be able to handle yourself without any
hints or tips from me!
*)
Lemma zero_pow_zero : 0 ^ 0 = 1.
Proof.
    (* unfold pow *)
    reflexivity.
Qed.
(* Level epilogue *)
(* Level end *)

(* Level 1 data *)
(* name `zero_pow_succ` *)
(* tactics ring *)
(* theorems pow_succ *)
(* Level 1 prologue *)
Lemma zero_pow_succ (m : mynat) : 0 ^ S m = 0.
Proof.
    (* probably best to do this with induction over m for practice though *)
    reflexivity.
Qed.
(* Level epilogue *)
(* Level end *)

(* Level 2 data *)
(* name `pow_one` *)
(* tactics ring *)
(* theorems pow_succ *)
(* Level 2 prologue *)
Lemma pow_one (a : mynat) : a ^ 1 = a.
Proof.
    rewrite one_eq_succ_zero.
    rewrite pow_succ.
    rewrite pow_zero.
    ring.
Qed.
(* Level epilogue *)
(* Level end *)

(* Level 3 data *)
(* name `one_pow` *)
(* tactics ring *)
(* theorems pow_succ *)
(* Level 3 prologue *)
Lemma one_pow (m : mynat) : 1 ^ m = 1.
Proof.
    induction m as [| ? H].
    - reflexivity.
    - rewrite pow_succ.
      rewrite H.
      reflexivity.
Qed.
(* Level epilogue *)
(* Level end *)

(* Level 4 data *)
(* name `pow_add` *)
(* tactics ring *)
(* theorems pow_succ *)
(* Level 4 prologue *)
Lemma pow_add (a m n : mynat) : a ^ (m + n) = a ^ m * a ^ n.
Proof.
    induction n as [| ? H].
    - rewrite pow_zero.
      ring_simplify.
      reflexivity.
    - rewrite add_succ.
      repeat rewrite pow_succ.
      rewrite H.
      ring.
Qed.
(* Level epilogue *)
(* Level end *)

(* Level 5 data *)
(* name `mul_pow` *)
(* tactics ring *)
(* theorems pow_succ *)
(* Level 5 prologue *)
Lemma mul_pow (a b n : mynat) : (a * b) ^ n = a ^ n * b ^ n.
Proof.
    induction n as [| ? H].
    - reflexivity.
    - repeat rewrite pow_succ.
      rewrite H.
      ring.
Qed.
(* Level epilogue *)
(* Level end *)

(* Level 6 data *)
(* name `pow_pow` (boss level!) *)
(* tactics ring *)
(* theorems pow_succ *)
(* Level 6 prologue *)
(*
Boss level! Alright, maybe a quick tip about the `rewrite` tactic.
Did you know that instead of repeatedly writing `rewrite` with different
theorems or hypotheses like so:
```
rewrite succ_add.
rewrite mul_succ.
rewrite mul_add.
...
```
you can instead do
```
rewrite succ_add, mul_succ, mul_add.
```
Try it out!
*)
Lemma pow_pow (a m n : mynat) : (a ^ m) ^ n = a ^ (m * n).
Proof.
    induction n as [| ? H].
    - repeat rewrite pow_zero; easy.
    - rewrite mul_succ, pow_succ, pow_add.
      rewrite H.
      reflexivity.
Qed.
(* Level epilogue *)
(* Level end *)

Definition II := S I.
Notation "2" := II.
Fact two_eq_succ_one : 2 = S 1.
Proof.
  trivial.
Qed.

(* Level 7 data *)
(* name `add_squared` *)
(* tactics ring *)
(* theorems two_eq_succ_one *)
(* Level 7 prologue *)
(*
I have just added the definition for 2 (yeah, we didn't
have that yet...) and a theorem
```
#Fact two_eq_succ_one : 2 = S 1.
```
Use it to prove the last theorem of Power World!
*)
Lemma add_squared (a b : mynat) : (a + b) ^ 2 = a^2 + b^2 + 2 * a * b.
Proof.
    (* rewrite two_eq_succ_one *)
    unfold II, I.
    repeat rewrite pow_succ.
    repeat rewrite pow_zero.
    repeat rewrite one_mul.
    rewrite mul_add, add_mul.
    rewrite add_mul.
    repeat rewrite succ_mul.
    (* ring_simplify.  output is ugly *)
    ring.
Qed.
(* Level epilogue *)
(* Level end *)


Require Import Coq.Bool.Bool.
Require Import Coq.Arith.Arith.
Require Import Coq.Arith.EqNat.
Require Import Coq.omega.Omega.
Require Import Coq.Lists.List.
Require Import QArith.
Import ListNotations.
Require Import Reals.
Require Import Psatz.
Require Import QArith.Qminmax.
Require Import List.
Require Import PeanoNat.

Fixpoint replace_in_list (i :nat)(l : list Q)(b : Q):=
match i,l with
| O , nil => nil
| O ,  _::l' => b :: l'
| S i' , nil =>  nil
| S i' , a::l' => a :: (replace_in_list i' l' b)
end.

Check replace_in_list.
Definition lpoint : list (Q)
  := 1:: 0:: 1 :: 0:: 1 ::  nil.

Eval compute in (replace_in_list 3 lpoint (3#1)).

Definition i_element(i:nat)(l:list Q)(d:Q):=nth i l d.

Definition j_element(j:nat)(l:list Q)(d:Q):=nth j l d.

Definition swap (i j :nat)(l : list Q) :=
replace_in_list i (replace_in_list j l (nth i l 0)) (nth j l 0) .

Eval compute in (swap 1 2 lpoint).

Search Qle.
Check Qle_bool.

Fixpoint insert (n:Q)(ms : list Q) :=
  match ms with
  | nil => n::nil
  | m::ms' => if  Qle_bool n m
              then n::ms
              else m::(insert n ms')
  end.

Eval compute in insert (3#1) (1::0::1::4#1::nil).

Fixpoint sort (ms : list Q) :=
  match ms with
  | nil => nil
  | m::ms' => insert m (sort ms')
  end.

Eval compute in sort (4#1::2#1::3#1::1::nil).

Eval compute in (le 4 1).

Definition is_sorted (l : list Q) :=
forall (i:nat), ( i < ((length l) -1))%nat -> ((nth i l 0) <= (nth (i+1) l 0)).

Lemma single_sort: forall a:Q, is_sorted [a].
Proof.
intros.
unfold is_sorted.
intros.
induction i.
- simpl in *. lia.
- simpl in *. lia.
Qed.
Search Qle.

Lemma empty_list_is_sorted:is_sorted ([]).
Proof.
unfold is_sorted.
intros.
induction i.
- simpl. apply Qle_refl.
- simpl. apply Qle_refl.
Qed.

Lemma sortedlist_sort:forall (a:Q)(l:list Q), is_sorted (a::l)-> is_sorted l.
Proof.
intros. unfold is_sorted in *. intros. specialize (H (S i)). induction i.
- simpl in *. rewrite <- minus_n_O in H.
  apply  (lt_O_minus_lt (length l) 1) in H0. auto.
- simpl in *. rewrite <- minus_n_O in H.
  apply Nat.lt_add_lt_sub_r in H0. rewrite Nat.add_1_r in H0. auto.
Qed.

Lemma insert_sorted_0: forall (a :Q) (l:list Q), is_sorted(l) /\ a <= nth 0 l 0
-> is_sorted(a::l).
Proof.
intros. destruct H. unfold is_sorted. intros. induction i.
  - simpl. auto.
  - simpl. unfold is_sorted in H. specialize (H i). simpl in H1.
    rewrite <- Nat.add_1_r in H1. rewrite <- minus_n_O in H1.
    apply Nat.lt_add_lt_sub_r in H1. auto.
Qed.

Lemma Qle_bool_false: forall (a b :Q) , (Qle_bool a b = false) -> a>b.
Proof.
 intros.
  generalize ((proj2 (Qle_bool_iff a b))). rewrite H.
  destruct (Qlt_le_dec b a); intuition; try discriminate.
Qed.

Lemma list_length: forall(l:list Q) , (length l >= 0)%nat.
Proof.
intro. induction l.
  - simpl. auto.
  - simpl.  rewrite <- Nat.add_1_r. apply le_plus_trans. auto.
Qed.

Lemma succ_pos: forall(n:nat) ,( S n > 0 )%nat.
Proof.
intros. induction n.
  - auto.
  -  auto.
Qed.

Lemma insert_works: forall (l : list Q) (a : Q), (is_sorted l) ->
(is_sorted (insert a l)).
Proof.
intros.
induction l.
  - simpl in *. apply single_sort.
  - unfold insert. remember (Qle_bool a a0) as res. induction res.
      + symmetry in Heqres. apply Qle_bool_iff in Heqres.
        apply insert_sorted_0. split.
        -- auto.
        -- simpl. auto.
      + fold insert. unfold is_sorted. intros. induction i.
        -- simpl. unfold insert. induction l.
           ++ simpl. symmetry in Heqres. apply Qle_bool_false in Heqres.
              apply Qlt_le_weak. auto.
           ++ simpl in *. remember (Qle_bool a a1) as b. induction b.
              --- simpl. symmetry in Heqres. apply Qle_bool_false in Heqres.
                  apply Qlt_le_weak. auto.
              --- simpl. fold insert in IHl0. unfold is_sorted in H.
                  specialize (H O) . simpl in *. assert ( 0 < S (length l))%nat.
                  +++ apply succ_pos.
                  +++ auto.
        -- simpl. apply sortedlist_sort in H. apply IHl.
           ++ auto.
           ++ simpl in H0. rewrite <- Nat.add_1_r in H0.
              rewrite <- minus_n_O in H0. apply Nat.lt_add_lt_sub_r in H0. auto.
Qed.

Lemma sort_sorts: forall (l: list Q), is_sorted( sort l).
Proof.
intros.
induction l.
  - simpl in *. apply empty_list_is_sorted.
  - simpl in *. apply insert_works. auto.
Qed.