 Set Warnings "-notation-overridden,-parsing".
Require Export IndProp.

Definition relation(X:Type) :=
  X->X->Prop.

Print le.
Check le.
Check le : relation nat.

Definition partial_function{X:Type}
  (R:relation X) :=
  forall x y1 y2 : X,
  R x y1 -> R x y2 -> y1 = y2.

Print next_nat.
Check next_nat : relation nat.

Theorem next_nat_partial_function :
  partial_function next_nat.
Proof.
  unfold partial_function.
  intros x y1 y2 eq1 eq2.
  inversion eq1.
  inversion eq2.
  reflexivity.
  Qed.

Theorem le_not_a_partial_function :
  ~(partial_function le).
Proof.
  unfold not.
  unfold partial_function.
  intros eq.
  assert(0=1) as contra.
  { apply eq with (x:=0).
    - apply le_n.
    - apply le_S. apply le_n. }
  inversion contra.
  Qed.

Definition reflexive{X:Type}(R:relation X)
  := forall a:X, R a a.

Theorem le_reflexive: reflexive le.
Proof.
  unfold reflexive.
  intros a. apply le_n.
  Qed.

Definition transitive{X:Type}(R:relation X)
  := forall a b c : X,
  (R a b) -> (R b c) -> (R a c).

Theorem le_trans : transitive le.
Proof.
  unfold transitive.
  intros a b c eqab eqbc.
  apply le_trans with (m:=a)(n:=b)(o:=c).
  - apply eqab.
  - apply eqbc.
  Qed.

Theorem lt_trans : transitive lt.
Proof.
  unfold lt. unfold transitive.
  intros a b c Hnm Hmo.
  apply le_S in Hnm.
  apply le_trans with (a:=(S a))(b:=(S b))(c:=c).
  - apply Hnm.
  - apply Hmo.
  Qed.

(* Exercise le_trans_hard_way *)
Theorem lt_trans': transitive lt.
Proof.
  unfold lt. unfold transitive.
  intros n m o Hnm Hmo.
  induction Hmo as [|m' Hm'o].
  - Print le.
    apply le_S. apply Hnm.
  - apply le_S. apply IHHm'o.
  Qed.

(* Exercise le_S_n *)
Theorem le_Sn_le: forall n m,
  S n <= m ->
  n <= m.
Proof.
  intros n m eq.
  apply le_trans with (a:=n)(b:=S n)(c:=m).
  - apply le_S. apply le_n.
  - apply eq.
  Qed.

Theorem le_S_n: forall n m,
  (S n <= S m) -> (n <= m).
Proof.
  intros n m eq.
  Search le.
  apply Sn_le_Sm__n_le_m.
  apply eq.
  Qed.

(* Exercise le_Sn_n *)
Theorem le_Sn_n: forall n,
  ~(S n <= n).
Proof.
  unfold not. intros n eq.
  induction n as [|n' IHn'].
  - inversion eq.
  - apply Sn_le_Sm__n_le_m in eq.
  apply IHn' in eq. apply eq.
  Qed.

Definition symmetric{X:Type}(R:relation X)
  := forall a b : X,
  (R a b) -> (R b a).

(* Exercise le_not_symmetry *)
Theorem le_not_symmetric:
  ~(symmetric le).
Proof.
  unfold symmetric. unfold not.
  intros eq. apply eq with (a:=0)(b:=S 0) in eq.
  - apply le_Sn_n in eq. apply eq.
  - assert(H:0<=S 0).
  { apply le_S. apply le_n. }
  apply eq in H. apply H.
  Qed.

Definition antisymmetric{X:Type}(R:relation X)
  := forall a b : X,
  (R a b) -> (R b a) -> a = b.

(* Exercise le_antisymmetry *)
Lemma eq_S_n: forall n m,
  n = m ->
  S n = S m.
Proof.
  intros. rewrite H. reflexivity.
  Qed.

Theorem le_antisymmetric: antisymmetric le.
Proof.
  unfold antisymmetric.
  induction a as [|a' IHa'].
  - intros. inversion H0. reflexivity.
  - induction b as [|b' IHb'].
    + intros. inversion H.
    + intros. apply eq_S_n. apply IHa'.
      * apply le_S_n. apply H.
      * apply le_S_n. apply H0.
  Qed.

(* Exercise le_step *)
Theorem le_step : forall n m p,
  n < m ->
  m <= S p ->
  n <= p.
Proof.
  unfold lt. intros n m p eqnm eqm.
  apply le_S_n.
  apply le_trans with (a:=S n)(b:=m)(c:=S p).
  - apply eqnm.
  - apply eqm.
  Qed.

Definition equivalence{X:Type}(R:relation X)
  := (reflexive R)/\(symmetric R)/\(transitive R).

Definition order{X:Type}(R:relation X) :=
  (reflexive R)/\(antisymmetric R)/\(transitive R).

Definition preorder{X:Type}(R:relation X) :=
  (reflexive R)/\(transitive R).

Theorem le_order : order le.
Proof.
  unfold order. split.
  - apply le_reflexive.
  - split.
   + apply le_antisymmetric.
   + apply le_trans.
  Qed.

Inductive clos_refl_trans{A:Type}(R:relation A)
  : relation A :=
  | rt_step: forall x y, R x y -> clos_refl_trans R x y
  | rt_refl: forall x, clos_refl_trans R x x
  | rt_trans: forall x y z,
    clos_refl_trans R x y ->
    clos_refl_trans R y z ->
    clos_refl_trans R x z.

Theorem next_nat_closure_is_le: forall n m,
  (n<=m) <-> ((clos_refl_trans next_nat) n m).
Proof.
  intros n m. split.
  - intros H. induction H.
    + apply rt_refl.
    + apply rt_trans with m.
      * apply IHle.
      * apply rt_step. apply nn.
  - intros H. induction H.
    + inversion H. apply le_S. apply le_n.
    + apply le_n.
    + apply le_trans with y.
      * apply IHclos_refl_trans1.
      * apply IHclos_refl_trans2.
  Qed.

Inductive clos_refl_trans_ln{A:Type}
      (R:relation A)(x:A) : A->Prop
  :=
  | rtln_refl: clos_refl_trans_ln R x x
  | rtln_trans (y z : A) :
    R x y ->
    clos_refl_trans_ln R y z ->
    clos_refl_trans_ln R x z.

Lemma rsc_R : forall (X:Type)(R:relation X)
  (x y : X),
  R x y -> clos_refl_trans_ln R x y.
Proof.
  intros X R x y H.
  apply rtln_trans with y.
  - apply H.
  - apply rtln_refl.
  Qed.

(* Exercise rsc_trans *)
Lemma rsc_trans:
  forall (X:Type)(R:relation X)(x y z : X),
    clos_refl_trans_ln R x y ->
      clos_refl_trans_ln R y z ->
      clos_refl_trans_ln R x z.
Proof.
  intros X R x y z eqxy eqyz.
  induction eqxy.
  - apply eqyz.
  - apply IHeqxy in eqyz.
  apply rtln_trans with y.
    + apply H.
    + apply eqyz.
  Qed.

(* Exercise rtc_rsc_coincide *)
Theorem rtc_rsc_coincide:
  forall (X:Type)(R:relation X)(x y:X),
  clos_refl_trans R x y <-> clos_refl_trans_ln R x y.
Proof.
  intros X R x y. split.
  - intros eq.
  induction eq.
    + apply rtln_trans with y.
      * apply H.
      * apply rtln_refl.
    + apply rtln_refl.
    + apply rsc_trans with y.
      * apply IHeq1.
      * apply IHeq2.
  - intros eq.
  induction eq.
    + apply rt_refl.
    + apply rt_trans with y.
      * apply rt_step. apply H.
      * apply IHeq.
  Qed.


Theorem negation_fn_applied_twice:
    forall (f : bool -> bool),
    (forall (x : bool), f x = negb x) ->
    forall (b : bool), f (f b) = b.
Proof.
    intros f.
    intros H.
    intros b.
    rewrite -> H.
    rewrite -> H.
    destruct b.
    - reflexivity.
    - reflexivity.
Qed.


Require Import Coq.Arith.Arith.

(* from http://adam.chlipala.net/cpdt/html/Cpdt.MoreDep.html *)

Inductive type : Set :=
| Nat : type
| Bool : type
| Prod : type -> type -> type.

Inductive exp : type -> Set :=
| NConst : nat -> exp Nat
| Plus : exp Nat -> exp Nat -> exp Nat
| Eq : exp Nat -> exp Nat -> exp Bool

| BConst : bool -> exp Bool
| And : exp Bool -> exp Bool -> exp Bool
| If : forall t, exp Bool -> exp t -> exp t -> exp t

| Pair : forall t1 t2, exp t1 -> exp t2 -> exp (Prod t1 t2)
| Fst : forall t1 t2, exp (Prod t1 t2) -> exp t1
| Snd : forall t1 t2, exp (Prod t1 t2) -> exp t2.

Fixpoint typeDenote (t : type) : Set :=
  match t with
    | Nat => nat
    | Bool => bool
    | Prod t1 t2 => typeDenote t1 * typeDenote t2
  end%type.

Fixpoint expDenote {t} (e : exp t) : typeDenote t :=
  match e with
    | NConst n => n
    | Plus e1 e2 => expDenote e1 + expDenote e2
    | Eq e1 e2 => if eq_nat_dec (expDenote e1) (expDenote e2) then true else false

    | BConst b => b
    | And e1 e2 => andb (expDenote e1) (expDenote e2)
    | If _ e' e1 e2 => if expDenote e' then expDenote e1 else expDenote e2

    | Pair _ _ e1 e2 => (expDenote e1, expDenote e2)
    | Fst _ _ e' => fst (expDenote e')
    | Snd _ _ e' => snd (expDenote e')
  end.


From LF Require Export Poly.

Theorem silly1: forall (n m o p : nat),
  n = m -> [n;o] = [n;p] -> [n;o] = [m;p].
Proof.
  intros n m o p eq1 eq2.
  rewrite <- eq1. apply eq2. (* Hypothesis and the goal is the same. *)
Qed.

Theorem silly2 : forall (n m o p : nat),
  n = m -> (n = m -> [n;o] = [m;p]) -> [n;o] = [m;p].
Proof.
  intros n m o p eq1 eq2.
  apply eq2. (* Replace the goal with the predicate of eq2. *)
  apply eq1.
Qed.

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

Theorem silly_ex :
  (forall n, even n = true -> odd (S n) = true) ->
  even 2 = true -> odd 3 = true.
Proof.
  intros eq1 eq2. apply eq1. apply eq2. Qed
.

Theorem silly3_firsttry : forall (n : nat),
  true = (n =? 5) ->
  (S (S n)) =? 7 = true.
Proof.
  intros n H. symmetry. (* Swap left and right of the goal. *)
  simpl. apply H. Qed
.

Theorem rev_injective : forall (l l' : list nat),
  rev l = rev l' -> l = l'.
Proof.
  intros l l' H.
  rewrite <- rev_involutive. rewrite <- H. symmetry. apply rev_involutive.
Qed.

Theorem rev_exercise1 : forall (l l' : list nat),
  l = rev l' -> l' = rev l.
Proof.
  intros. rewrite -> H. symmetry. apply rev_involutive.
Qed
.

Example trans_eq_example : forall (a b c d e f : nat),
 [a;b] = [c;d] -> [c;d]=[e;f] -> [a;b] = [e;f].
Proof.
  intros a b c d e f eq1 eq2.
  rewrite -> eq1.
  rewrite -> eq2.
  reflexivity. Qed
.

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

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

Example trans_eq_example'' : forall (a b c d e f : nat),
  [a;b] = [c;d] -> [c;d] = [e;f] -> [a;b] = [e;f].
Proof.
  intros a b c d e f eq1 eq2.
  transitivity [c;d]. (* transitivity tactic accomplishes the same purpose as applying trans_eq. *)
  apply eq1. apply eq2.
Qed
.

Example trans_eq_exercise : forall (n m o p : nat),
  m = (minustwo o) ->
  (n + p) = m ->
  (n + p) = (minustwo o).
Proof.
  intros n m o p eq1 eq2.
  transitivity m. apply eq2. apply eq1. Qed
.

Theorem S_injective : forall (n m : nat),
  S n = S m -> n = m.
Proof.
  intros n m H1.
  assert (H2: n = pred (S n)). { reflexivity. }
  rewrite H2. rewrite H1. reflexivity.
Qed.

(* Any constructors are injective. *)
(* injection tactic makes use of injectivity of constructors. *)
Theorem S_injective' : forall (n m : nat),
  S n = S m -> n = m.
Proof.
  intros n m H.
  injection H as Hnm. (* generate all equations that it can infer from H using the injectivity of consturctors. i.e (H: S n = S m) -> (Hnm: n m). *)
  apply Hnm.
Qed
.

Theorem injection_ex1 : forall (n m o : nat),
  [n; m] = [o; o] ->
  [n] = [m].
Proof.
  intros n m o H.
  injection H as H1 H2.
  rewrite H1. rewrite H2. reflexivity. Qed
.

Theorem injection_ex2 : forall (n m o : nat),
  [n; m] = [o; o] ->
  [n] = [m].
Proof.
  intros n m o H.
  injection H. (* All the equations are turned into hypotheses at the beginning of the goal. *)
  intros H1 H2. rewrite H1. rewrite H2. reflexivity. Qed
.

Example inejction_ex3: forall (X: Type) (x y z : X) (l j : list X),
  x :: y :: l = z :: j -> j = z :: l -> x = y.
Proof.
  intros X x y z l j eq1 eq2.
  injection eq1 as eq11 eq12.
  assert (H : y :: l = z :: l). {
    transitivity j.
    apply eq12. apply eq2.
  }
  injection H as H1.
  rewrite eq11. rewrite H1. reflexivity. Qed
.

Theorem eqb_0_1 : forall n,
  0 =? n = true -> n = 0.
Proof.
  intros n.
  destruct n as [| n'] eqn:E.
  - reflexivity.
  - simpl. intros H. discriminate H. (* principle of explosion *)
Qed.
Theorem discriminate_ex1 : forall n : nat,
  S n = O -> 2 + 2 = 5.
Proof.
  intros n contra.
  discriminate contra.
Qed.

Example discriminate_ex2: forall n m : nat,
  false = true -> [n] = [m].
Proof.
  intros. discriminate H.
Qed.

Example discriminate_ex3: forall (X:Type) (x y z:X) (l j : list X),
  x :: y :: l = [] -> x = z.
Proof.
  intros. discriminate H.
Qed
.

Theorem f_equal : forall (A B : Type) (f : A -> B) (x y : A),
  x = y -> f x = f y.
Proof.
  intros A B f x y eq. rewrite eq. reflexivity. Qed
.

Theorem eq_implies_succ_equal : forall n m : nat,
  n = m -> S n = S m.
Proof.
  intros. apply f_equal. apply H. Qed.

(* f_equal tactic: Given the goal f a1 ... an = g b1 ... bn, it produce subgoals f = g, a1 = b1, ..., an = bn. *)
Theorem eq_implies_succ_equal' : forall n m : nat,
  n = m -> S n = S m.
Proof.
  intros n m H.
  f_equal. apply H. Qed
.

(* Using Tactics on Hypotheses *)
Theorem S_inj : forall (n m : nat) (b:bool),
  (S n) =? (S m) = b -> n =? m = b.
Proof.
  intros n m b H. simpl in H. apply H. Qed
.

Theorem silly3' : forall (n : nat),
  (n =? 5 = true -> (S (S n)) =? 7 = true) ->
  true = (n =? 5) ->
  true = ((S (S n)) =? 7).
Proof.
  intros n eq H.
  symmetry in H. apply eq in H. symmetry in H.
  apply H. Qed
.

Theorem double_injective_FAILED : forall n m,
double n = double m ->
n = m.
Proof.
intros n m. induction n as [| n' IHn'].
- (* n = O *) simpl. intros eq. destruct m as [| m'] eqn:E.
  + (* m = O *) reflexivity.
  + (* m = S m' *) discriminate eq.
- (* n = S n' *) intros eq. destruct m as [| m'] eqn:E.
  + (* m = O *) discriminate eq.
  + (* m = S m' *) apply f_equal. Abort
.

Theorem double_injective : forall n m,
  double n = double m ->
  n = m.
  Proof.
  induction n as [| n' IHn'].
  - (* n = O *) simpl. intros m eq. destruct m as [| m'] eqn:E.
    + reflexivity.
    + discriminate eq.
  - simpl. intros m eq. destruct m as [|m'] eqn:E.
    + discriminate eq.
    + f_equal. apply IHn'. simpl in eq. injection eq as goal. apply goal.
Qed
.

Theorem eqb_true : forall n m,
  n =? m = true -> n = m.
Proof.
  induction n as [|n' IHn'].
  - destruct m as [|m'].
    + reflexivity.
    + intros H. simpl in H. discriminate H.
  - destruct m as [|m'].
    + intros H. simpl in H. discriminate H.
    + simpl. intros H. apply IHn' in H. rewrite H. reflexivity.
Qed
.

Theorem plus_n_n_injective : forall n m,
  n + n = m + m -> n = m.
Proof.
  induction n as [|n' IHn'].
  - destruct m as [|m'].
    + reflexivity.
    + simpl. intros H. simpl in H. discriminate H.
  - destruct m as [|m'].
    + simpl. intros H. discriminate H.
    + simpl. intros H. injection H as H1. rewrite <- plus_n_Sm in H1. symmetry. rewrite <- plus_n_Sm in H1. injection H1 as H2. apply IHn' in H2. rewrite H2. reflexivity.
Qed.

Theorem double_injective_take2_FAILED : forall n m,
  double n = double m ->
  n = m.
Proof.
  intros n m. induction m as [| m' IHm'].
  - (* m = O *) simpl. intros eq. destruct n as [| n'] eqn:E.
    + reflexivity.
    + discriminate eq.
  - intros eq. destruct n as [|n'] eqn:E.
    + discriminate eq.
    + f_equal. Abort
.

Theorem double_injective_take2 : forall n m,
  double n = double m ->
  n = m.
Proof.
  intros n m. (* Context: n, m: nat, Goal: double n = double m -> n = m *)
  generalize dependent n. (* Context: m : nat, Goal: forall n : nat, double n = double m -> n = m *)
  induction m as [| m' IHm'].
  - (* m = O *) simpl. intros n eq. destruct n as [| n'] eqn:E.
    + reflexivity.
    + discriminate eq.
  - intros n eq. destruct n as [|n'] eqn:E.
    + discriminate eq.
    + f_equal. apply IHm'. simpl in eq. injection eq as goal. apply goal. Qed
.

Theorem nth_error_after_last : forall (n : nat) (X : Type) (l : list X),
  length l = n -> nth_error l n = None.
Proof.
  intros n X l.
  generalize dependent n.
  induction l as [| h t IHl'].
  - intros H. simpl. reflexivity.
  - intros n H. simpl in H. simpl. destruct n.
    + discriminate H.
    + apply IHl'. injection H as H1. apply H1. Qed
.

(* Unfolding Definitinos *)
Definition square n := n * n.

Lemma square_mult : forall n m, square (n * m) = square n * square m.
Proof.
  intros n m.
  simpl.
  unfold square.
  rewrite mult_assoc.
  assert (H: n*m*n = n*n*m). { rewrite mul_comm. apply mult_assoc. }
  rewrite H. rewrite mult_assoc. reflexivity. Qed
.

Definition foo (x : nat) := 5.
Fact silly_fact_1 : forall m, foo m + 1 = foo (m + 1) + 1.
Proof.
  intros m.
  simpl.
  reflexivity.
  Qed
.

Definition bar x :=
  match x with | O => 5 | S _ => 5 end
.

Fact silly_fact_2_FAILED : forall m, bar m + 1 = bar (m + 1) + 1.
Proof.
  intros m.
  simpl.
Abort.

Fact silly_fact_2 : forall m, bar m + 1 = bar (m + 1) + 1.
Proof.
  intros m.
  destruct m eqn: E.
  - reflexivity.
  - reflexivity.
Qed.

Fact silly_fact_2' : forall m, bar m + 1 = bar (m + 1) + 1.
Proof.
  intros m.
  unfold bar.
  destruct m eqn:E.
  - reflexivity.
  - reflexivity.
Qed.

Definition sillyfun (n:nat) : bool :=
  if n =? 3 then false
  else if n =? 5 then false
  else false
.

Theorem sillyfun_false : forall (n : nat),
  sillyfun n = false.
Proof.
  intros n. unfold sillyfun.
  destruct (n =? 3) eqn:E1.
  - reflexivity.
  - destruct (n =? 5) eqn: E2.
    + reflexivity.
    + reflexivity. Qed
.

Theorem combine_split : forall X Y (l : list (X * Y)) l1 l2,
  split l = (l1, l2) ->
  combine l1 l2 = l.
Proof.
  intros X Y l l1 l2 H.
  generalize dependent l2.
  generalize dependent l1.
  induction l as [|h t IH].
  - unfold split. simpl. intros l1 l2 H. injection H as H1 H2. rewrite <- H1. rewrite <- H2. reflexivity.
  - intros l1 l2. destruct h as [x y]. intros H. simpl in H. destruct (split t) as [xt yt]. destruct l1 as [|h1 t1].
    + discriminate H.
    + destruct l2 as [|h2 t2].
      * discriminate H.
      * simpl. f_equal.
        ** injection H as H1 H2. rewrite H1. rewrite H. reflexivity.
        ** apply IH. injection H as H1 H2. rewrite H2. rewrite H0. reflexivity.
Qed
.

Definition sillyfun1 (n : nat) : bool :=
  if n =? 3 then true
  else if n =? 5 then true
  else false.

  Theorem sillyfun1_odd_FAILED : forall (n : nat),
  sillyfun1 n = true -> odd n = true.
Proof.
  intros n eq. unfold sillyfun1 in eq.
  destruct (n =? 3).
  - Abort
.

Theorem sillyfun1_odd : forall (n : nat),
  sillyfun1 n = true -> odd n = true.
Proof.
  intros n eq. unfold sillyfun1 in eq.
  destruct (n =? 3) eqn:E.
  - apply eqb_true in E. rewrite E. reflexivity.
  - destruct (n =? 5) eqn:E5.
    + apply eqb_true in E5.
      rewrite E5. reflexivity.
    + discriminate eq. Qed
.

Theorem bool_fn_applied_thrice :
  forall (f : bool -> bool) (b : bool),
  f (f (f b)) = f b.
Proof.
  intros f b.
  destruct (f true) eqn:Et.
  - destruct (f false) eqn:Ef.
    + destruct b.
      * rewrite Et. rewrite Et. rewrite Et. reflexivity.
      * rewrite Ef. rewrite Et. rewrite Et. reflexivity.
    + destruct b.
      * rewrite Et. rewrite Et. rewrite Et. reflexivity.
      * rewrite Ef. rewrite Ef. rewrite Ef. reflexivity.
  - destruct (f false) eqn:Ef.
  + destruct b.
    * rewrite Et. rewrite Ef. rewrite Et. reflexivity.
    * rewrite Ef. rewrite Et. rewrite Ef. reflexivity.
  + destruct b.
    * rewrite Et. rewrite Ef. rewrite Ef. reflexivity.
    * rewrite Ef. rewrite Ef. rewrite Ef. reflexivity.
Qed
.

Theorem eqb_sym : forall (n m : nat),
  (n =? m) = (m =? n).
Proof.
  induction n as [| n' IHn'].
  - destruct m as [| m'].
    + reflexivity.
    + reflexivity.
  - destruct m as [| m'].
    + reflexivity.
    + simpl. apply IHn'.
Qed
.

Theorem eqb_trans : forall n m p,
  n =? m = true -> m =? p = true -> n =? p = true.
Proof.
  intros n m p H1 H2.
  apply eqb_true in H1. apply eqb_true in H2.
  rewrite H1. rewrite H2. rewrite eqb_refl. reflexivity.
Qed
.

Definition split_combine_statement : Prop :=
  forall X Y (l1: list X) (l2:list Y),
  length l1 = length l2 -> split (combine l1 l2) = (l1, l2).

Theorem split_combine : split_combine_statement.
Proof.
  unfold split_combine_statement.
  intros X Y.
  induction l1 as [| h1 t1 IH1].
  - simpl. destruct l2 as [| h2 t2].
    + reflexivity.
    + simpl. discriminate.
  - simpl. destruct l2 as [| h2 t2].
    + simpl. discriminate.
    + simpl. intro H. injection H as H'. apply IH1 in H'. rewrite H'. reflexivity.
Qed.

Fixpoint forallb {X:Type} (test:X->bool) (l:list X) : bool :=
  match l with
  | nil => true
  | x::t => match test x with
    | true => forallb test t
    | false => false
  end
  end
.

Fixpoint existsb {X:Type} (test:X->bool) (l:list X) : bool :=
  match l with
  | nil => false
  | x::t => match test x with
    | true => true
    | false => existsb test t
  end
  end
.

Example test_forallb_1 : forallb odd [1;3;5;7;9] = true.
Proof. reflexivity. Qed.
Example test_forallb_2 : forallb negb [false;false] = true.
Proof. reflexivity. Qed.
Example test_forallb_3 : forallb even [0;2;4;5] = false.
Proof. reflexivity. Qed.
Example test_forallb_4 : forallb (eqb 5) [] = true.
Proof. reflexivity. Qed.

Example test_existsb_1 : existsb (eqb 5) [0;2;3;6] = false.
Proof. reflexivity. Qed.
Example test_existsb_2 : existsb (andb true) [true;true;false] = true.
Proof. reflexivity. Qed.
Example test_existsb_3 : existsb odd [1;0;0;0;0;3] = true.
Proof. reflexivity. Qed.
Example test_existsb_4 : existsb even [] = false.
Proof. reflexivity. Qed.

Definition existsb' {X:Type} (test:X->bool) (l:list X) : bool :=
  negb (forallb (fun x => negb (test x)) l)
.

Example test_existsb_1' : existsb' (eqb 5) [0;2;3;6] = false.
Proof. reflexivity. Qed.
Example test_existsb_2' : existsb' (andb true) [true;true;false] = true.
Proof. reflexivity. Qed.
Example test_existsb_3' : existsb' odd [1;0;0;0;0;3] = true.
Proof. reflexivity. Qed.
Example test_existsb_4' : existsb' even [] = false.
Proof. reflexivity. Qed.

Theorem existsb_existsb' : forall (X:Type) (test:X->bool) (l:list X),
  existsb test l = existsb' test l.
Proof.
  induction l as [| h t IHl].
  - reflexivity.
  - simpl. destruct (test h) eqn: eq.
    + unfold existsb'. simpl. rewrite eq. reflexivity.
    + unfold existsb'. simpl. rewrite eq. simpl. unfold existsb' in IHl. apply IHl.
Qed.


Set Warnings "-notation-overridden,-parsing".
From LF Require Export Indprop.

Print even.

Check ev_SS.

Theorem ev_4 : even 4.
Proof.
  apply ev_SS. apply ev_SS. apply ev_0. Qed.

Print ev_4.

Check (ev_SS 2 (ev_SS 0 ev_0)).

Theorem ev_4': even 4.
Proof.
  apply (ev_SS 2 (ev_SS 0 ev_0)).
Qed.

Theorem ev_4'' : even 4.
Proof.
  Show Proof.
  apply ev_SS.
  Show Proof.
  apply ev_SS.
  Show Proof.
  apply ev_0.
  Show Proof.
Qed.

Definition ev_4''' : even 4 :=
  ev_SS 2 (ev_SS 0 ev_0).

Print ev_4.
Print ev_4'.
Print ev_4''.
Print ev_4'''.

(*standard (eight_is_even)*)
Theorem ev_8 : even 8.
Proof.
  Show Proof.
  apply ev_SS.
  Show Proof.
  apply ev_SS.
  Show Proof.
  apply ev_SS.
  Show Proof.
  apply ev_SS.
  Show Proof.
  apply ev_0.
  Show Proof.
Qed.

Definition ev_8' : even 8 :=
  ev_SS 6 (ev_SS 4 (ev_SS 2 (ev_SS 0 ev_0))).
(*/standard (eight_is_even)*)

Theorem ev_plus4 : forall n, even n -> even (4 + n).
Proof.
  intros n H. simpl.
  apply ev_SS.
  apply ev_SS.
  apply H.
Qed.

Definition ev_plus4' : forall n, even n -> even (4 + n) :=
  fun (n : nat) => fun (H : even n) =>
    ev_SS (S (S n)) (ev_SS n H).

Definition ev_plus4'' (n : nat) (H : even n)
                    : even (4 + n) :=
  ev_SS (S (S n)) (ev_SS n H).

Check ev_plus4''.

Definition ev_plus2 : Prop :=
  forall n, forall (E : even n), even (n + 2).

Definition ev_plus2' : Prop :=
  forall n, forall (_ : even n), even (n + 2).

Definition ev_plus2'' : Prop :=
  forall n, even n -> even (n + 2).

Definition add1 : nat -> nat.
intro n.
Show Proof.
apply S.
Show Proof.
apply n. Defined.

Print add1.

Compute add1 2.

Module Props.

Module And.

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

End And.

Print prod.

Lemma and_comm : forall P Q : Prop, P /\ Q <-> Q /\ P.
Proof.
  intros P Q. split.
  - intros [HP HQ]. split.
    + apply HQ.
    + apply HP.
  - intros [HP HQ]. split.
    + apply HQ.
    + apply HP.
Qed.

Definition and_comm'_aux P Q (H : P /\ Q) : Q /\ P :=
  match H with
  | conj HP HQ => conj HQ HP
  end.

Definition and_comm' P Q : P /\ Q <-> Q /\ P :=
  conj (and_comm'_aux P Q) (and_comm'_aux Q P).

Definition conj_fact : forall P Q R, P /\ Q -> Q /\ R -> P /\ R :=
  fun P Q R (PQ:P/\Q) (QR:Q/\R) =>
    match PQ with
      | conj HP HQ => match QR with
                        | conj HQ HR => conj HP HR
                      end
    end.

Module Or.

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

End Or.

Definition or_comm : forall P Q, P \/ Q -> Q \/ P  :=
  fun P Q (PQ:P\/Q) =>
    match PQ with
      | or_introl HP => or_intror HP
      | or_intror HQ => or_introl HQ
    end.

Module Ex.

Inductive ex {A : Type} (P : A -> Prop) : Prop :=
| ex_intro : forall x : A, P x -> ex P.

End Ex.

Check ex (fun n => even n).

Definition some_nat_is_even : exists n, even n :=
  ex_intro even 4 (ev_SS 2 (ev_SS 0 ev_0)).

Definition ex_ev_Sn : ex (fun n => even (S n)) :=
  ex_intro (fun n => even (S n)) 1 (ev_SS 0 ev_0).

Inductive True : Prop :=
  | I : True.

Inductive False : Prop := .

End Props.

Module MyEquality.

Check eq.

Inductive eq {X:Type} : X -> X -> Prop :=
| eq_refl : forall x, eq x x.

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

Lemma four: 2 + 2 == 1 + 3.
Proof.
  apply eq_refl.
Qed.

Definition four' : 2 + 2 == 1 + 3 :=
  eq_refl 4.

Definition singleton : forall (X:Type) (x:X), []++[x] == x::[] :=
  fun (X:Type) (x:X) => eq_refl [x].

(*standard (equality__leibniz_equality)*)
Lemma equality__leibniz_equality : forall (X : Type) (x y: X),
  x == y -> forall P:X->Prop, P x -> P y.
Proof.
  intros X x y. intros. destruct H as [H1]. apply H0. Qed.
(*/standard (equality__leibniz_equality)*)

 (*standard, optional (leibniz_equality__equality)*)
Lemma leibniz_equality__equality : forall (X : Type) (x y: X),
  (forall P:X->Prop, P x -> P y) -> x == y.
Proof.
  intros X x y. intros. apply (H (eq x) (eq_refl x)). Qed.
 (*/standard, optional (leibniz_equality__equality)*)

End MyEquality.


Require Import Reals.
Require Import Interval.Tactic.

Goal forall x, (1 <= x)%R -> (0 < x)%R.
Proof.
intros.
interval.
Qed.

Goal forall x, (1 <= x)%R -> (x <= x * x)%R.
Proof.
intros.
apply Rminus_le.
interval with (i_autodiff x, i_prec 10).
Qed.

Goal forall x, (2 <= x)%R -> (x < x * x)%R.
Proof.
intros.
apply Rminus_lt.
interval with (i_autodiff x).
Qed.

Goal forall x, (-1 <= x)%R -> (x < 1 + powerRZ x 3)%R.
Proof.
intros.
apply Rminus_lt.
interval with (i_bisect x, i_autodiff x).
Qed.


Require Import Arith.

Fixpoint two_power (n:nat) : nat :=
  match n with
  | O => 1
  | S p => 2 * two_power p
  end.

Eval compute in (two_power 5).


(** Examples with Standard Library's vectors  *)
(**

Keywords : vectors, dependent types, dependent elimination *)

Require Import Bool Arith Vector.
Import VectorNotations.

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

(** A known problem ... *)

Fail
Lemma app_assoc {d e f:nat} {A: Type} :
  forall (u: t A d)( v : t A e) (w: t A f),
    (u ++ v) ++ w =  u ++ (v ++ w).

(* So, let us define an equivalence relation *)

Definition equiv {A} {n p : nat} (v: t A n) (w: t A p) :=
  to_list v = to_list w.

Infix "==" := equiv (at level 70) : type_scope.

Lemma app_assoc {d e f:nat} {A: Type} :
  forall (u: t A d)( v : t A e) (w: t A f),
    (u ++ v) ++ w ==  u ++ (v ++ w).
Proof.
Admitted.

(** Plesae define a "cast" of the following type *)

Definition cast {A:Type}{n:nat}(v : t A n) : forall n', n = n' -> t A n'.
Admitted. (* replace with "Defined" *)

(** cast's is correct (w.r.t equiv) *)

Lemma equiv_cast : forall (A:Type) n (v : t A n) n' (e: n = n'),
    v == cast v n' e.
Proof.
Admitted.

(** equivalence is (almost) equality *)

Lemma equiv_eq {A : Type}  : forall n (v w : t A n),
     v == w -> v = w.
Proof.
Admitted.

Lemma cast_eq {A} {n p} (v : t A n) (w : t A p) (e : n = p):
   v == w -> w = cast v p e.
Proof.
Admitted.

(** What is the problem with the following definition ? *)

Definition add_r {A} n a (v : t A n) : t A (S n) :=
  cast (v ++ [a]) _ (Nat.add_1_r n).

Compute add_r _ 7 [1;2;3].

(** Please give an alternate definition of add_r which has a correct behaviour
   (see below) *)

(*

About add_r'.

add_r' : forall (A : Type) (n : nat), A -> t A n -> t A (S n)

Argument A is implicit and maximally inserted
Argument scopes are [type_scope nat_scope _ _]
add_r' is transparent

Compute add_r' _ 7 [1;2;3].

  = [1; 2; 3; 7]
     : t nat 4

*)


(* We consider the discrete plan the coordinate system of which
    is based on Z *)
Require Import List  ZArith  Bool.
Open Scope Z_scope.
Require Import Relations  Setoid  Morphisms  RelationClasses.
Require Import EMonoid.
Require Import Lia.

(** Types for representing routes in the dicrete  plane *)

Inductive direction : Type := North | East | South | West.
Definition route := list direction.

Record Point : Type :=
 {Point_x : Z;
  Point_y : Z}.

Definition Point_O := Build_Point 0 0.

Definition translate (dx dy:Z) (P : Point) :=
  Build_Point (Point_x P + dx) (Point_y P + dy).

(** Equality test  between Points *)

Definition Point_eqb (P P':Point) :=
   Zeq_bool (Point_x P) (Point_x P') &&
   Zeq_bool (Point_y P) (Point_y P').

(* Prove the correctness of Point_eqb *)

Lemma Point_eqb_correct : forall p p', Point_eqb p p' = true <->
                                       p = p'.
Proof.
 destruct p;destruct p';simpl;split.
 -  unfold Point_eqb; simpl; rewrite andb_true_iff; destruct 1.
    repeat rewrite <- Zeq_is_eq_bool in *.
    now  rewrite H, H0.
 -  injection 1;intros H0 H1;rewrite H0, H1; unfold Point_eqb; simpl;
    rewrite andb_true_iff;repeat rewrite <- Zeq_is_eq_bool; now split.
Qed.

(**  (move P r) follows the route r starting from P *)

Fixpoint move (r:route) (P:Point) : Point :=
 match r with
 | nil => P
 | North :: r' => move r' (translate 0 1 P)
 | East :: r' => move r' (translate 1 0 P)
 | South :: r' => move r' (translate 0 (-1) P)
 | West :: r' => move r' (translate (-1) 0 P)
 end.

(**  We consider that two routes are "equivalent" if they define
  the same moves. For instance, the routes
  East::North::West::South::East::nil and East::nil are equivalent *)

Definition route_equiv : relation route :=
  fun r r' => forall P:Point , move r P = move  r' P.

Infix "=r=" := route_equiv (at level 70):type_scope.

Example Ex1 : East::North::West::South::East::nil =r= East::nil.
Proof.
 intro P;destruct P;simpl; unfold route_equiv, translate;simpl;f_equal; ring.
Qed.

Lemma route_equiv_refl : reflexive _ route_equiv.
Proof.  intros r p;reflexivity. Qed.

Lemma route_equiv_sym : symmetric _ route_equiv.
Proof.  intros r r' H p; symmetry;apply H. Qed.

Lemma route_equiv_trans : transitive _ route_equiv.
Proof.  intros r r' r'' H H' p; rewrite H; apply H'. Qed.

#[local] Instance route_equiv_Equiv : Equivalence  route_equiv.
Proof.
  split;
    [apply route_equiv_refl | apply route_equiv_sym |
      apply route_equiv_trans].
Qed.

(* Cons and app are Proper functions w.r.t. route_equiv *)

Lemma route_cons : forall r r' d, r =r= r' -> d::r =r= d::r'.
Proof.
 intros r r' d H P;destruct d;simpl;rewrite H;reflexivity.
Qed.

Example Ex2 :  South::East::North::West::South::East::nil =r= South::East::nil.
Proof. apply route_cons;apply Ex1. Qed.

#[local] Instance cons_route_Proper (d:direction):
    Proper (route_equiv ==> route_equiv) (cons d) .
Proof.
 intros r r' H ; now apply route_cons.
Qed.

(**  cons_route_Proper allows to replace a route with an =r= equivalent one
     in a context composed by "cons" *)

Example SW : forall r r', r =r= r' ->
                  South::West::r =r= South::West::r'.
Proof.
 intros r r' H; now rewrite H.
Qed.

#[local] Instance move_Proper  :
  Proper (route_equiv ==> @eq Point ==> @eq Point) move .
Proof.
 intros r r' Hr_r' p q Hpq; rewrite Hpq; apply Hr_r'.
Qed.

Example length_not_Proper : ~Proper (route_equiv ==> @eq nat) (@length _).
Proof.
 intro H; generalize (H (North::South::nil) nil);simpl;intro H0.
 discriminate H0.
 -  intro P;destruct P; simpl;unfold translate; simpl;f_equal;simpl;ring.
Qed.

Lemma route_compose : forall r r' P, move (r++r') P = move r' (move r P).
Proof.
 induction r as [|d s IHs]; simpl;
 [auto | destruct d; intros;rewrite IHs;auto].
Qed.

#[local] Instance app_route_Proper :
  Proper (route_equiv==>route_equiv ==> route_equiv)
    (@app direction).
Proof.
 intros r r' H r'' r''' H' P.
 repeat rewrite route_compose; rewrite H, H';reflexivity.
Qed.

Example Ex3 : forall r, North::East::South::West::r =r= r.
Proof.
 intros r P;destruct P;simpl;
  unfold route_equiv, translate;simpl;do 2 f_equal;ring.
Qed.

Example Ex4 : forall r r', r =r= r' ->
                North::East::South::West::r =r= r'.
Proof. intros r r' H. now rewrite Ex3. Qed.

Example Ex5 : forall r r',  r++ North::East::South::West::r' =r= r++r'.
Proof. intros r r'; now rewrite Ex3. Qed.

Lemma translate_comm : forall dx dy dx' dy' P,
    translate dx dy (translate dx' dy' P) =
    translate dx' dy' (translate dx dy P).
Proof.
  unfold translate; simpl; intros; f_equal; ring.
 Qed.

Lemma move_translate : forall r P dx dy , move r (translate dx dy P) =
                                                translate dx dy (move r P).
Proof.
 induction r as [|a r];simpl;[reflexivity|].
 destruct a;simpl; intros;rewrite <- IHr;rewrite  (translate_comm );auto.
Qed.

Lemma move_comm : forall r r' P  , move r (move r' P)  =
                                   move r' (move r P) .
Proof.
induction r as [| a r'];[reflexivity|].
- simpl;destruct a;
 intros;repeat rewrite move_translate;rewrite IHr';auto.
Qed.

Lemma app_comm : forall r r', r++r' =r=  r'++r.
Proof.
 intros r r' P;repeat rewrite route_compose; apply move_comm.
Qed.

(** the following lemma  will be used for deciding route equivalence *)

Lemma route_equiv_Origin : forall r r', r =r= r' <->
                                        move r Point_O  = move r' Point_O .
Proof.
split;intro H.
- now rewrite H.
- intro P;replace P with (translate (Point_x P) (Point_y P) Point_O).
 +   repeat rewrite move_translate.
     rewrite H;reflexivity.
 + destruct P;simpl;unfold translate;f_equal.
Qed.

Definition route_eqb r r' : bool :=
   Point_eqb (move r Point_O) (move r' Point_O).

(**  ... we can now prove route_eqb's  correctness *)

Lemma route_equiv_equivb : forall r r', route_equiv r r' <->
                                        route_eqb r r' = true.
Proof.
 intros r r' ; rewrite route_equiv_Origin;
 unfold route_eqb;rewrite Point_eqb_correct;tauto.
Qed.

Ltac route_eq_tac := rewrite route_equiv_equivb;reflexivity.

(** another proof of Ex1, using computation  *)

Example Ex1' : East::North::West::South::East::nil =r= East::nil.
Proof. route_eq_tac. Qed.

Lemma north_south_0 : forall r, North::South::r =r=  r.
Proof.
 intro r; change ((North::South::nil)++ r =r=  r).
 setoid_replace (North :: South :: nil) with  (@nil direction);
  [reflexivity |route_eq_tac ].
Qed.

Lemma north_south_simpl : forall r r', r++ North::South::r' =r=  r++r'.
Proof.
 induction r as [|a r'];simpl.
 -  intro r';rewrite north_south_0;reflexivity.
 -  intros r1;now rewrite IHr' .
Qed.

(* we want to prove that, if some route contains two steps in opposite
   directions, then the route can be shortened *)

Definition opposite (d d':direction):= match d,d' with
        | North,South => True
        | South, North => True
        | East, West => True
        | West, East => True
        | _, _ => False
end.

Inductive  Useless_steps_in (r:route) : Type :=
Useless_i: forall r0 r1 r2 d d1,  r = r0++(d::r1)++(d1::r2) ->
                                  opposite d d1 ->
                                  Useless_steps_in r.

Lemma opposite_cons : forall d d1 r, opposite d d1 -> d1::d::r =r= r.
Proof.
 intros d d1 r H;destruct d,d1;simpl ;try contradiction ;
 intro P;destruct P;simpl;auto; unfold translate;simpl; repeat f_equal;ring.
Qed.

Lemma cons2_comm : forall d d' r, d::d'::r =r= d'::d::r.
Proof.
 intros d d' r; change ((d::nil)++(d'::nil)++r =r= (d'::nil)++(d::nil)++r).
 do 2  rewrite <- app_ass.
 rewrite (app_comm  (d :: nil) (d'::nil));reflexivity.
Qed.

Lemma Useless_steps_shorter (r:route) :
  Useless_steps_in r -> {r' : route | r =r= r' /\ (length r' < length r)%nat}.
Proof.
 intro H;destruct H as [r0 r1 r2 d d1 H1 H2].
 exists (r0 ++ r1 ++ r2).
 split.
 -  subst r; replace (r0 ++ (d :: r1) ++ d1 :: r2) with
         (r0 ++ ((d::nil) ++ r1) ++ ((d1::nil)++r2))  by (simpl;auto).
     apply app_route_Proper;[reflexivity|].
     rewrite <- app_ass.
     apply app_route_Proper;[|reflexivity].
     transitivity ((d1::nil)++(d::r1)).
     rewrite app_comm; reflexivity.
      simpl;rewrite opposite_cons;[reflexivity|trivial].
 -  subst r; repeat (simpl;repeat  rewrite app_length); lia.
Qed.

(** Monoid structure on routes *)

#[local] Instance Route : EMonoid route_equiv (@app _)  nil .
Proof.
split.
- apply route_equiv_Equiv.
- apply app_route_Proper.
- intros x y z P;repeat rewrite  route_compose; trivial.
-  intros x  P;repeat rewrite  route_compose; trivial.
- intros x  P;repeat rewrite  route_compose; trivial.
Qed.

Example Ex6 : forall n, Epower (South::North::nil) n =r= nil.
Proof.
 induction n as [| p IHp];simpl;[reflexivity|].
 rewrite IHp; route_eq_tac.
Qed.

#[local] Instance AbelianRoute : Abelian_EMonoid Route.
  split;  apply app_comm.
Qed.


(** * Induction: Proof by Induction *)

(** Before getting started, we need to import all of our
    definitions from the previous chapter: *)

Require Export Basics.

(** For the [Require Export] to work, you first need to use
    [coqc] to compile [Basics.v] into [Basics.vo].  This is like
    making a .class file from a .java file, or a .o file from a .c
    file.  There are two ways to do it:

     - In CoqIDE:

         Open [Basics.v].  In the "Compile" menu, click on "Compile
         Buffer".

     - From the command line:

         [coqc Basics.v]

   If you have trouble (e.g., if you get complaints about missing
   identifiers later in the file), it may be because the "load path"
   for Coq is not set up correctly.  The [Print LoadPath.] command may
   be helpful in sorting out such issues. *)

(* ################################################################# *)
(** * Proof by Induction *)

(** We proved in the last chapter that [0] is a neutral element
    for [+] on the left, using an easy argument based on
    simplification.  We also observed that proving the fact that it is
    also a neutral element on the _right_... *)

Theorem plus_n_O_firsttry : forall n:nat,
  n = n + 0.

(** ... can't be done in the same simple way.  Just applying
  [reflexivity] doesn't work, since the [n] in [n + 0] is an arbitrary
  unknown number, so the [match] in the definition of [+] can't be
  simplified.  *)

Proof.
  intros n.
  simpl. (* Does nothing! *)
Abort.

(** And reasoning by cases using [destruct n] doesn't get us much
    further: the branch of the case analysis where we assume [n = 0]
    goes through fine, but in the branch where [n = S n'] for some [n'] we
    get stuck in exactly the same way. *)

Theorem plus_n_O_secondtry : forall n:nat,
  n = n + 0.
Proof.
  intros n. destruct n as [| n'].
  - (* n = 0 *)
    reflexivity. (* so far so good... *)
  - (* n = S n' *)
    simpl.       (* ...but here we are stuck again *)
Abort.

(** We could use [destruct n'] to get one step further, but,
    since [n] can be arbitrarily large, if we just go on like this
    we'll never finish. *)

(** To prove interesting facts about numbers, lists, and other
    inductively defined sets, we usually need a more powerful
    reasoning principle: _induction_.

    Recall (from high school, a discrete math course, etc.) the
    _principle of induction over 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, for any [n'], if [P(n')] holds, then so does
           [P(S n')];
         - conclude that [P(n)] holds for all [n].

    In Coq, the steps are the same: we begin with the goal of proving
    [P(n)] for all [n] and break it down (by applying the [induction]
    tactic) into two separate subgoals: one where we must show [P(O)]
    and another where we must show [P(n') -> P(S n')].  Here's how
    this works for the theorem at hand: *)

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

(** Like [destruct], the [induction] tactic takes an [as...]
    clause that specifies the names of the variables to be introduced
    in the subgoals.  Since there are two subgoals, the [as...] clause
    has two parts, separated by [|].  (Strictly speaking, we can omit
    the [as...] clause and Coq will choose names for us.  In practice,
    this is a bad idea, as Coq's automatic choices tend to be
    confusing.)

    In the first subgoal, [n] is replaced by [0].  No new variables
    are introduced (so the first part of the [as...] is empty), and
    the goal becomes [0 + 0 = 0], which follows by simplification.

    In the second subgoal, [n] is replaced by [S n'], and the
    assumption [n' + 0 = n'] is added to the context with the name
    [IHn'] (i.e., the Induction Hypothesis for [n']).  These two names
    are specified in the second part of the [as...] clause.  The goal
    in this case becomes [(S n') + 0 = S n'], which simplifies to
    [S (n' + 0) = S n'], which in turn follows from [IHn']. *)

Theorem minus_diag : forall n,
  minus n n = 0.
Proof.
  (* WORKED IN CLASS *)
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *)
    simpl. reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity.  Qed.

(** (The use of the [intros] tactic in these proofs is actually
    redundant.  When applied to a goal that contains quantified
    variables, the [induction] tactic will automatically move them
    into the context as needed.) *)

(** **** Exercise: 2 stars, recommended (basic_induction)  *)
(** Prove the following using induction. You might need previously
    proven results. *)

Theorem mult_0_r : forall n:nat,
  n * 0 = 0.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem plus_n_Sm : forall n m : nat,
  S (n + m) = n + (S m).
Proof.
  (* FILL IN HERE *) Admitted.

Theorem plus_comm : forall n m : nat,
  n + m = m + n.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem plus_assoc : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars (double_plus)  *)
(** Consider the following function, which doubles its argument: *)

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

(** Use induction to prove this simple fact about [double]: *)

Lemma double_plus : forall n, double n = n + n .
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional (evenb_S)  *)
(** One inconveninent aspect of our definition of [evenb n] is the
    recursive call on [n - 2]. This makes proofs about [evenb n]
    harder when done by induction on [n], since we may need an
    induction hypothesis about [n - 2]. The following lemma gives an
    alternative characterization of [evenb (S n)] that works better
    with induction: *)

Theorem evenb_S : forall n : nat,
  evenb (S n) = negb (evenb n).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 1 star (destruct_induction)  *)
(** Briefly explain the difference between the tactics [destruct]
    and [induction].

(* FILL IN HERE *)
*)
(** [] *)

(* ################################################################# *)
(** * Proofs Within Proofs *)

(** In Coq, as in informal mathematics, large proofs are often
    broken into a sequence of theorems, with later proofs referring to
    earlier theorems.  But sometimes a proof will require some
    miscellaneous fact that is too trivial and of too little general
    interest to bother giving it its own top-level name.  In such
    cases, it is convenient to be able to simply state and prove the
    needed "sub-theorem" right at the point where it is used.  The
    [assert] tactic allows us to do this.  For example, our earlier
    proof of the [mult_0_plus] theorem referred to a previous theorem
    named [plus_O_n].  We could instead use [assert] to state and
    prove [plus_O_n] in-line: *)

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

(** The [assert] tactic introduces two sub-goals.  The first is
    the assertion itself; by prefixing it with [H:] we name the
    assertion [H].  (We can also name the assertion with [as] just as
    we did above with [destruct] and [induction], i.e., [assert (0 + n
    = n) as H].)  Note that we surround the proof of this assertion
    with curly braces [{ ... }], both for readability and so that,
    when using Coq interactively, we can see more easily when we have
    finished this sub-proof.  The second goal is the same as the one
    at the point where we invoke [assert] except that, in the context,
    we now have the assumption [H] that [0 + n = n].  That is,
    [assert] generates one subgoal where we must prove the asserted
    fact and a second subgoal where we can use the asserted fact to
    make progress on whatever we were trying to prove in the first
    place. *)

(** Another example of [assert]... *)

(** For example, suppose we want to prove that [(n + m) + (p + q)
    = (m + n) + (p + q)]. The only difference between the two sides of
    the [=] is that the arguments [m] and [n] to the first inner [+]
    are swapped, so it seems we should be able to use the
    commutativity of addition ([plus_comm]) to rewrite one into the
    other.  However, the [rewrite] tactic is not very smart about
    _where_ it applies the rewrite.  There are three uses of [+] here,
    and it turns out that doing [rewrite -> plus_comm] will affect
    only the _outer_ one... *)

Theorem plus_rearrange_firsttry : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  (* We just need to swap (n + m) for (m + n)... seems
     like plus_comm should do the trick! *)
  rewrite -> plus_comm.
  (* Doesn't work...Coq rewrote the wrong plus! *)
Abort.

(** To use [plus_comm] at the point where we need it, we can introduce
    a local lemma stating that [n + m = m + n] (for the particular [m]
    and [n] that we are talking about here), prove this lemma using
    [plus_comm], and then use it to do the desired rewrite. *)

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

(* ################################################################# *)
(** * Formal vs. Informal Proof *)

(** "_Informal proofs are algorithms; formal proofs are code_." *)

(** What constitutes a successful proof of a mathematical claim?
    The question has challenged philosophers for millennia, but a
    rough and ready definition could be this: A proof of a
    mathematical proposition [P] is a written (or spoken) text that
    instills in the reader or hearer the certainty that [P] is true --
    an unassailable argument for the truth of [P].  That is, a proof
    is an act of communication.

    Acts of communication may involve different sorts of readers.  On
    one hand, the "reader" can be a program like Coq, in which case
    the "belief" that is instilled is that [P] can be mechanically
    derived from a certain set of formal logical rules, and the proof
    is a recipe that guides the program in checking this fact.  Such
    recipes are _formal_ proofs.

    Alternatively, the reader can be a human being, in which case the
    proof will be written in English or some other natural language,
    and will thus necessarily be _informal_.  Here, the criteria for
    success are less clearly specified.  A "valid" proof is one that
    makes the reader believe [P].  But the same proof may be read by
    many different readers, some of whom may be convinced by a
    particular way of phrasing the argument, while others may not be.
    Some readers may be particularly pedantic, inexperienced, or just
    plain thick-headed; the only way to convince them will be to make
    the argument in painstaking detail.  But other readers, more
    familiar in the area, may find all this detail so overwhelming
    that they lose the overall thread; all they want is to be told the
    main ideas, since it is easier for them to fill in the details for
    themselves than to wade through a written presentation of them.
    Ultimately, there is no universal standard, because there is no
    single way of writing an informal proof that is guaranteed to
    convince every conceivable reader.

    In practice, however, mathematicians have developed a rich set of
    conventions and idioms for writing about complex mathematical
    objects that -- at least within a certain community -- make
    communication fairly reliable.  The conventions of this stylized
    form of communication give a fairly clear standard for judging
    proofs good or bad.

    Because we are using Coq in this course, we will be working
    heavily with formal proofs.  But this doesn't mean we can
    completely forget about informal ones!  Formal proofs are useful
    in many ways, but they are _not_ very efficient ways of
    communicating ideas between human beings. *)

(** For example, here is a proof that addition is associative: *)

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

(** Coq is perfectly happy with this.  For a human, however, it
    is difficult to make much sense of it.  We can use comments and
    bullets to show the structure a little more clearly... *)

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

(** ... and if you're used to Coq you may be able to step
    through the tactics one after the other in your mind and imagine
    the state of the context and goal stack at each point, but if the
    proof were even a little bit more complicated this would be next
    to impossible.

    A (pedantic) mathematician might write the proof something like
    this: *)

(** - _Theorem_: For any [n], [m] and [p],

      n + (m + p) = (n + m) + p.

    _Proof_: By induction on [n].

    - First, suppose [n = 0].  We must show

        0 + (m + p) = (0 + m) + p.

      This follows directly from the definition of [+].

    - Next, suppose [n = S n'], where

        n' + (m + p) = (n' + m) + p.

      We must show

        (S n') + (m + p) = ((S n') + m) + p.

      By the definition of [+], this follows from

        S (n' + (m + p)) = S ((n' + m) + p),

      which is immediate from the induction hypothesis.  _Qed_. *)

(** The overall form of the proof is basically similar, and of
    course this is no accident: Coq has been designed so that its
    [induction] tactic generates the same sub-goals, in the same
    order, as the bullet points that a mathematician would write.  But
    there are significant differences of detail: the formal proof is
    much more explicit in some ways (e.g., the use of [reflexivity])
    but much less explicit in others (in particular, the "proof state"
    at any given point in the Coq proof is completely implicit,
    whereas the informal proof reminds the reader several times where
    things stand). *)

(** **** Exercise: 2 stars, advanced, recommended (plus_comm_informal)  *)
(** Translate your solution for [plus_comm] into an informal proof:

    Theorem: Addition is commutative.

    Proof: (* FILL IN HERE *)
*)
(** [] *)

(** **** Exercise: 2 stars, optional (beq_nat_refl_informal)  *)
(** Write an informal proof of the following theorem, using the
    informal proof of [plus_assoc] as a model.  Don't just
    paraphrase the Coq tactics into English!

    Theorem: [true = beq_nat n n] for any [n].

    Proof: (* FILL IN HERE *)
[] *)

(* ################################################################# *)
(** * More Exercises *)

(** **** Exercise: 3 stars, recommended (mult_comm)  *)
(** Use [assert] to help prove this theorem.  You shouldn't need to
    use induction on [plus_swap]. *)

Theorem plus_swap : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  (* FILL IN HERE *) Admitted.

(** Now prove commutativity of multiplication.  (You will probably
    need to define and prove a separate subsidiary theorem to be used
    in the proof of this one.  You may find that [plus_swap] comes in
    handy.) *)

Theorem mult_comm : forall m n : nat,
  m * n = n * m.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars, optional (more_exercises)  *)
(** Take a piece of paper.  For each of the following theorems, first
    _think_ about whether (a) it can be proved using only
    simplification and rewriting, (b) it also requires case
    analysis ([destruct]), or (c) it also requires induction.  Write
    down your prediction.  Then fill in the proof.  (There is no need
    to turn in your piece of paper; this is just to encourage you to
    reflect before you hack!) *)

Theorem leb_refl : forall n:nat,
  true = leb n n.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem zero_nbeq_S : forall n:nat,
  beq_nat 0 (S n) = false.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem andb_false_r : forall b : bool,
  andb b false = false.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem plus_ble_compat_l : forall n m p : nat,
  leb n m = true -> leb (p + n) (p + m) = true.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem S_nbeq_0 : forall n:nat,
  beq_nat (S n) 0 = false.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem mult_1_l : forall n:nat, 1 * n = n.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem all3_spec : forall b c : bool,
    orb
      (andb b c)
      (orb (negb b)
               (negb c))
  = true.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem mult_plus_distr_r : forall n m p : nat,
  (n + m) * p = (n * p) + (m * p).
Proof.
  (* FILL IN HERE *) Admitted.

Theorem mult_assoc : forall n m p : nat,
  n * (m * p) = (n * m) * p.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional (beq_nat_refl)  *)
(** Prove the following theorem.  (Putting the [true] on the left-hand
    side of the equality may look odd, but this is how the theorem is
    stated in the Coq standard library, so we follow suit.  Rewriting
    works equally well in either direction, so we will have no problem
    using the theorem no matter which way we state it.) *)

Theorem beq_nat_refl : forall n : nat,
  true = beq_nat n n.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional (plus_swap')  *)
(** The [replace] tactic allows you to specify a particular subterm to
   rewrite and what you want it rewritten to: [replace (t) with (u)]
   replaces (all copies of) expression [t] in the goal by expression
   [u], and generates [t = u] as an additional subgoal. This is often
   useful when a plain [rewrite] acts on the wrong part of the goal.

   Use the [replace] tactic to do a proof of [plus_swap'], just like
   [plus_swap] but without needing [assert (n + m = m + n)]. *)

Theorem plus_swap' : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars, recommended (binary_commute)  *)
(** Recall the [incr] and [bin_to_nat] functions that you
    wrote for the [binary] exercise in the [Basics] chapter.  Prove
    that the following diagram commutes:

                            incr
              bin ----------------------> bin
               |                           |
    bin_to_nat |                           |  bin_to_nat
               |                           |
               v                           v
              nat ----------------------> nat
                             S

    That is, incrementing a binary number and then converting it to
    a (unary) natural number yields the same result as first converting
    it to a natural number and then incrementing.
    Name your theorem [bin_to_nat_pres_incr] ("pres" for "preserves").

    Before you start working on this exercise, copy the definitions
    from your solution to the [binary] exercise here so that this file
    can be graded on its own.  If you want to change your original
    definitions to make the property easier to prove, feel free to
    do so! *)

(* FILL IN HERE *)
(** [] *)

(** **** Exercise: 5 stars, advanced (binary_inverse)  *)
(** This exercise is a continuation of the previous exercise about
    binary numbers.  You will need your definitions and theorems from
    there to complete this one; please copy them to this file to make
    it self contained for grading.

    (a) First, write a function to convert natural numbers to binary
        numbers.  Then prove that starting with any natural number,
        converting to binary, then converting back yields the same
        natural number you started with.

    (b) You might naturally think that we should also prove the
        opposite direction: that starting with a binary number,
        converting to a natural, and then back to binary yields the
        same number we started with.  However, this is not true!
        Explain what the problem is.

    (c) Define a "direct" normalization function -- i.e., a function
        [normalize] from binary numbers to binary numbers such that,
        for any binary number b, converting to a natural and then back
        to binary yields [(normalize b)].  Prove it.  (Warning: This
        part is tricky!)

    Again, feel free to change your earlier definitions if this helps
    here. *)

(* FILL IN HERE *)
(** [] *)

(** $Date: 2016-09-10 06:26:08 +0900 (2016年09月10日 (土)) $ *)


Require Import RelationClasses.
Require Import Relations Morphisms.
Require Import String.

Set Implicit Arguments.

(** ** The [Monoid] type class (with Operational Type Classes) *)

Declare Scope M_scope.

(* begin snippet MultOpClass *)
Class Mult_op (A:Type) := mult_op : A -> A -> A.

Print Mult_op.
(* end snippet MultOpClass *)

Print mult_op.

(* begin snippet MultOpEq:: no-out *)

Goal forall A (op: Mult_op A), @mult_op A op = op.
reflexivity.
Qed.
(* end snippet MultOpEq *)

(* begin snippet MultOpInfix *)
Delimit Scope M_scope with M.
Infix "*" := mult_op : M_scope.
Open Scope M_scope.
(* end snippet MultOpInfix *)

(* begin snippet DemoNatMulta *)

Module Demo.

  #[local] Instance nat_mult_op : Mult_op nat := Nat.mul.
  (* end snippet DemoNatMulta *)

(* begin snippet DemoNatMultb *)
  Set Printing All.

  Check 3 * 4.

   Unset Printing All.

   Compute 3 * 4.

End Demo.
(* end snippet DemoNatMultb *)

(* begin snippet DemoStringMult:: no-out *)

#[ global ] Instance string_op : Mult_op string := append.
Open Scope string_scope.

Example ex_string : "ab" * "cde" = "abcde".
Proof. reflexivity. Qed.

(* end snippet DemoStringMult *)

#[ global ] Instance bool_and_binop : Mult_op bool := andb.

Example ex_bool : true * false = false.
Proof. reflexivity. Qed.

(*

mult_op : forall (A : Type) (_ : Mult_op A) (_ : A) (_ : A), A

Arguments A, Mult_op are implicit and maximally inserted
*)
(** within M_scope, a term of the form (x * y) is an abbreviation of
(mult_op A op x y) where op : Mult_op A and x, y : A.
*)

(* begin snippet MonoidClass *)
Class Monoid {A:Type}(op : Mult_op A)(one : A) : Prop :=
{
    op_assoc : forall x y z, x * (y * z) = x * y * z;
    one_left : forall x, one * x = x;
    one_right : forall x, x * one = x
}.
(* end snippet MonoidClass *)

(** *** Exercice

Define a class for semi-groups, and re-define monoids as semi-groups with a neutral element

*)

(** *** Monoids and Equivalence Relations

In some situations, the previous definition may be too restrictive.
For instance, consider the computation of  $x^n \mod{m}$ where
$x$ and $m$ are positive integers, and $1<m$.

Although it could possible to compute with values of the dependent
type %\linebreak% [{n:N | n < m}], it looks simpler to compute with numbers of type
[N], and consider the multiplication $x \times y \mod{m}$.

It is easy to prove that this operation is associative, using library
 %\texttt{NArith}%. Unfortunately, it is not possible to prove the
following proposition,
required for building an instance of [Monoid]:

[[
forall x:N, 1 * x  mod m = x.
]]

Thus, we define a more general class, parameterized by an equivalence
relation [Aeq] on type [A], compatible with the multiplication $\bullet$.
The laws of associativity and neutral element
are not expressed as Leibniz equalities but as equivalence statements:
*)

(* begin snippet EquivDef *)
Class Equiv A := equiv : relation A.

Infix "==" := equiv (at level 70) : type_scope.
(* end snippet EquivDef *)

(*
equiv : forall A : Type, Equiv A -> relation A
*)
(* begin snippet EMonoidDef *)

Class EMonoid (A:Type)(E_op : Mult_op A)(E_one : A)
      (E_eq: Equiv A): Prop :=
  {
    Eq_equiv :> Equivalence equiv;
    Eop_proper : Proper (equiv ==> equiv ==> equiv) E_op;
    Eop_assoc : forall x y z, x * (y * z) == x * y * z;
    Eone_left : forall x,  E_one * x == x;
    Eone_right : forall x,  x * E_one ==  x
  }.
(* end snippet EMonoidDef *)

#[ global ] Instance Equiv_Equiv (A:Type)(E_op : Mult_op A)(E_one : A)
      (E_eq: Equiv A)(M :EMonoid E_op E_one E_eq) :
   Equivalence E_eq.
destruct M;auto.
Qed.

#[ global ] Instance Equiv_Refl (A:Type)(E_op : Mult_op A)(E_one : A)
      (E_eq: Equiv A)(M :EMonoid E_op E_one E_eq) :
   Reflexive E_eq.
destruct (Equiv_Equiv   M);auto.
Qed.

#[ global ] Instance Equiv_Sym (A:Type)(E_op : Mult_op A)(E_one : A)
      (E_eq: Equiv A)(M :EMonoid E_op E_one E_eq) :
   Symmetric E_eq.
destruct (Equiv_Equiv   M);auto.
Qed.

#[ global ] Instance Equiv_Trans (A:Type)(E_op : Mult_op A)(E_one : A)
      (E_eq: Equiv A)(M :EMonoid E_op E_one E_eq) :
   Transitive E_eq.
destruct (Equiv_Equiv   M);auto.
Qed.

Generalizable All Variables.

(** *** Coercion from Monoid to EMonoid

Every instance of class  [Monoid] can be transformed into an instance of
[EMonoid], considering Leibniz' equality [eq].
*)

(* begin snippet Coerciona:: no-out  *)
#[global] Instance eq_equiv {A} : Equiv A := eq.

#[global] Instance Monoid_EMonoid `(M:@Monoid A op one) :
        EMonoid  op one eq_equiv.
Proof.
split; unfold eq_equiv, equiv in *.
 - apply eq_equivalence.
 - intros x y H z t H0;  now subst.
 - intros;now rewrite (op_assoc).
 - intro; now rewrite one_left.
 - intro;now rewrite one_right.
Qed.
(* end snippet Coerciona  *)

(** We can now register [Monoid_EMonoid] as a _coercion_:
*)

(* begin snippet Coercionb:: no-out  *)
Coercion Monoid_EMonoid : Monoid >-> EMonoid.
(* end snippet Coercionb  *)

(** *** Commutative Monoids

The following type class definitions allow to take advantage of
  the possible commutativity of the $\bullet$ operation

*)

Class Abelian_EMonoid `(M:@EMonoid A op one Aeq ):= {
  Eop_comm : forall x y, op x  y ==  op y  x}.

Class Abelian_Monoid `(M:Monoid ):= {
  op_comm : forall x y, op x  y = op y  x}.

Ltac add_op_proper M H :=
 let h := fresh H in
   generalize (@Eop_proper _ _ _ _ M); intro h.


(************************************************************************)
(*         *   The Coq Proof Assistant / The Coq Development Team       *)
(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
(* <O___,, *       (see CREDITS file for the list of authors)           *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)

Require Import ZAxioms ZMulOrder ZSgnAbs NZDiv.

(** * Euclidean Division for integers (Trunc convention)

    We use here the convention known as Trunc, or Round-Toward-Zero,
    where [a/b] is the integer with the largest absolute value to
    be between zero and the exact fraction. It can be summarized by:

    [a = bq+r /\ 0 <= |r| < |b| /\ Sign(r) = Sign(a)]

    This is the convention of Ocaml and many other systems (C, ASM, ...).
    This convention is named "T" in the following paper:

    R. Boute, "The Euclidean definition of the functions div and mod",
    ACM Transactions on Programming Languages and Systems,
    Vol. 14, No.2, pp. 127-144, April 1992.

    See files [ZDivFloor] and [ZDivEucl] for others conventions.
*)

Module Type ZQuotProp
 (Import A : ZAxiomsSig')
 (Import B : ZMulOrderProp A)
 (Import C : ZSgnAbsProp A B).

(** We benefit from what already exists for NZ *)

 Module Import Private_Div.
 Module Quot2Div <: NZDiv A.
  Definition div := quot.
  Definition modulo := A.rem.
  Definition div_wd := quot_wd.
  Definition mod_wd := rem_wd.
  Definition div_mod := quot_rem.
  Definition mod_bound_pos := rem_bound_pos.
 End Quot2Div.
 Module NZQuot := Nop <+ NZDivProp A Quot2Div B.
 End Private_Div.

Ltac pos_or_neg a :=
 let LT := fresh "LT" in
 let LE := fresh "LE" in
 destruct (le_gt_cases 0 a) as [LE|LT]; [|rewrite <- opp_pos_neg in LT].

(** Another formulation of the main equation *)

Lemma rem_eq :
 forall a b, b~=0 -> a rem b == a - b*(a÷b).
Proof.
intros.
rewrite <- add_move_l.
symmetry. now apply quot_rem.
Qed.

(** A few sign rules (simple ones) *)

Lemma rem_opp_opp : forall a b, b ~= 0 -> (-a) rem (-b) == - (a rem b).
Proof. intros. now rewrite rem_opp_r, rem_opp_l. Qed.

Lemma quot_opp_l : forall a b, b ~= 0 -> (-a)÷b == -(a÷b).
Proof.
intros.
rewrite <- (mul_cancel_l _ _ b) by trivial.
rewrite <- (add_cancel_r _ _ ((-a) rem b)).
now rewrite <- quot_rem, rem_opp_l, mul_opp_r, <- opp_add_distr, <- quot_rem.
Qed.

Lemma quot_opp_r : forall a b, b ~= 0 -> a÷(-b) == -(a÷b).
Proof.
intros.
assert (-b ~= 0) by (now rewrite eq_opp_l, opp_0).
rewrite <- (mul_cancel_l _ _ (-b)) by trivial.
rewrite <- (add_cancel_r _ _ (a rem (-b))).
now rewrite <- quot_rem, rem_opp_r, mul_opp_opp, <- quot_rem.
Qed.

Lemma quot_opp_opp : forall a b, b ~= 0 -> (-a)÷(-b) == a÷b.
Proof. intros. now rewrite quot_opp_r, quot_opp_l, opp_involutive. Qed.

(** Uniqueness theorems *)

Theorem quot_rem_unique : forall b q1 q2 r1 r2 : t,
  (0<=r1<b \/ b<r1<=0) -> (0<=r2<b \/ b<r2<=0) ->
  b*q1+r1 == b*q2+r2 -> q1 == q2 /\ r1 == r2.
Proof.
intros b q1 q2 r1 r2 Hr1 Hr2 EQ.
destruct Hr1; destruct Hr2; try (intuition; order).
apply NZQuot.div_mod_unique with b; trivial.
rewrite <- (opp_inj_wd r1 r2).
apply NZQuot.div_mod_unique with (-b); trivial.
rewrite <- opp_lt_mono, opp_nonneg_nonpos; tauto.
rewrite <- opp_lt_mono, opp_nonneg_nonpos; tauto.
now rewrite 2 mul_opp_l, <- 2 opp_add_distr, opp_inj_wd.
Qed.

Theorem quot_unique:
 forall a b q r, 0<=a -> 0<=r<b -> a == b*q + r -> q == a÷b.
Proof. intros; now apply NZQuot.div_unique with r. Qed.

Theorem rem_unique:
 forall a b q r, 0<=a -> 0<=r<b -> a == b*q + r -> r == a rem b.
Proof. intros; now apply NZQuot.mod_unique with q. Qed.

(** A division by itself returns 1 *)

Lemma quot_same : forall a, a~=0 -> a÷a == 1.
Proof.
intros. pos_or_neg a. apply NZQuot.div_same; order.
rewrite <- quot_opp_opp by trivial. now apply NZQuot.div_same.
Qed.

Lemma rem_same : forall a, a~=0 -> a rem a == 0.
Proof.
intros. rewrite rem_eq, quot_same by trivial. nzsimpl. apply sub_diag.
Qed.

(** A division of a small number by a bigger one yields zero. *)

Theorem quot_small: forall a b, 0<=a<b -> a÷b == 0.
Proof. exact NZQuot.div_small. Qed.

(** Same situation, in term of remulo: *)

Theorem rem_small: forall a b, 0<=a<b -> a rem b == a.
Proof. exact NZQuot.mod_small. Qed.

(** * Basic values of divisions and modulo. *)

Lemma quot_0_l: forall a, a~=0 -> 0÷a == 0.
Proof.
intros. pos_or_neg a. apply NZQuot.div_0_l; order.
rewrite <- quot_opp_opp, opp_0 by trivial. now apply NZQuot.div_0_l.
Qed.

Lemma rem_0_l: forall a, a~=0 -> 0 rem a == 0.
Proof.
intros; rewrite rem_eq, quot_0_l; now nzsimpl.
Qed.

Lemma quot_1_r: forall a, a÷1 == a.
Proof.
intros. pos_or_neg a. now apply NZQuot.div_1_r.
apply opp_inj. rewrite <- quot_opp_l. apply NZQuot.div_1_r; order.
intro EQ; symmetry in EQ; revert EQ; apply lt_neq, lt_0_1.
Qed.

Lemma rem_1_r: forall a, a rem 1 == 0.
Proof.
intros. rewrite rem_eq, quot_1_r; nzsimpl; auto using sub_diag.
intro EQ; symmetry in EQ; revert EQ; apply lt_neq; apply lt_0_1.
Qed.

Lemma quot_1_l: forall a, 1<a -> 1÷a == 0.
Proof. exact NZQuot.div_1_l. Qed.

Lemma rem_1_l: forall a, 1<a -> 1 rem a == 1.
Proof. exact NZQuot.mod_1_l. Qed.

Lemma quot_mul : forall a b, b~=0 -> (a*b)÷b == a.
Proof.
intros. pos_or_neg a; pos_or_neg b. apply NZQuot.div_mul; order.
rewrite <- quot_opp_opp, <- mul_opp_r by order. apply NZQuot.div_mul; order.
rewrite <- opp_inj_wd, <- quot_opp_l, <- mul_opp_l by order.
apply NZQuot.div_mul; order.
rewrite <- opp_inj_wd, <- quot_opp_r, <- mul_opp_opp by order.
apply NZQuot.div_mul; order.
Qed.

Lemma rem_mul : forall a b, b~=0 -> (a*b) rem b == 0.
Proof.
intros. rewrite rem_eq, quot_mul by trivial. rewrite mul_comm; apply sub_diag.
Qed.

Theorem quot_unique_exact a b q: b~=0 -> a == b*q -> q == a÷b.
Proof.
 intros Hb H. rewrite H, mul_comm. symmetry. now apply quot_mul.
Qed.

(** The sign of [a rem b] is the one of [a] (when it's not null) *)

Lemma rem_nonneg : forall a b, b~=0 -> 0 <= a -> 0 <= a rem b.
Proof.
 intros. pos_or_neg b. destruct (rem_bound_pos a b); order.
 rewrite <- rem_opp_r; trivial.
 destruct (rem_bound_pos a (-b)); trivial.
Qed.

Lemma rem_nonpos : forall a b, b~=0 -> a <= 0 -> a rem b <= 0.
Proof.
 intros a b Hb Ha.
 apply opp_nonneg_nonpos. apply opp_nonneg_nonpos in Ha.
 rewrite <- rem_opp_l by trivial. now apply rem_nonneg.
Qed.

Lemma rem_sign_mul : forall a b, b~=0 -> 0 <= (a rem b) * a.
Proof.
intros a b Hb. destruct (le_ge_cases 0 a).
 apply mul_nonneg_nonneg; trivial. now apply rem_nonneg.
 apply mul_nonpos_nonpos; trivial. now apply rem_nonpos.
Qed.

Lemma rem_sign_nz : forall a b, b~=0 -> a rem b ~= 0 ->
 sgn (a rem b) == sgn a.
Proof.
intros a b Hb H. destruct (lt_trichotomy 0 a) as [LT|[EQ|LT]].
rewrite 2 sgn_pos; try easy.
 generalize (rem_nonneg a b Hb (lt_le_incl _ _ LT)). order.
now rewrite <- EQ, rem_0_l, sgn_0.
rewrite 2 sgn_neg; try easy.
 generalize (rem_nonpos a b Hb (lt_le_incl _ _ LT)). order.
Qed.

Lemma rem_sign : forall a b, a~=0 -> b~=0 -> sgn (a rem b) ~= -sgn a.
Proof.
intros a b Ha Hb H.
destruct (eq_decidable (a rem b) 0) as [EQ|NEQ].
apply Ha, sgn_null_iff, opp_inj. now rewrite <- H, opp_0, EQ, sgn_0.
apply Ha, sgn_null_iff. apply eq_mul_0_l with 2; try order'. nzsimpl'.
apply add_move_0_l. rewrite <- H. symmetry. now apply rem_sign_nz.
Qed.

(** Operations and absolute value *)

Lemma rem_abs_l : forall a b, b ~= 0 -> (abs a) rem b == abs (a rem b).
Proof.
intros a b Hb. destruct (le_ge_cases 0 a) as [LE|LE].
rewrite 2 abs_eq; try easy. now apply rem_nonneg.
rewrite 2 abs_neq, rem_opp_l; try easy. now apply rem_nonpos.
Qed.

Lemma rem_abs_r : forall a b, b ~= 0 -> a rem (abs b) == a rem b.
Proof.
intros a b Hb. destruct (le_ge_cases 0 b).
now rewrite abs_eq. now rewrite abs_neq, ?rem_opp_r.
Qed.

Lemma rem_abs : forall a b,  b ~= 0 -> (abs a) rem (abs b) == abs (a rem b).
Proof.
intros. now rewrite rem_abs_r, rem_abs_l.
Qed.

Lemma quot_abs_l : forall a b, b ~= 0 -> (abs a)÷b == (sgn a)*(a÷b).
Proof.
intros a b Hb. destruct (lt_trichotomy 0 a) as [LT|[EQ|LT]].
rewrite abs_eq, sgn_pos by order. now nzsimpl.
rewrite <- EQ, abs_0, quot_0_l; trivial. now nzsimpl.
rewrite abs_neq, quot_opp_l, sgn_neg by order.
 rewrite mul_opp_l. now nzsimpl.
Qed.

Lemma quot_abs_r : forall a b, b ~= 0 -> a÷(abs b) == (sgn b)*(a÷b).
Proof.
intros a b Hb. destruct (lt_trichotomy 0 b) as [LT|[EQ|LT]].
rewrite abs_eq, sgn_pos by order. now nzsimpl.
order.
rewrite abs_neq, quot_opp_r, sgn_neg by order.
 rewrite mul_opp_l. now nzsimpl.
Qed.

Lemma quot_abs : forall a b, b ~= 0 -> (abs a)÷(abs b) == abs (a÷b).
Proof.
intros a b Hb.
pos_or_neg a; [rewrite (abs_eq a)|rewrite (abs_neq a)];
 try apply opp_nonneg_nonpos; try order.
pos_or_neg b; [rewrite (abs_eq b)|rewrite (abs_neq b)];
 try apply opp_nonneg_nonpos; try order.
rewrite abs_eq; try easy. apply NZQuot.div_pos; order.
rewrite <- abs_opp, <- quot_opp_r, abs_eq; try easy.
 apply NZQuot.div_pos; order.
pos_or_neg b; [rewrite (abs_eq b)|rewrite (abs_neq b)];
 try apply opp_nonneg_nonpos; try order.
rewrite <- (abs_opp (_÷_)), <- quot_opp_l, abs_eq; try easy.
 apply NZQuot.div_pos; order.
rewrite <- (quot_opp_opp a b), abs_eq; try easy.
 apply NZQuot.div_pos; order.
Qed.

(** We have a general bound for absolute values *)

Lemma rem_bound_abs :
 forall a b, b~=0 -> abs (a rem b) < abs b.
Proof.
intros. rewrite <- rem_abs; trivial.
apply rem_bound_pos. apply abs_nonneg. now apply abs_pos.
Qed.

(** * Order results about rem and quot *)

(** A modulo cannot grow beyond its starting point. *)

Theorem rem_le: forall a b, 0<=a -> 0<b -> a rem b <= a.
Proof. exact NZQuot.mod_le. Qed.

Theorem quot_pos : forall a b, 0<=a -> 0<b -> 0<= a÷b.
Proof. exact NZQuot.div_pos. Qed.

Lemma quot_str_pos : forall a b, 0<b<=a -> 0 < a÷b.
Proof. exact NZQuot.div_str_pos. Qed.

Lemma quot_small_iff : forall a b, b~=0 -> (a÷b==0 <-> abs a < abs b).
Proof.
intros. pos_or_neg a; pos_or_neg b.
rewrite NZQuot.div_small_iff; try order. rewrite 2 abs_eq; intuition; order.
rewrite <- opp_inj_wd, opp_0, <- quot_opp_r, NZQuot.div_small_iff by order.
 rewrite (abs_eq a), (abs_neq' b); intuition; order.
rewrite <- opp_inj_wd, opp_0, <- quot_opp_l, NZQuot.div_small_iff by order.
 rewrite (abs_neq' a), (abs_eq b); intuition; order.
rewrite <- quot_opp_opp, NZQuot.div_small_iff by order.
 rewrite (abs_neq' a), (abs_neq' b); intuition; order.
Qed.

Lemma rem_small_iff : forall a b, b~=0 -> (a rem b == a <-> abs a < abs b).
Proof.
intros. rewrite rem_eq, <- quot_small_iff by order.
rewrite sub_move_r, <- (add_0_r a) at 1. rewrite add_cancel_l.
rewrite eq_sym_iff, eq_mul_0. tauto.
Qed.

(** As soon as the divisor is strictly greater than 1,
    the division is strictly decreasing. *)

Lemma quot_lt : forall a b, 0<a -> 1<b -> a÷b < a.
Proof. exact NZQuot.div_lt. Qed.

(** [le] is compatible with a positive division. *)

Lemma quot_le_mono : forall a b c, 0<c -> a<=b -> a÷c <= b÷c.
Proof.
intros. pos_or_neg a. apply NZQuot.div_le_mono; auto.
pos_or_neg b. apply le_trans with 0.
 rewrite <- opp_nonneg_nonpos, <- quot_opp_l by order.
 apply quot_pos; order.
 apply quot_pos; order.
rewrite opp_le_mono in *. rewrite <- 2 quot_opp_l by order.
 apply NZQuot.div_le_mono; intuition; order.
Qed.

(** With this choice of division,
    rounding of quot is always done toward zero: *)

Lemma mul_quot_le : forall a b, 0<=a -> b~=0 -> 0 <= b*(a÷b) <= a.
Proof.
intros. pos_or_neg b.
split.
apply mul_nonneg_nonneg; [|apply quot_pos]; order.
apply NZQuot.mul_div_le; order.
rewrite <- mul_opp_opp, <- quot_opp_r by order.
split.
apply mul_nonneg_nonneg; [|apply quot_pos]; order.
apply NZQuot.mul_div_le; order.
Qed.

Lemma mul_quot_ge : forall a b, a<=0 -> b~=0 -> a <= b*(a÷b) <= 0.
Proof.
intros.
rewrite <- opp_nonneg_nonpos, opp_le_mono, <-mul_opp_r, <-quot_opp_l by order.
rewrite <- opp_nonneg_nonpos in *.
destruct (mul_quot_le (-a) b); tauto.
Qed.

(** For positive numbers, considering [S (a÷b)] leads to an upper bound for [a] *)

Lemma mul_succ_quot_gt: forall a b, 0<=a -> 0<b -> a < b*(S (a÷b)).
Proof. exact NZQuot.mul_succ_div_gt. Qed.

(** Similar results with negative numbers *)

Lemma mul_pred_quot_lt: forall a b, a<=0 -> 0<b -> b*(P (a÷b)) < a.
Proof.
intros.
rewrite opp_lt_mono, <- mul_opp_r, opp_pred, <- quot_opp_l by order.
rewrite <- opp_nonneg_nonpos in *.
now apply mul_succ_quot_gt.
Qed.

Lemma mul_pred_quot_gt: forall a b, 0<=a -> b<0 -> a < b*(P (a÷b)).
Proof.
intros.
rewrite <- mul_opp_opp, opp_pred, <- quot_opp_r by order.
rewrite <- opp_pos_neg in *.
now apply mul_succ_quot_gt.
Qed.

Lemma mul_succ_quot_lt: forall a b, a<=0 -> b<0 -> b*(S (a÷b)) < a.
Proof.
intros.
rewrite opp_lt_mono, <- mul_opp_l, <- quot_opp_opp by order.
rewrite <- opp_nonneg_nonpos, <- opp_pos_neg in *.
now apply mul_succ_quot_gt.
Qed.

(** Inequality [mul_quot_le] is exact iff the modulo is zero. *)

Lemma quot_exact : forall a b, b~=0 -> (a == b*(a÷b) <-> a rem b == 0).
Proof.
intros. rewrite rem_eq by order. rewrite sub_move_r; nzsimpl; tauto.
Qed.

(** Some additional inequalities about quot. *)

Theorem quot_lt_upper_bound:
  forall a b q, 0<=a -> 0<b -> a < b*q -> a÷b < q.
Proof. exact NZQuot.div_lt_upper_bound. Qed.

Theorem quot_le_upper_bound:
  forall a b q, 0<b -> a <= b*q -> a÷b <= q.
Proof.
intros.
rewrite <- (quot_mul q b) by order.
apply quot_le_mono; trivial. now rewrite mul_comm.
Qed.

Theorem quot_le_lower_bound:
  forall a b q, 0<b -> b*q <= a -> q <= a÷b.
Proof.
intros.
rewrite <- (quot_mul q b) by order.
apply quot_le_mono; trivial. now rewrite mul_comm.
Qed.

(** A division respects opposite monotonicity for the divisor *)

Lemma quot_le_compat_l: forall p q r, 0<=p -> 0<q<=r -> p÷r <= p÷q.
Proof. exact NZQuot.div_le_compat_l. Qed.

(** * Relations between usual operations and rem and quot *)

(** Unlike with other division conventions, some results here aren't
    always valid, and need to be restricted. For instance
    [(a+b*c) rem c <> a rem c] for [a=9,b=-5,c=2] *)

Lemma rem_add : forall a b c, c~=0 -> 0 <= (a+b*c)*a ->
 (a + b * c) rem c == a rem c.
Proof.
assert (forall a b c, c~=0 -> 0<=a -> 0<=a+b*c -> (a+b*c) rem c == a rem c).
 intros. pos_or_neg c. apply NZQuot.mod_add; order.
 rewrite <- (rem_opp_r a), <- (rem_opp_r (a+b*c)) by order.
 rewrite <- mul_opp_opp in *.
 apply NZQuot.mod_add; order.
intros a b c Hc Habc.
destruct (le_0_mul _ _ Habc) as [(Habc',Ha)|(Habc',Ha)]. auto.
apply opp_inj. revert Ha Habc'.
rewrite <- 2 opp_nonneg_nonpos.
rewrite <- 2 rem_opp_l, opp_add_distr, <- mul_opp_l by order. auto.
Qed.

Lemma quot_add : forall a b c, c~=0 -> 0 <= (a+b*c)*a ->
 (a + b * c) ÷ c == a ÷ c + b.
Proof.
intros.
rewrite <- (mul_cancel_l _ _ c) by trivial.
rewrite <- (add_cancel_r _ _ ((a+b*c) rem c)).
rewrite <- quot_rem, rem_add by trivial.
now rewrite mul_add_distr_l, add_shuffle0, <-quot_rem, mul_comm.
Qed.

Lemma quot_add_l: forall a b c, b~=0 -> 0 <= (a*b+c)*c ->
 (a * b + c) ÷ b == a + c ÷ b.
Proof.
 intros a b c. rewrite add_comm, (add_comm a). now apply quot_add.
Qed.

(** Cancellations. *)

Lemma quot_mul_cancel_r : forall a b c, b~=0 -> c~=0 ->
 (a*c)÷(b*c) == a÷b.
Proof.
assert (Aux1 : forall a b c, 0<=a -> 0<b -> c~=0 -> (a*c)÷(b*c) == a÷b).
 intros. pos_or_neg c. apply NZQuot.div_mul_cancel_r; order.
 rewrite <- quot_opp_opp, <- 2 mul_opp_r. apply NZQuot.div_mul_cancel_r; order.
 rewrite <- neq_mul_0; intuition order.
assert (Aux2 : forall a b c, 0<=a -> b~=0 -> c~=0 -> (a*c)÷(b*c) == a÷b).
 intros. pos_or_neg b. apply Aux1; order.
 apply opp_inj. rewrite <- 2 quot_opp_r, <- mul_opp_l; try order. apply Aux1; order.
 rewrite <- neq_mul_0; intuition order.
intros. pos_or_neg a. apply Aux2; order.
apply opp_inj. rewrite <- 2 quot_opp_l, <- mul_opp_l; try order. apply Aux2; order.
rewrite <- neq_mul_0; intuition order.
Qed.

Lemma quot_mul_cancel_l : forall a b c, b~=0 -> c~=0 ->
 (c*a)÷(c*b) == a÷b.
Proof.
intros. rewrite !(mul_comm c); now apply quot_mul_cancel_r.
Qed.

Lemma mul_rem_distr_r: forall a b c, b~=0 -> c~=0 ->
  (a*c) rem (b*c) == (a rem b) * c.
Proof.
intros.
assert (b*c ~= 0) by (rewrite <- neq_mul_0; tauto).
rewrite ! rem_eq by trivial.
rewrite quot_mul_cancel_r by order.
now rewrite mul_sub_distr_r, <- !mul_assoc, (mul_comm (a÷b) c).
Qed.

Lemma mul_rem_distr_l: forall a b c, b~=0 -> c~=0 ->
  (c*a) rem (c*b) == c * (a rem b).
Proof.
intros; rewrite !(mul_comm c); now apply mul_rem_distr_r.
Qed.

(** Operations modulo. *)

Theorem rem_rem: forall a n, n~=0 ->
 (a rem n) rem n == a rem n.
Proof.
intros. pos_or_neg a; pos_or_neg n. apply NZQuot.mod_mod; order.
rewrite <- ! (rem_opp_r _ n) by trivial. apply NZQuot.mod_mod; order.
apply opp_inj. rewrite <- !rem_opp_l by order. apply NZQuot.mod_mod; order.
apply opp_inj. rewrite <- !rem_opp_opp by order. apply NZQuot.mod_mod; order.
Qed.

Lemma mul_rem_idemp_l : forall a b n, n~=0 ->
 ((a rem n)*b) rem n == (a*b) rem n.
Proof.
assert (Aux1 : forall a b n, 0<=a -> 0<=b -> n~=0 ->
         ((a rem n)*b) rem n == (a*b) rem n).
 intros. pos_or_neg n. apply NZQuot.mul_mod_idemp_l; order.
 rewrite <- ! (rem_opp_r _ n) by order. apply NZQuot.mul_mod_idemp_l; order.
assert (Aux2 : forall a b n, 0<=a -> n~=0 ->
         ((a rem n)*b) rem n == (a*b) rem n).
 intros. pos_or_neg b. now apply Aux1.
 apply opp_inj. rewrite <-2 rem_opp_l, <-2 mul_opp_r by order.
  apply Aux1; order.
intros a b n Hn. pos_or_neg a. now apply Aux2.
apply opp_inj. rewrite <-2 rem_opp_l, <-2 mul_opp_l, <-rem_opp_l by order.
apply Aux2; order.
Qed.

Lemma mul_rem_idemp_r : forall a b n, n~=0 ->
 (a*(b rem n)) rem n == (a*b) rem n.
Proof.
intros. rewrite !(mul_comm a). now apply mul_rem_idemp_l.
Qed.

Theorem mul_rem: forall a b n, n~=0 ->
 (a * b) rem n == ((a rem n) * (b rem n)) rem n.
Proof.
intros. now rewrite mul_rem_idemp_l, mul_rem_idemp_r.
Qed.

(** addition and modulo

  Generally speaking, unlike with other conventions, we don't have
       [(a+b) rem n = (a rem n + b rem n) rem n]
  for any a and b.
  For instance, take (8 + (-10)) rem 3 = -2 whereas
  (8 rem 3 + (-10 rem 3)) rem 3 = 1.
*)

Lemma add_rem_idemp_l : forall a b n, n~=0 -> 0 <= a*b ->
 ((a rem n)+b) rem n == (a+b) rem n.
Proof.
assert (Aux : forall a b n, 0<=a -> 0<=b -> n~=0 ->
          ((a rem n)+b) rem n == (a+b) rem n).
 intros. pos_or_neg n. apply NZQuot.add_mod_idemp_l; order.
 rewrite <- ! (rem_opp_r _ n) by order. apply NZQuot.add_mod_idemp_l; order.
intros a b n Hn Hab. destruct (le_0_mul _ _ Hab) as [(Ha,Hb)|(Ha,Hb)].
now apply Aux.
apply opp_inj. rewrite <-2 rem_opp_l, 2 opp_add_distr, <-rem_opp_l by order.
rewrite <- opp_nonneg_nonpos in *.
now apply Aux.
Qed.

Lemma add_rem_idemp_r : forall a b n, n~=0 -> 0 <= a*b ->
 (a+(b rem n)) rem n == (a+b) rem n.
Proof.
intros. rewrite !(add_comm a). apply add_rem_idemp_l; trivial.
now rewrite mul_comm.
Qed.

Theorem add_rem: forall a b n, n~=0 -> 0 <= a*b ->
 (a+b) rem n == (a rem n + b rem n) rem n.
Proof.
intros a b n Hn Hab. rewrite add_rem_idemp_l, add_rem_idemp_r; trivial.
reflexivity.
destruct (le_0_mul _ _ Hab) as [(Ha,Hb)|(Ha,Hb)];
 destruct (le_0_mul _ _ (rem_sign_mul b n Hn)) as [(Hb',Hm)|(Hb',Hm)];
 auto using mul_nonneg_nonneg, mul_nonpos_nonpos.
 setoid_replace b with 0 by order. rewrite rem_0_l by order. nzsimpl; order.
 setoid_replace b with 0 by order. rewrite rem_0_l by order. nzsimpl; order.
Qed.

(** Conversely, the following results need less restrictions here. *)

Lemma quot_quot : forall a b c, b~=0 -> c~=0 ->
 (a÷b)÷c == a÷(b*c).
Proof.
assert (Aux1 : forall a b c, 0<=a -> 0<b -> c~=0 -> (a÷b)÷c == a÷(b*c)).
 intros. pos_or_neg c. apply NZQuot.div_div; order.
 apply opp_inj. rewrite <- 2 quot_opp_r, <- mul_opp_r; trivial.
 apply NZQuot.div_div; order.
 rewrite <- neq_mul_0; intuition order.
assert (Aux2 : forall a b c, 0<=a -> b~=0 -> c~=0 -> (a÷b)÷c == a÷(b*c)).
 intros. pos_or_neg b. apply Aux1; order.
 apply opp_inj. rewrite <- quot_opp_l, <- 2 quot_opp_r, <- mul_opp_l; trivial.
 apply Aux1; trivial.
 rewrite <- neq_mul_0; intuition order.
intros. pos_or_neg a. apply Aux2; order.
apply opp_inj. rewrite <- 3 quot_opp_l; try order. apply Aux2; order.
rewrite <- neq_mul_0. tauto.
Qed.

Lemma mod_mul_r : forall a b c, b~=0 -> c~=0 ->
 a rem (b*c) == a rem b + b*((a÷b) rem c).
Proof.
 intros a b c Hb Hc.
 apply add_cancel_l with (b*c*(a÷(b*c))).
 rewrite <- quot_rem by (apply neq_mul_0; split; order).
 rewrite <- quot_quot by trivial.
 rewrite add_assoc, add_shuffle0, <- mul_assoc, <- mul_add_distr_l.
 rewrite <- quot_rem by order.
 apply quot_rem; order.
Qed.

Lemma rem_quot: forall a b, b~=0 ->
 a rem b ÷ b == 0.
Proof.
 intros a b Hb.
 rewrite quot_small_iff by assumption.
 auto using rem_bound_abs.
Qed.

(** A last inequality: *)

Theorem quot_mul_le:
 forall a b c, 0<=a -> 0<b -> 0<=c -> c*(a÷b) <= (c*a)÷b.
Proof. exact NZQuot.div_mul_le. Qed.

End ZQuotProp.


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

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

Compute (next_weekday friday).

Compute (next_weekday (next_weekday saturday)).

Example test_next_weekday:
  (next_weekday (next_weekday saturday)) = tuesday.
Proof. simpl. reflexivity. Qed.

(* ------------------------------ *)

Inductive bool : Type :=
  | true
  | false.

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

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

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

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

Notation "x && y" := (andb x y).
Notation "x || y" := (orb  x y).

Example test_orb5: false || false || true = true.
Proof. simpl. reflexivity. Qed.
(* ----------------------------- *)

Check true.

Inductive rgb : Type :=
  | red
  | green
  | blue.

Inductive color : Type :=
  | black
  | white
  | primary (p : rgb).

Definition monochrome (c : color) : bool :=
  match c with
  | black => true
  | white => true
  | primary q => false
  end.

Definition isred (c : color) : bool :=
  match c with
  | black => false
  | white => false
  | primary red => true
  | primary _ => false
  end.

Inductive bit : Type :=
  | B0
  | B1.

Inductive nybble : Type :=
  | bits (b0 b1 b2 b3 : bit).

Check (bits B1 B0 B1 B0).

  (* With this definition, 0 is represented by O, 1 by S O, 2 by S (S O), and so on. *)

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

  Example test_mult1: (mult 3 3) = 9.
  Proof. simpl. reflexivity. Qed.

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

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

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

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

  Check ((0 + 1) + 1).

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

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

  Notation "x =< y" := (leb x y)
                         (at level 70): nat_scope.
  Notation "x =? y" := (eqb x y)
                         (at level 70) : nat_scope.

  Example test_leb1: (2 =< 2) = true.
  Proof. simpl. reflexivity. Qed.
  Example test_leb2: (2 =< 4) = true.
  Proof. simpl. reflexivity. Qed.
  Example test_leb3: (4 =< 2) = false.
  Proof. simpl. reflexivity. Qed.

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

  Notation "x <? y" := (ltb x y) (at level 70) : nat_scope.

  Example test_ltb1: (2 <? 2) = false.
  Proof. simpl. reflexivity. Qed.
  Example test_ltb2: (2 <? 4) = true.
  Proof. simpl. reflexivity. Qed.
  Example test_ltb3: (4 <? 2) = false.
  Proof. simpl. reflexivity. Qed.


Definition id : forall X:Prop, X->X :=
	fun (X:Prop) (a:X) => a.
Check id (True->True) : (True->True)->True->True.

(*forall (A:Type)(x y:A), x=y -> y=x*)

(* 2 *)

Definition sym : forall (A:Type)(x y:A), x=y -> y=x :=
	fun (A:Type) (x y:A) (H: x = y) =>
		eq_ind x (fun z:A => z=x)
		(eq_refl x) y H.

Definition trans : forall (A:Type)(x y z:A), x=y -> y=z -> x=z :=
	fun (A:Type) (x y z : A) (H1 : x=y) (H2:y=z) =>
		eq_ind y (fun y0:A => x=y0)
		H1 z H2.

Definition cong : forall (A B:Type) (f:A->B) (x y:A), x=y -> f x = f y :=
	fun (A B:Type) (f:A->B) (x y:A) (H:x=y) =>
		eq_ind x (fun t:A => f x=f t)
		(eq_refl (f x)) y H
	.

(*Lemma cong_dep :
	forall (A:Type) (B:A->Type) (f:forall x:A, B x) (x y:A),
		x=y -> f x= f y.*)

(* 3 *)

Definition t := Prop.
Check (forall (x:t), x):t.

Definition u := Type.
Fail Check (forall (x:u), x):u.
Check (forall (P:Type), P):Type.

(* 4 *)

Definition imp_and (A:Prop)(B:Prop) :=
	forall X : Prop,  (A -> B -> X ) -> X.


(* Software Foundations *)
(* Exercice 5 stars, classical_axioms *)

Definition peirce  := forall P Q: Prop, ((P -> Q ) -> P) -> P.
Definition classic := forall P:Prop, ~~ P -> P.
Definition excluded_middle := forall  P:Prop, P \/ ~P.
Definition de_morgan_not_and_not := forall P Q:Prop, ~(~P /\ ~Q) -> P \/ Q.
Definition implies_to_or := forall P Q:Prop, (P -> Q) -> (~P \/ Q).

Theorem peirce_imp_classic: peirce -> classic.
Proof.
    compute. (* we can also use: unfold peirce. unfold classic. unfold not. *)
intros. apply H with False. intros. apply H0 in H1. inversion H1.
Qed.

Theorem classic_imp_excluded_middle: classic -> excluded_middle.

Proof.
    compute. intros. apply H. intros. apply H0. right. intros.
    apply H0. left. apply H1.
Qed.

Theorem excluded_middle_imp_de_morgan_not_and_not: excluded_middle -> de_morgan_not_and_not.
Proof.
    unfold excluded_middle. unfold de_morgan_not_and_not.
intros.
destruct (H P). left. apply H1.
destruct (H Q). right. apply H2.
destruct H0. split. apply H1. apply H2.
Qed.

Theorem de_morgan_not_and_not_imp_implies_to_or: de_morgan_not_and_not -> implies_to_or.
Proof.
    compute. intros.
    apply H. intros. destruct H1. apply H1. intros. apply H2. apply H0. apply H3.
Qed.

Theorem implies_to_or_imp_peirce: implies_to_or -> peirce.
Proof.
    Abort. (* Couldn't complet the cycle *)

(* not required just wanted to keep the proof *)
Theorem pierce_eq_classic: peirce <-> classic.
Proof.
    unfold peirce, classic.
    unfold not.
    split.
    (* peirce -> classic *)
    intros. apply H with False.
    intros.
    apply H0 in H1. inversion H1.
    (* peirce <- classic *)
    intros. apply H. intros. apply H1. apply H0. intros. apply H1 in H2. inversion H2.
Qed.


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

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

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

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

Notation "x && y" := (andb x y).
Notation "x || y" := (orb x y).

Definition nandb (b1: bool) (b2:bool) : bool :=        (* 1 star *)
match b1 with
 | true => match b2 with
            | false => true
            | true => false
	   end
 | false => true
end.

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

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

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

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

Definition andb3 (b1: bool) (b2:bool) (b3:bool) : bool :=    (* 1 star *)
match b1 with
  | false => false
  | true => match b2 with
             | false => false
             | true => b3
       	    end
end.

Example test_andb31: (andb3 true true true) = true.
Proof. simpl. reflexivity. Qed.
Example test_andb32: (andb3 false true true) = false.
Proof. simpl. reflexivity. Admitted.
Example test_andb33: (andb3 true false true) = false.
Proof. simpl. reflexivity. Admitted.
Example test_andb34: (andb3 true true false) = false.
Proof. simpl. reflexivity. Admitted.

Check true.

Module Playground1.

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

End Playground1.

Module Playground2.

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

Compute (plus 3 2).

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

Example test_mult1: (mult 3 3) = 9.
Proof. simpl. reflexivity.  Qed.

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

End Playground2.

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

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

Example test_factorial1:          (factorial 3) = 6.
Proof. reflexivity. Qed.
Example test_factorial2:          (factorial 5) = (mult 10 12).
Proof. reflexivity. Qed.

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

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

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

Notation "x =? y" := (eqb x y) (at level 70) : nat_scope.
Notation "x <=? y" := (leb x y) (at level 70) : nat_scope.
Example test_leb3': (4 <=? 2) = false.
Proof. simpl. reflexivity. Qed.

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

Notation "x <? y" := (ltb x y) (at level 70) : nat_scope.

Example test_ltb1: (ltb 2 2) = false.
Proof. simpl. reflexivity.  Qed.
Example test_ltb2: (ltb 2 4) = true.
Proof. simpl. reflexivity.  Qed.
Example test_ltb3: (ltb 4 2) = false.
Proof. simpl. reflexivity.  Qed.

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

Theorem plus_id_example : forall n m:nat,
  n = m ->
  n + n = m + m.
Proof.
  (* move both quantifiers into the context: *)
  intros n m.
  (* move the hypothesis into the context: *)
  intros H.
  (* rewrite the goal using the hypothesis: *)
  rewrite -> H.
  reflexivity.  Qed.

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

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

(** **** Exercise: 2 stars (mult_S_1)  *)
Theorem mult_S_1 : forall n m : nat,
  m = S n ->
  m * (1 + n) = m * m.
Proof.
  intros n m H.
  simpl.
  rewrite <- H.
  reflexivity.
  Qed.

Theorem plus_1_neq_0_firsttry : forall n : nat,
  (n + 1) =? 0 = false.
Proof.
  intros n.
  simpl.  (* does nothing! *)
Abort.

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

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

Theorem andb_commutative : forall b c, andb b c = andb c b.
Proof.
  intros b c. destruct b.
  - destruct c.
    + reflexivity.
    + reflexivity.
  - destruct c.
    + reflexivity.
    + reflexivity.
Qed.

Theorem andb_commutative' : forall b c, andb b c = andb c b.
Proof.
  intros b c. destruct b.
  { destruct c.
    { reflexivity. }
    { reflexivity. } }
  { destruct c.
    { reflexivity. }
    { reflexivity. } }
Qed.

Theorem andb3_exchange :
  forall b c d, andb (andb b c) d = andb (andb b d) c.
Proof.
  intros b c d. destruct b.
  - destruct c.
    { destruct d.
      - reflexivity.
      - reflexivity. }
    { destruct d.
      - reflexivity.
      - reflexivity. }
  - destruct c.
    { destruct d.
      - reflexivity.
      - reflexivity. }
    { destruct d.
      - reflexivity.
      - reflexivity. }
Qed.

Theorem plus_1_neq_0' : forall n : nat,
  (n + 1) =? 0 = false.
Proof.
  intros [|n].
  - reflexivity.
  - reflexivity. Qed.

Theorem andb_commutative'' :
  forall b c, andb b c = andb c b.
Proof.
  intros [] [].
  - reflexivity.
  - reflexivity.
  - reflexivity.
  - reflexivity.
Qed.

Theorem andb_true_elim2 : forall b c : bool,
  andb b c = true -> c = true.
Proof.
  intros [] [].
  - reflexivity.
  - simpl. intros H. rewrite -> H. reflexivity.
  - reflexivity.
  - simpl. intros H. rewrite -> H. reflexivity.
Qed.

Theorem zero_nbeq_plus_1 : forall n : nat,
   0 =? (n + 1) = false.
Proof.
  intros [|n].
  - reflexivity.
  - simpl. reflexivity.
Qed.

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

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

Theorem identity_fn_applied_twice :
  forall (f : bool -> bool),
  (forall (x : bool), f x = x) ->
  forall (b : bool), f (f b) = b.
Proof.
  intros f x b. rewrite -> x. rewrite -> x. reflexivity.
Qed.

Theorem negation_fn_applied_twice :
  forall (f : bool -> bool),
  (forall (x : bool), f x = negb x) ->
  forall (b : bool), f (f b) = b.
Proof.
  intros f x b. rewrite -> x. rewrite -> x. rewrite -> negb_involutive. reflexivity.
Qed.

Theorem andb_eq_orb :
  forall (b c : bool),
  (andb b c = orb b c) ->
  b = c.
Proof.
  intros [] [].
  - reflexivity.
  - simpl. intros H. rewrite -> H. reflexivity.
  - simpl. intros H. rewrite -> H. reflexivity.
  - reflexivity.
Qed.

Print nat.

Inductive bin : Type :=
  | Z
  | A (n : bin)
  | B (n : bin).

Fixpoint incr (n : bin) : bin :=
  match n with
  | Z => B Z
  | A n' => B n'
  | B n' => A (incr n')
  end.

Fixpoint bin_to_nat (b : bin) : nat :=
  match b with
  | Z => 0
  | A b' => 2 * (bin_to_nat b')
  | B b' => 1 + 2 * (bin_to_nat b')
  end.

Example test_bin_incr1 :=
  bin_to_nat(incr (B (B (B (A Z))))).