Require Import List ssreflect ssrbool.
From mathcomp Require Import eqtype ssrnat.

(* Let's see how one would define insertion sort in OCaml:

   let rec insert n l =
     match l with
       | [] -> [n]
       | x::xs -> if n <= x then n::x::xs else x::(insert n xs)

   let rec sort l =
     match l with
       | [] -> []
       | x::xs -> insert x (sort xs)

   As you saw during the lesson, the [insert] function is just some
   particular proof of [nat -> list nat -> list nat]: it is the proof
   that builds a new list by inserting its first arguments into its
   second one. As any proof, it thus can be defined in Coq using tactics.
 *)

Definition insert (n:nat) (l:list nat) : list nat.
Proof.
  (* The OCaml program is a recursive definition over l. I just do
     exactly the same with the elim tactic. The induction hypothesis ih
     is a proof of insert n xs : in fact it is the recursive call. *)
  elim:l => [|x xs ih].
  (* We start with the base case: we return the singleton list
     containing only n. *)
    apply:(n::nil).
  (* We are now in the recursive case. We need to distinguish two cases
     whether n <= x or not. *)
  case h:(n <= x).
  (* We are in the branch where n <= x. In this case, we can immediately
     return the list n::x::xs *)
    apply:(n::x::xs).
  (* We now are in the branch where n > x. In this case, we want to
     return x::(insert n xs). As we said, the recursive call is in fact
     ih. *)
  apply:(x::ih).
  (* Our function is now defined using tactics. [Defined] checks that it
     actually have the right type and defines it. *)
 Defined.

(* We can check on some examples that it is indeed the insert function
   we add in mind. Coq can actually compute with it! *)

Compute (insert 5 (1::2::3::4::6::7::8::9::nil)).
Compute (insert 5 (1::2::3::4::nil)).

(* Now do the same for the sort function, and test it on some examples.
   Hint: it takes only three tactics to define it! *)

Definition sort (l:list nat) : list nat.
Proof.
  (* TODO *)
Defined.

Compute (sort (7::9::5::3::0::4::2::1::8::6::nil)).
(* Add your own examples... *)

(* Ok, so far we have understood that we can define function using
   tactics. But our sorting function is no more that the OCaml version:
   we did not prove it was actually returning a list that is sorted!
   With tactics, we will be able to build the sorting function AND proof
   its correctness at the same time... *)

(* First, we need to define for a list of integers what it means to be
   sorted: each element is smaller than all the following elements *)

Fixpoint smaller n l : Prop :=
  match l with
    | nil => true
    | x::xs => n <= x /\ smaller n xs
  end.

Fixpoint sorted l : Prop :=
  match l with
    | nil => true
    | x::xs => smaller x xs /\ sorted xs
  end.

(* We give a very simple fact about smaller: if a is smaller than all
   the elements of a list l, and n <= a, then n is also smaller than all
   the elements of l. *)

Lemma smaller_trans n a l : smaller a l -> n <= a -> smaller n l.
Proof.
  elim:l => /=.
    done.
  move => b l ih [h1 h2] h3.
  split.
    move/(_ a n b):leq_trans => h4.
    by apply:h4.
  by apply:ih.
Defined.

(* For a matter of time, we also give you some arithmetic lemmas that
   you will need:

   o leq_false_lt m n : (m <= n) = false -> (n < m)
   o leq_false_leq n x : (n <= x) = false -> x <= n
   o eq_refl (n:nat) : n == n
   o gtn_eqF m n : m < n -> n == m = false
   o leq_false_neq n a : (n <= a) = false -> n == a = false

   Do not look at the proofs, just look at the statements above. *)

Lemma leq_trans n m p : m <= n -> n <= p -> m <= p.
Proof.
  elim: n m p => [|i IHn] [|m] [|p]; try reflexivity.
        move => h _. apply:h.
      compute. discriminate 1.
    move => _. compute => h. apply:h.
  by move/(_ m p):IHn.
Defined.

Lemma ltnW m n : m < n -> m <= n.
Proof. by apply:leq_trans. Defined.

Lemma leq_false_lt m n : (m <= n) = false -> (n < m).
Proof.
  elim: m n => [|m IHm] [|n].
        compute. discriminate 1.
      compute. discriminate 1.
    reflexivity.
  by move/(_ n):IHm.
Defined.

Lemma leq_false_leq n x : (n <= x) = false -> x <= n.
Proof.
  move => h.
  apply:ltnW.
  by apply:leq_false_lt.
Defined.

Lemma eq_refl (n:nat) : n == n.
Proof.
  elim:n => [|n ih].
    reflexivity.
  exact:ih.
Defined.

Lemma leqNgt m n : (m <= n) = ~~ (n < m).
Proof. by elim: m n => [|m IHm] [|n] //; exact: IHm n. Defined.

Lemma eqn_leq m n : (m == n) = (m <= n <= m).
Proof. elim: m n => [|m IHm] [|n] //; exact: IHm n. Defined.

Lemma gtn_eqF m n : m < n -> n == m = false.
Proof. by rewrite eqn_leq (leqNgt n) => ->. Defined.

Lemma leq_false_neq n a : (n <= a) = false -> n == a = false.
Proof.
  move => h.
  apply:gtn_eqF.
  by apply: leq_false_lt.
Defined.

(* We are now ready to build the insert function and prove its
   correctness at the same time. To do so, the Coq writing {l | P l}
   that designates a list l that satisfies the predicate P: P is the
   specification of the function.

   The specification of the insert function is the following:
   o if a is smaller that all the elements of l and a <= n then a is
     smaller than all the elements of (insert n l)
   o if l is sorted then (insert n l) is sorted *)

Definition insert_spec n l :
  {l' |
    (forall a, smaller a l -> a <= n -> smaller a l') /\
    (sorted l -> sorted l')}.
Proof.
  (* The proof is a refinement of the proof of [insert], in which we
     also build the proof of the specification of the function. So like
     for defining [insert], we do an induction. *)
  elim:l => [|x xs ih].
  (* We present the base case. The answer is the singleton list
     containing only n, together with a proof that this list satisfies
     the specification. We first give the list, using the exists tactic.
     *)
    exists (n::nil).
    (* Let's now prove the specification. It is a conjunction. *)
    split.
    (* On the first branch, we introduce a. *)
      move => a.
      (* We can simplify this goal: we know what [smaller a nil] and
         [smaller a (n :: nil)] mean. *)
      simpl.
      (* In fact, this goal is trivially proved with done. *)
      done.
      (* Let's simplify the second branch: we know what [sorted nil] and
         [sorted (n :: nil)] mean. *)
    simpl.
    (* In fact, this goal is trivially proved with done. *)
    done.
    (* Now do the recursive case. Do not forget to make a case analysis
       whether n <= x or not. You can destruct a proof of {l | P l}
       using the [case] tactic as usual. *)

  (* TODO *)
Defined.

(* Let do the same for the sort function. *)

Definition sort_spec (l:list nat) : {l' | sorted l'}.
Proof.
  (* TODO *)
Defined.

(* We now have defined functions that are correct (with respect to our
   specification) by construction. Finally, Coq offers an extraction
   mechanism, that automatically export them to OCaml, so we are sure
   that the OCaml program is correct by construction. *)

Require Extraction.
Extraction Language Ocaml.
Set Extraction AccessOpaque.

Extraction "insert_sort.ml" sort_spec.

(* Have a look at the file "insert_sort.mli". You observe that the
   function [sort_spec] has type [nat list -> nat list]: the extraction
   mechanism "forgets" the proof of the correctness of this function,
   since it has no signification in OCaml. You can test this extracted
   function using the file "test_sort.ml". *)

(* TO GO FURTHER *)

(* I am sure you all have noticed that our specification is incomplete:
   the sort function must not only return a sorted list, but this list
   must be a permutation of the initial list! We now do the same job
   with a complete specification. *)

(* We first define our notion of permutation: (x::xs) and l2 are a
   permutation if and only if xs and (remove x l2) are. *)

Fixpoint remove a (l:list nat) :=
  match l with
    | nil => None
    | x::xs =>
      if a == x then
        Some xs
      else
        match remove a xs with
          | Some xs' => Some (x::xs')
          | None => None
        end
  end.

Fixpoint permutation l1 l2 : Prop :=
  match l1, l2 with
    | nil, nil => true
    | nil, _ => False
    | x::xs, _ =>
      match remove x l2 with
        | Some l2' => permutation xs l2'
        | None => False
      end
  end.

(* First prove that this relation is reflexive. *)

Lemma permutation_refl l: permutation l l.
Proof.
  (* TODO *)
Defined.

(* Now define insertion and sort with the complete specification. *)

Definition insert_complete n l :
  {l' |
    (forall a, smaller a l -> a <= n -> smaller a l') /\
    (remove n l' = Some l) /\
    (sorted l -> sorted l' /\ permutation (n::l) l')}.
Proof.
  (* TODO *)
Defined.

Definition sort_complete (l:list nat) : {l' | sorted l' /\ permutation l l'}.
Proof.
  (* TODO *)
Defined.

Extraction Language Ocaml.
Set Extraction AccessOpaque.

Extraction "insert_sort.ml" sort_complete.


Require Import ProofCheckingEuclid.euclidean_axioms.
Require Import ProofCheckingEuclid.lemma_congruencetransitive.

Section Euclid.

Context `{Ax:euclidean_neutral}.

Lemma lemma_congruenceflip :
	forall A B C D,
	Cong A B C D ->
	Cong B A D C /\ Cong B A C D /\ Cong A B D C.
Proof.
	intros A B C D.
	intros Cong_AB_CD.
	assert (Cong B A A B) as Cong_BA_AB by (apply cn_congruencereverse).
	assert (Cong C D D C) as Cong_CD_DC by (apply cn_congruencereverse).
	pose proof (lemma_congruencetransitive _ _ _ _ _ _ Cong_BA_AB Cong_AB_CD) as Cong_BA_CD.
	pose proof (lemma_congruencetransitive _ _ _ _ _ _ Cong_AB_CD Cong_CD_DC) as Cong_AB_DC.
	pose proof (lemma_congruencetransitive _ _ _ _ _ _ Cong_BA_AB Cong_AB_DC) as Cong_BA_DC.
	split.
	exact Cong_BA_DC.
	split.
	exact Cong_BA_CD.
	exact Cong_AB_DC.
Qed.

End Euclid.


(* March 1st, 2016. We skipped a lot of chapters *)

Inductive list (A:Type) : Type :=
  | Nil : list A
  | Cons : A -> list A -> list A.

Inductive ev : nat -> Prop :=
  | ev_0: ev 0 (* constructor declaration *)
  | ev_SS: forall (n:nat), ev n -> ev (S (S n)). (* also a constructor *)

Theorem ev_example : ev 0.
Proof.
  apply ev_0.
Qed.

Theorem ev_example_nonzero : ev 14.
Proof.
  repeat apply ev_SS.
  apply ev_0.
Abort.

(* What's different from evenb *)
Fixpoint evenb (n:nat) : bool :=
  match n with
  | 0 => true
  | S 0 => false
  | S (S n) => evenb n
end.

Fixpoint even (n:nat) : Prop := evenb n = true.

Theorem even_ex : even 0.
Proof.
  simpl.
  reflexivity.
Qed.

Theorem even_ex_bad : even 1.
Proof.
  simpl.
Abort.

Theorem even_ex_big : even 14.
Proof.
  simpl.
  auto.
Qed.

(* Inference rule: bottom conclusion, top hypothesis

          ev n
------  ----------
 ev 0    ev (n+2)

*)

Inductive beautiful : nat -> Prop :=
| b_0 : beautiful 0
| b_3 : beautiful 3
| b_5 : beautiful 5
| b_sum : forall n m, beautiful n -> beautiful m -> beautiful (n+m).

(*
                               beautiful n beautiful m
-------- ---------   --------  ------------------------
  b_0      b_3         b_5         beautiful(n+m)

*)

Theorem b_times2: forall n, beautiful n -> beautiful (2 * n).
Proof.
  intros n beau. (* premises to a lemma *)
  apply b_sum.
  apply beau.
  apply b_sum.
  apply beau.
  apply b_0.
Qed.

(* when to use computational vs. inductive definitions? *)
(* Inductive defs are more flexible than computational ones *)


From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Inductive exp: Type :=
  | con (n: nat)
  | add (a: exp) (b: exp)
  | sub (a: exp) (b: exp).

Fixpoint eval (e: exp): nat :=
  match e with
  | con n => n
  | add a b => eval a + eval b
  | sub a b => eval a - eval b
  end.

Inductive comm: Type :=
  | addc
  | subc
  | push (n: nat).

Print list.

Fixpoint r (pr: list comm) (s: list nat): list nat :=
  match pr, s with
  | (cons addc pr'), (cons a (cons b  rest)) => r pr' (cons (a + b) rest)
  | (cons subc pr'), (cons a (cons b  rest)) => r pr' (cons (a - b) rest)
  | (cons (push n) pr'), stack => r pr' (cons n stack)
  | [::], s => s
  | _, _ => nil
  end.

Fixpoint compile (e: exp): list comm :=
    match e with
    | con n => cons (push n) nil
    | add a b => compile b ++ compile a ++  (cons addc nil)
    | sub a b => compile b ++ compile a ++ (cons subc nil)
    end.

(* 20.3.1 *)
Lemma stepc: forall e rest stack,
  r (compile e ++ rest) stack = r rest (cons (eval e) stack).
Proof.
  elim => [n //| a IH b IH' | a IH b IH'] rest stack.
  - rewrite /compile -/compile /eval -/eval.
    rewrite -catA IH'.
    rewrite -catA IH.
    rewrite cat1s.
    by rewrite /r -/r.
  - rewrite /compile -/compile /eval -/eval.
    rewrite -catA IH'.
    rewrite -catA IH.
    rewrite cat1s.
    by rewrite /r -/r.
Qed.

(* 20.3.2 *)
Theorem correctc: forall e, r (compile e) [::] = [:: (eval e)].
Proof.
  elim => [ n //= | a IH b IH' | a IH b IH' ].
  - by rewrite /compile -/compile 2!stepc /r /eval -/eval.
  - by rewrite /compile -/compile 2!stepc /r /eval -/eval.
Qed.

(* 20.4 *)
Fixpoint d (pr: list comm) (exps: list exp): list exp :=
  match pr, exps with
  | [::], e => e
  | [:: addc & rest], [:: e1, e2 & exps] => d rest [:: add e1 e2 & exps]
  | [:: subc & rest], [:: e1, e2 & exps] => d rest [:: sub e1 e2 & exps]
  | [:: push n & rest], exps => d rest [:: con n & exps]
  | _, _ => [::]
  end.

(* 20.4.1 *)
Lemma stepd: forall e pr b, d (compile e ++ pr) b = d pr [:: e & b ].
Proof.
  elim => [ n pr b // | e1 IH e2 IH' pr b | e1 IH e2 IH' pr b ].
  - rewrite /compile -/compile -catA IH' -catA IH cat1s.
    by rewrite /d -/d.
  - rewrite /compile -/compile -catA IH' -catA IH cat1s.
    by rewrite /d -/d.
Qed.

(* 20.4.2 *)
Theorem correctd: forall e, d (compile e) [::] = [:: e ].
Proof.
  elim => [ n // | a IH b IH' | a IH b IH' ];
    by rewrite /compile -/compile stepd stepd /d -/d.
Qed.


Require Export ZArith  List  Arith Bool.

(*

Inductive month : Set :=
| January : month | February : month | March : month
| April : month   | May : month      | June : month
| July : month    | August : month   | September : month
| October : month | November : month | December : month.

*)

(** short form
*)
Inductive month : Set :=
| January | February | March     | April   | May      | June
| July    | August   | September | October | November | December.

(** Tests :

Check month_ind.

Check month_rec.
*)

Theorem month_equal :
forall m:month,
 m=January \/ m=February \/ m=March \/ m=April \/ m=May \/ m=June \/
 m=July \/ m=August \/  m=September \/ m=October \/ m=November \/
 m=December.
Proof.
 destruct m; auto 12.
Qed.

(** explicit use of maont_ind:

*)
Theorem month_equal' :
forall m:month,
 m=January \/ m=February \/ m=March \/ m=April \/
 m=May \/ m=June \/ m=July \/ m=August \/
 m=September \/ m=October \/ m=November \/ m=December.
Proof.
 intro m; pattern m; apply month_ind; auto 12.
Qed.

Definition month_length (leap:bool)(m:month) : nat :=
  match m with
  | January => 31 | February => if leap then 29 else 28
  | March => 31   | April => 30    | May => 31  | June => 30
  | July => 31    | August => 31   | September => 30
  | October => 31 | November => 30 | December => 31
  end.

Definition month_length' (leap:bool) :=
  month_rec (fun m:month => nat)
  31 (if leap then 29 else 28) 31 30 31 30 31 31 30 31 30 31.

Definition month_length'' (leap:bool)(m:month) :=
 match m with
 | February => if leap then 29 else 28
 | April  | June  | September | November => 30
 | _  => 31
 end.

(** Tests :

Compute  (fun leap => month_length leap November).
*)

Example  length_february : month_length false February = 28.
Proof. reflexivity. Qed.

(* Definition with Record *)

Record plane : Set := point {abscissa : Z; ordinate : Z}.

Definition in_diagonal (p:plane) :=
  Z_eq_bool (abscissa p) (ordinate p).

Inductive vehicle : Set :=
  bicycle : nat->vehicle | motorized : nat->nat->vehicle.

(**
Check vehicle_ind.
*)

Definition nb_wheels (v:vehicle) : nat :=
  match v with
  | bicycle x => 2
  | motorized x n => n
  end.

Definition nb_seats (v:vehicle) : nat :=
  match v with
  | bicycle x => x
  | motorized x _ => x
  end.

Theorem at_least_28 :
 forall (leap:bool)(m:month), 28 <= month_length leap m.
Proof.
 intros leap m; case m; simpl; auto with arith.
 case leap; simpl; auto with arith.
Qed.

Definition next_month (m:month) :=
  match m with
  |  January => February  | February => March | March => April
  | April => May         | May => June       | June => July
  | July => August       | August => September
  | September => October | October => November
  | November => December | December => January
  end.

Theorem next_august_then_july :
 forall m:month, next_month m = August -> m = July.
Proof.
 intros m; case m; simpl; intros Hnext_eq;
    (reflexivity || discriminate Hnext_eq).
Qed.

(* Simulating discriminate (just for the fun) *)

Theorem not_January_eq_February' : January <> February.
Proof.
 unfold not; intros H.
 change ((fun m:month =>
          match m with | January => True | _ => False end)
        February).
 rewrite <- H.
 trivial.
Qed.

(* Using injection *)

Theorem bicycle_eq_seats :
 forall x1 y1:nat, bicycle x1 = bicycle y1 -> x1 = y1.
Proof.
 intros x1 y1 H.
 injection H.
 trivial.
Qed.

(* Simulating injection (for the fun) *)

Theorem bicycle_eq_seats' :
 forall x1 y1:nat, bicycle x1 = bicycle y1 -> x1 = y1.
Proof.
 intros x1 y1 H.
 change (nb_seats (bicycle x1) = nb_seats (bicycle y1)).
 rewrite H; reflexivity.
Qed.

Theorem next_march_shorter :
 forall (leap:bool)(m1 m2:month), next_month m1 = March ->
   month_length leap m1 <= month_length leap m2.
Proof.
 intros leap m1 m2 H.
 case_eq m1; try  (intro H0; rewrite H0 in H; simpl in H; discriminate H).
  case leap ; case m2 ; simpl; auto with arith.
Qed.

(* A first, detailed, proof of associativity of + *)

Theorem plus_assoc :
 forall x y z:nat, (x+y)+z = x+(y+z).
Proof.
 induction x as [ | x0 IHx0].
 -  simpl; reflexivity.
 - simpl; intros y z; rewrite IHx0; reflexivity.
Qed.

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

Inductive Z_btree : Set :=
  Z_leaf : Z_btree | Z_bnode : Z->Z_btree->Z_btree->Z_btree.

Fixpoint sum_all_values (t:Z_btree) : Z :=
  (match t with
   | Z_leaf => 0
   | Z_bnode v t1 t2 =>
       v + sum_all_values t1 + sum_all_values t2
  end)%Z.

Fixpoint zero_present (t:Z_btree) : bool :=
   match t with
   | Z_leaf => false
   | Z_bnode (0%Z)  t1 t2 => true
   | Z_bnode _ t1 t2 =>
        zero_present t1 ||  zero_present t2
   end.

Fixpoint add_one (x:positive) : positive :=
  match x with
  | xI x' => xO (add_one x')
  | xO x' => xI x'
  | xH => 2%positive
  end.

Inductive Z_fbtree : Set :=
  Z_fleaf : Z_fbtree | Z_fnode : Z ->(bool->Z_fbtree)-> Z_fbtree.

Definition right_son (t:Z_btree) : Z_btree :=
  match t with
  | Z_leaf => Z_leaf
  | Z_bnode a t1 t2 => t2
  end.

Definition fright_son (t:Z_fbtree) : Z_fbtree :=
  match t with
  | Z_fleaf => Z_fleaf
  | Z_fnode a f => f false
  end.

(**

Check Z_fbtree_ind.
*)

Fixpoint fsum_all_values (t:Z_fbtree) : Z :=
 (match t with
  | Z_fleaf => 0
  | Z_fnode v f =>
     v + fsum_all_values (f true) + fsum_all_values (f false)
  end )%Z .

Inductive Z_inf_branch_tree : Set :=
| Z_inf_leaf : Z_inf_branch_tree
| Z_inf_node : Z->(nat->Z_inf_branch_tree)->Z_inf_branch_tree.

Fixpoint sum_f (n:nat)(f : nat -> Z) : Z
 := (match n with
       | O => 0
       | S p => f n + sum_f p f
     end)%Z.

Fixpoint n_sum_all_values (n:nat)(t:Z_inf_branch_tree) : Z :=
  (match t with
    | Z_inf_leaf => 0
    | Z_inf_node v f =>
         v + sum_f n (fun x:nat => n_sum_all_values n (f x))
    end )%Z.

Definition mult2' : nat->nat :=
  fix f (n:nat) : nat :=
    match n with 0 => 0 | S p => S (S (f p)) end.

Fixpoint app {A:Type}(l m:list A) : list A :=
  match l with
  | nil => m
  | cons a l1 => cons a (app  l1 m)
  end.

Definition pred_option (n:nat) : option nat :=
  match n with O => None | S p => Some p end.

Definition pred2_option (n:nat) : option nat :=
  match pred_option n with
  | None => None
  | Some p => pred_option p
  end.

Fixpoint nth_option {A:Type} (n:nat)(l:list A) : option A :=
  match n, l with
  | O, cons a tl => Some a
  | S p, cons a tl => nth_option  p tl
  | _, nil => None
  end.

(** Some tests:

Print fst.

Check (sum nat bool).

Check (inl bool 4).

Check (inr nat false).
*)

Inductive ltree (n:nat) : Set :=
  | lleaf : ltree n
  | lnode : forall p:nat, p <= n -> ltree n -> ltree n -> ltree n.

Inductive sqrt_data (n:nat) : Set :=
  sqrt_intro : forall x:nat, x*x <= n -> n <  S x * S x -> sqrt_data n.

Inductive htree (A:Type) : nat->Type :=
  | hleaf : A->htree A 0
  | hnode : forall n:nat, A -> htree A n -> htree A n -> htree A (S n).

(**

Check htree_ind.

*)

Fixpoint htree_to_btree (n:nat)(t:htree Z n){struct t} : Z_btree :=
  match t with
  | hleaf _ x => Z_bnode x Z_leaf Z_leaf
  | hnode _ p v t1 t2 =>
      Z_bnode v (htree_to_btree p t1)(htree_to_btree p t2)
  end.

Fixpoint invert (A:Type)(n:nat)(t:htree A n){struct t} : htree A n :=
  match t in htree _ x return htree A x with
  | hleaf _ v => hleaf A v
  | hnode _ p v t1 t2 => hnode A p v (invert A p t2)(invert A p t1)
  end.

(**

Print Empty_set.

Check Empty_set_ind.
*)

Inductive strange : Set :=  cs : strange->strange.

Theorem strange_empty : forall x:strange, False.
Proof.
 intro x; induction x.
 assumption.
Qed.

(** attempt to prove falsehood

Theorem nat_not_strange :  forall n:nat, False.
Proof.
 intros x; elim x.
Abort.

*)

Inductive even_line : nat->Set :=
  | even_empty_line : even_line 0
  | even_step_line : forall n:nat, even_line n -> even_line (S (S n)).

(** Tests :

Check even_empty_line.

Check (even_step_line _ even_empty_line).

Check (even_step_line _ (even_step_line _ even_empty_line)).
*)


Require Import Arith.
Require Import Omega.
Require Import Recdef.
Require Import List.
Require Import Program.Tactics.
Import ListNotations.

Section Lecture6.

  (* True iff the list’s elements are in decreasing order *)
  Inductive Dec : list nat -> Prop :=
  | DNil : Dec []
  | DCons : forall a l,
      (forall b, In b l -> a <= b) ->
      Dec l ->
      Dec (a :: l).
  Hint Constructors Dec.

  (* True iff the list’s elements are in INcreasing order *)
  Inductive Inc : list nat -> Prop :=
  | INil : Inc []
  | ICons : forall a l,
      (forall b, In b l -> b <= a) ->
      Inc l ->
      Inc (a :: l).
  Hint Constructors Inc.

  (* A fact about appending increasing lists *)
  Lemma Inc_app xs ys:
    Inc xs -> Inc ys ->
    (forall x y, In x xs -> In y ys -> y <= x) ->
    Inc (xs ++ ys).
  Admitted.

  Lemma Dec_rev xs: Dec (rev xs) -> Inc xs.
    induction xs.
    auto.
    simpl.
    intros.
    apply ICons; intros.
    (* Ugh! We could prove some lemmas about Dec, but instead
       let’s use a more convenient induction principle. *)
  Abort.

  (* Reverse induction on lists: *)
  Lemma rev_ind {A} (P:list A -> Prop):
      P [] ->
      (forall a l, P l -> P (l ++ [a])) ->
      (forall l, P l).
    (* But this is difficult to prove from scratch.
       We need one more helper induction principle. *)
  Abort.

  Lemma rev_ind' {A} (P:list A -> Prop):
      P [] ->
      (forall a l, P (rev l) -> P (rev (a :: l))) ->
      (forall l, P (rev l)).
    (* This induction principle is easier to prove
       because, in the inductive hypotheses, `l` grows
       in the normal way (from the front). *)
    intros; induction l; auto.
  Qed.

  Lemma rev_ind {A} (P:list A -> Prop):
      P [] ->
      (forall a l, P l -> P (l ++ [a])) ->
      (forall l, P l).
    intros.
    rewrite <- (rev_involutive l). (* `rev (rev l) = l` *)
    apply rev_ind'; auto.
    intros.
    simpl.
    apply H0.
    auto.
  Qed.

  (* We’ve proved the new induction principle correct,
     so we can use it. *)
  Lemma Dec_rev xs: Dec (rev xs) -> Inc xs.
    induction xs using rev_ind; auto.
    rewrite rev_unit. (* `rev (xs ++ [a]) = a :: rev xs` *)
    intros; inversion H; subst.
    apply Inc_app.
    - auto. (* `auto` can apply inductive hypothesis *)
    - apply ICons; intros.
      + destruct H0.
      + auto.
    - intros; destruct H1.
      + subst.
        apply H2.
        apply in_rev in H0.
        auto.
      + destruct H1.
  Qed.

  (* The proof gets easier if we tell Coq `auto` to
     automatically resolve `In _ nil` hypotheses. *)
  Hint Extern 1 => match goal with
                   | [ H : In _ nil |- _ ] => destruct H
                   end.

  Lemma Dec_rev' xs: Dec (rev xs) -> Inc xs.
    induction xs using rev_ind; auto.
    rewrite rev_unit.
    intros; inversion H; subst.
    apply Inc_app; auto. (* !! *)
    intros; destruct H1; auto.
    apply in_rev in H0; subst; auto.
  Qed.

End Lecture6.


(** * Induction: Proof by Induction *)

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

From LF Require Export Basics.

(** * Proof by Induction *)

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

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

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

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.

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.

(** **** Exercise: 2 stars, standard, 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, standard (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, standard, optional (evenb_S)

    One inconvenient 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, standard (destruct_induction)

    Briefly explain the difference between the tactics [destruct]
    and [induction].

(* FILL IN HERE *)
*)

(* Do not modify the following line: *)
Definition manual_grade_for_destruct_induction : option (nat*string) := None.
(** [] *)

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

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.

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 rewrites 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 *)

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.

(** - _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_. *)

(** **** 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 *)
*)

(* Do not modify the following line: *)
Definition manual_grade_for_plus_comm_informal : option (nat*string) := None.
(** [] *)

(** **** Exercise: 2 stars, standard, optional (eqb_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 = n =? n] for any [n].

    Proof: (* FILL IN HERE *)

    [] *)

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

(** **** Exercise: 3 stars, standard, 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, standard, 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!) *)

Check leb.

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

Theorem zero_nbeq_S : forall n: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,
  n <=? m = true -> (p + n) <=? (p + m) = true.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem S_nbeq_0 : forall n: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, standard, optional (eqb_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 eqb_refl : forall n : nat,
  true = (n =? n).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, standard, 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, standard, 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 *)

(* Do not modify the following line: *)
Definition manual_grade_for_binary_commute : option (nat*string) := None.
(** [] *)

(** **** Exercise: 5 stars, advanced (binary_inverse)

    This is a further continuation of the previous exercises about
    binary numbers.  You may find you need to go back and change your
    earlier definitions to get things to work here.

    (a) First, write a function to convert natural numbers to binary
        numbers. *)

Fixpoint nat_to_bin (n:nat) : bin
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.

(** Prove that, if we start with any [nat], convert it to binary, and
    convert it back, we get the same [nat] we started with.  (Hint: If
    your definition of [nat_to_bin] involved any extra functions, you
    may need to prove a subsidiary lemma showing how such functions
    relate to [nat_to_bin].) *)

Theorem nat_bin_nat : forall n, bin_to_nat (nat_to_bin n) = n.
Proof.
  (* FILL IN HERE *) Admitted.

(* Do not modify the following line: *)
Definition manual_grade_for_binary_inverse_a : option (nat*string) := None.

(** (b) One might naturally expect that we should also prove the
        opposite direction -- that starting with a binary number,
        converting to a natural, and then back to binary should yield
        the same number we started with.  However, this is not the
        case!  Explain (in a comment) what the problem is. *)

(* FILL IN HERE *)

(* Do not modify the following line: *)
Definition manual_grade_for_binary_inverse_b : option (nat*string) := None.

(** (c) Define a normalization function -- i.e., a function
        [normalize] going directly from [bin] to [bin] (i.e., _not_ by
        converting to [nat] and back) such that, for any binary number
        [b], converting [b] to a natural and then back to binary yields
        [(normalize b)].  Prove it.  (Warning: This part is a bit
        tricky -- you may end up defining several auxiliary lemmas.
        One good way to find out what you need is to start by trying
        to prove the main statement, see where you get stuck, and see
        if you can find a lemma -- perhaps requiring its own inductive
        proof -- that will allow the main proof to make progress.) Don't
        define thi using nat_to_bin and bin_to_nat! *)

(* FILL IN HERE *)

(* Do not modify the following line: *)
Definition manual_grade_for_binary_inverse_c : option (nat*string) := None.
(** [] *)


Module IndPrinciples.

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

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

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

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

Check rgb_ind:
  forall (P: rgb -> Prop),
  P red ->
  P green ->
  P blue ->
  forall (c : rgb), P c.

Inductive natlist : Type :=
  | nnil
  | ncons (n : nat) (l : natlist).

Check natlist_ind :
  forall (P : natlist -> Prop),
    P nnil ->
    (forall (n : nat) (l : natlist),  P l -> P (ncons n l)) ->
    forall (l : natlist), P l.

Inductive natlist' : Type :=
  | nnil'
  | nsnoc (l : natlist') (n : nat).

Check natlist'_ind :
  forall (P : natlist' -> Prop),
    P nnil' ->
    (forall (l : natlist'), P l -> forall (n : nat), P (nsnoc l n)) ->
    forall (n : natlist'), P n.

Inductive booltree : Type :=
  | bt_empty
  | bt_leaf (b : bool)
  | bt_branch (b : bool) (t1 t2 : booltree).

Check booltree_ind:
  forall (P : booltree -> Prop),
    P bt_empty ->
    (forall (b : bool), P (bt_leaf b)) ->
    (forall (b : bool) (t1: booltree), P t1 -> forall (t2 : booltree), P t2 -> P (bt_branch b t1 t2)) ->
    (forall (t : booltree), P t).

Inductive tree (X:Type) : Type :=
  | leaf (x : X)
  | node (t1 t2 : tree X).

Check tree_ind:
  forall (X: Type) (P: tree X -> Prop),
    (forall (x: X), P (leaf X x)) ->
    (forall (t1: tree X), P t1 -> forall (t2: tree X), P t2 -> P (node X t1 t2)) ->
    (forall (t: tree X), P t).

Inductive foo' (X:Type) : Type :=
  | C1 (l : list X) (f : foo' X)
  | C2.

Check foo'_ind:
  forall (X: Type) (P: foo' X -> Prop),
    (forall (l: list X) (f: foo' X), P f -> P (C1 X l f)) ->
    P (C2 X ) ->
    (forall (f: foo' X), P f).

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

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

(* IndProp induction: *)

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

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

Inductive ev' : nat -> Prop :=
  | ev'_0 : ev' 0
  | ev'_2 : ev' 2
  | ev'_sum n m (Hn : ev' n) (Hm : ev' m) : ev' (n + m).

Theorem ev_ev' : forall n, ev n -> ev' n.
Proof.
  apply (ev_ind ev').
  - (* ev_0 *)
    apply ev'_0.
  - (* ev_SS *)
    intros m Hm IH.
    apply (ev'_sum 2 m).
    + apply ev'_2.
    + apply IH.
Qed.

Inductive le1 : nat -> nat -> Prop :=
  | le1_n : forall n, le1 n n
  | le1_S : forall n m, (le1 n m) -> (le1 n (S m)).
Notation "m <=1 n" := (le1 m n) (at level 70).

Inductive le2 (n:nat) : nat -> Prop :=
  | le2_n : le2 n n
  | le2_S m (H : le2 n m) : le2 n (S m).
Notation "m <=2 n" := (le2 m n) (at level 70).

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

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

(* induction lemma is just lemma *)
Fixpoint build_proof
         (P : nat -> Prop)
         (evPO : P 0)
         (evPS : forall (n : nat), P n -> P (S n))
         (n : nat) : P n :=
  match n with
  | 0   => evPO
  | S k => evPS k (build_proof P evPO evPS k)
  end.

Definition nat_ind2 :
  forall (P : nat -> Prop),
  P 0 ->
  P 1 ->
  (forall (n : nat), P n -> P (S(S n))) ->
  (forall (n : nat), P n) :=
    fun P P0 P1 PSS =>
      fix f (n:nat) := match n with
                       | 0        => P0
                       | 1        => P1
                       | S (S n') => PSS n' (f n')
                       end.

Fixpoint even (n: nat): bool :=
  match n with
  | 0 => true
  | S 0 => false
  | S (S k) => even k
  end.

Lemma even_ev : forall n, even n = true -> ev n.
Proof.
  intros.
  induction n as [ | |n'] using nat_ind2.
  - apply ev_0.
  - simpl in H.
    inversion H.
  - simpl in H.
    apply ev_SS.
    apply IHn'.
    apply H.
Qed.

Inductive foo'' (X:Type) : Type :=
  | C1' (l : list X) (f : foo'' X)
  | C2'.

Check foo''_ind :
  forall (X: Type) (P: foo'' X -> Prop),
    (forall (l: list X) (f: foo'' X), P f -> P (C1' X l f)) ->
    P (C2' X) ->
    (forall (f: foo'' X), P f).

End IndPrinciples.


Require Import Arith.

Goal forall n m p q : nat, (n + m) + (p + q) = (n + p) + (m + q).
Proof.
intros.
apply plus_permute_2_in_4.
Qed.

Goal forall n m : nat, (n + m) * (n + m) = n * n + m * m + 2 * n * m.
Proof.
intros.
rewrite -> mult_plus_distr_r.
rewrite -> mult_plus_distr_l.
rewrite <- plus_assoc.
rewrite <- plus_assoc.
apply NPeano.Nat.add_cancel_l.
rewrite -> mult_plus_distr_l.
replace (m*n) with (n*m).
rewrite -> plus_assoc.
replace (2*n*m) with (n*m+n*m).
rewrite -> plus_comm.
reflexivity.
simpl.
rewrite -> mult_plus_distr_r.
apply NPeano.Nat.add_cancel_l.
rewrite -> mult_plus_distr_r.
rewrite -> mult_0_l.
rewrite -> plus_0_r.
reflexivity.
apply mult_comm.
Qed.


(** * Prop: Propositions and Evidence *)

Require Export Logic.

(* ####################################################### *)
(** * Inductively Defined Propositions *)

(** In chapter [Basics] we defined a _function_ [evenb] that tests a
    number for evenness, yielding [true] if so.  We can use this
    function to define the _proposition_ that some number [n] is
    even: *)

Definition even (n:nat) : Prop :=
  evenb n = true.

(** That is, we can define "[n] is even" to mean "the function [evenb]
    returns [true] when applied to [n]."

    Note that here we have given a name
    to a proposition using a [Definition], just as we have
    given names to expressions of other sorts. This isn't a fundamentally
    new kind of proposition;  it is still just an equality. *)

(** Another alternative is to define the concept of evenness
    directly.  Instead of going via the [evenb] function ("a number is
    even if a certain computation yields [true]"), we can say what the
    concept of evenness means by giving two different ways of
    presenting _evidence_ that a number is even. *)

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

(** The first line declares that [ev] is a proposition -- or,
    more formally, a family of propositions "indexed by" natural
    numbers.  (That is, for each number [n], the claim that "[n] is
    even" is a proposition.)  Such a family of propositions is
    often called a _property_ of numbers.

    The last two lines declare the two ways to give evidence that a
    number [m] is even.  First, [0] is even, and [ev_0] is evidence
    for this.  Second, if [m = S (S n)] for some [n] and we can give
    evidence [e] that [n] is even, then [m] is also even, and [ev_SS n
    e] is the evidence.
*)

(** **** Exercise: 1 star (double_even)  *)

Theorem double_even : forall n,
  ev (double n).
Proof.
  intros n.
  induction n.
  simpl.
  apply ev_0.
  simpl.
  apply ev_SS.
  apply IHn.
  Qed.
(** [] *)

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

(** For [ev], we had already defined [even] as a function (returning a
   boolean), and then defined an inductive relation that agreed with
   it. However, we don't necessarily need to think about propositions
   first as boolean functions, we can start off with the inductive
   definition.
*)

(** As another example of an inductively defined proposition, let's
    define a simple property of natural numbers -- we'll call it
    "[beautiful]." *)

(** Informally, a number is [beautiful] if it is [0], [3], [5], or the
    sum of two [beautiful] numbers.

    More pedantically, we can define [beautiful] numbers by giving four
    rules:

       - Rule [b_0]: The number [0] is [beautiful].
       - Rule [b_3]: The number [3] is [beautiful].
       - Rule [b_5]: The number [5] is [beautiful].
       - Rule [b_sum]: If [n] and [m] are both [beautiful], then so is
         their sum. *)

(** We will see many definitions like this one during the rest
    of the course, and for purposes of informal discussions, it is
    helpful to have a lightweight notation that makes them easy to
    read and write.  _Inference rules_ are one such notation: *)
(**
                              -----------                               (b_0)
                              beautiful 0

                              ------------                              (b_3)
                              beautiful 3

                              ------------                              (b_5)
                              beautiful 5

                       beautiful n     beautiful m
                       ---------------------------                      (b_sum)
                              beautiful (n+m)
*)

(** *** *)
(** Each of the textual rules above is reformatted here as an
    inference rule; the intended reading is that, if the _premises_
    above the line all hold, then the _conclusion_ below the line
    follows.  For example, the rule [b_sum] says that, if [n] and [m]
    are both [beautiful] numbers, then it follows that [n+m] is
    [beautiful] too.  If a rule has no premises above the line, then
    its conclusion holds unconditionally.

    These rules _define_ the property [beautiful].  That is, if we
    want to convince someone that some particular number is [beautiful],
    our argument must be based on these rules.  For a simple example,
    suppose we claim that the number [5] is [beautiful].  To support
    this claim, we just need to point out that rule [b_5] says so.
    Or, if we want to claim that [8] is [beautiful], we can support our
    claim by first observing that [3] and [5] are both [beautiful] (by
    rules [b_3] and [b_5]) and then pointing out that their sum, [8],
    is therefore [beautiful] by rule [b_sum].  This argument can be
    expressed graphically with the following _proof tree_: *)
(**
         ----------- (b_3)   ----------- (b_5)
         beautiful 3         beautiful 5
         ------------------------------- (b_sum)
                   beautiful 8
*)
(** *** *)
(**
    Of course, there are other ways of using these rules to argue that
    [8] is [beautiful], for instance:
         ----------- (b_5)   ----------- (b_3)
         beautiful 5         beautiful 3
         ------------------------------- (b_sum)
                   beautiful 8
*)

(** **** Exercise: 1 star (varieties_of_beauty)  *)
(** How many different ways are there to show that [8] is [beautiful]? *)

(* Infinite, because you can destruct 8 as 0 + 8 as long as you want. *)
(** [] *)

(* ####################################################### *)
(** ** Constructing Evidence *)

(** In Coq, we can express the definition of [beautiful] as
    follows: *)

Inductive beautiful : nat -> Prop :=
  b_0   : beautiful 0
| b_3   : beautiful 3
| b_5   : beautiful 5
| b_sum : forall n m, beautiful n -> beautiful m -> beautiful (n+m).

(** *** *)
(**
    The rules introduced this way have the same status as proven
    theorems; that is, they are true axiomatically.
    So we can use Coq's [apply] tactic with the rule names to prove
    that particular numbers are [beautiful].  *)

Theorem three_is_beautiful: beautiful 3.
Proof.
   (* This simply follows from the rule [b_3]. *)
   apply b_3.
Qed.

Theorem eight_is_beautiful: beautiful 8.
Proof.
   (* First we use the rule [b_sum], telling Coq how to
      instantiate [n] and [m]. *)
   apply b_sum with (n:=3) (m:=5).
   (* To solve the subgoals generated by [b_sum], we must provide
      evidence of [beautiful 3] and [beautiful 5]. Fortunately we
      have rules for both. *)
   apply b_3.
   apply b_5.
Qed.

(** *** *)
(** As you would expect, we can also prove theorems that have
hypotheses about [beautiful]. *)

Theorem beautiful_plus_eight: forall n, beautiful n -> beautiful (8+n).
Proof.
  intros n B.
  apply b_sum with (n:=8) (m:=n).
  apply eight_is_beautiful.
  apply B.
Qed.

(** **** Exercise: 2 stars (b_times2)  *)
SearchAbout ["_0"].

Theorem b_times2: forall n, beautiful n -> beautiful (2*n).
Proof.
  intros n.
  induction n.
  simpl.
  intros H.
  apply H.
  intros H.
  apply b_sum. apply H.
  rewrite plus_0_r.
  apply H.
  Qed.
(** [] *)
SearchAbout ["S"].
(** **** Exercise: 3 stars (b_timesm)  *)
Theorem b_timesm: forall n m, beautiful n -> beautiful (m*n).
Proof.
  intros n m H.
  induction m as [| m'].
  simpl.
  apply b_0.
  rewrite <- plus_1_l.
  rewrite mult_plus_distr_r.
  apply b_sum.
  simpl.
  rewrite plus_0_r.
  apply H.
  apply IHm'.
  Qed.

(* ####################################################### *)
(** * Using Evidence in Proofs *)
(** ** Induction over Evidence *)

(** Besides _constructing_ evidence that numbers are beautiful, we can
    also _reason about_ such evidence. *)

(** The fact that we introduced [beautiful] with an [Inductive]
    declaration tells Coq not only that the constructors [b_0], [b_3],
    [b_5] and [b_sum] are ways to build evidence, but also that these
    four constructors are the _only_ ways to build evidence that
    numbers are beautiful. *)

(** In other words, if someone gives us evidence [E] for the assertion
    [beautiful n], then we know that [E] must have one of four shapes:

      - [E] is [b_0] (and [n] is [O]),
      - [E] is [b_3] (and [n] is [3]),
      - [E] is [b_5] (and [n] is [5]), or
      - [E] is [b_sum n1 n2 E1 E2] (and [n] is [n1+n2], where [E1] is
        evidence that [n1] is beautiful and [E2] is evidence that [n2]
        is beautiful). *)

(** *** *)
(** This permits us to _analyze_ any hypothesis of the form [beautiful
    n] to see how it was constructed, using the tactics we already
    know.  In particular, we can use the [induction] tactic that we
    have already seen for reasoning about inductively defined _data_
    to reason about inductively defined _evidence_.

    To illustrate this, let's define another property of numbers: *)

Inductive gorgeous : nat -> Prop :=
  g_0 : gorgeous 0
| g_plus3 : forall n, gorgeous n -> gorgeous (3+n)
| g_plus5 : forall n, gorgeous n -> gorgeous (5+n).

(** **** Exercise: 1 star (gorgeous_tree)  *)
(** Write out the definition of [gorgeous] numbers using inference rule
    notation.

(* --------- (g_0)
gorgeous0
gorgeous n
-------------- (g_plus3)
gorgeous (n+3)
gorgeous n
-------------- (g_plus5)
gorgeous (n+5) *)
[]
*)

(** **** Exercise: 1 star (gorgeous_plus13)  *)
Theorem gorgeous_plus13: forall n,
  gorgeous n -> gorgeous (13+n).
Proof.
  intros.
  repeat apply g_plus5.
  apply g_plus3.
  apply H.
  Qed.

(** [] *)

(** *** *)
(** It seems intuitively obvious that, although [gorgeous] and
    [beautiful] are presented using slightly different rules, they are
    actually the same property in the sense that they are true of the
    same numbers.  Indeed, we can prove this. *)

Theorem gorgeous__beautiful_FAILED : forall n,
  gorgeous n -> beautiful n.
Proof.
   intros. induction n as [| n'].
   Case "n = 0". apply b_0.
   Case "n = S n'". (* We are stuck! *)
Abort.

(** The problem here is that doing induction on [n] doesn't yield a
    useful induction hypothesis. Knowing how the property we are
    interested in behaves on the predecessor of [n] doesn't help us
    prove that it holds for [n]. Instead, we would like to be able to
    have induction hypotheses that mention other numbers, such as [n -
    3] and [n - 5]. This is given precisely by the shape of the
    constructors for [gorgeous]. *)

(** *** *)

(** Let's see what happens if we try to prove this by induction on the evidence [H]
   instead of on [n]. *)

Theorem gorgeous__beautiful : forall n,
  gorgeous n -> beautiful n.
Proof.
   intros n H.
   induction H as [|n'|n'].
   Case "g_0".
       apply b_0.
   Case "g_plus3".
       apply b_sum. apply b_3.
       apply IHgorgeous.
   Case "g_plus5".
       apply b_sum. apply b_5. apply IHgorgeous.
Qed.

(* These exercises also require the use of induction on the evidence. *)

(** **** Exercise: 2 stars (gorgeous_sum)  *)
Theorem gorgeous_sum : forall n m,
  gorgeous n -> gorgeous m -> gorgeous (n + m).
Proof.
  intros n m H1 H2.
  induction H1.
  simpl.
  apply H2.
  simpl.
  apply g_plus3.
  apply IHgorgeous.
  simpl.
  apply g_plus5.
  apply IHgorgeous.
  Qed.
(** [] *)

(** **** Exercise: 3 stars, advanced (beautiful__gorgeous)  *)
Theorem beautiful__gorgeous : forall n, beautiful n -> gorgeous n.
Proof.
  intros n H.
  induction H.
  apply g_0.
  apply g_plus3.   apply g_0.
  apply g_plus5.   apply g_0.
  apply gorgeous_sum.
  apply IHbeautiful1.
  apply IHbeautiful2.
  Qed.

(** [] *)

(** **** Exercise: 3 stars, optional (g_times2)  *)
(** Prove the [g_times2] theorem below without using [gorgeous__beautiful].
    You might find the following helper lemma useful. *)

Lemma helper_g_times2 : forall x y z, x + (z + y) = z + x + y.
Proof.
  intros x y z.
  rewrite plus_swap.
  rewrite plus_assoc.
  reflexivity.
  Qed.

Theorem g_times2: forall n, gorgeous n -> gorgeous (2*n).
Proof.
   intros n H. simpl.
   induction H.
   simpl.
   apply g_0.
   rewrite  helper_g_times2;
   rewrite plus_swap; simpl;
   repeat apply g_plus3.
   rewrite <- plus_assoc.
   apply IHgorgeous.
   rewrite  helper_g_times2.
   rewrite plus_swap. simpl.
   repeat apply g_plus5.
   rewrite <- plus_assoc.
   apply IHgorgeous.
   Qed.

(** [] *)

(** Here is a proof that the inductive definition of evenness implies
the computational one. *)

Theorem ev__even : forall n,
  ev n -> even n.
Proof.
  intros n E. induction E as [| n' E'].
  Case "E = ev_0".
    unfold even. reflexivity.
  Case "E = ev_SS n' E'".
    unfold even. apply IHE'.
Qed.

(** **** Exercise: 1 star (ev__even)  *)
(** Could this proof also be carried out by induction on [n] instead
    of [E]?  If not, why not? *)

(* no, because induction on n can not really tell us information about the ev status. *)
(** [] *)

(** Intuitively, the induction principle [ev n] evidence [ev n] is
    similar to induction on [n], but restricts our attention to only
    those numbers for which evidence [ev n] could be generated. *)

(** **** Exercise: 1 star (l_fails)  *)
(** The following proof attempt will not succeed.
     Theorem l : forall n,
       ev n.
     Proof.
       intros n. induction n.
         Case "O". simpl. apply ev_0.
         Case "S".
           ...
   Intuitively, we expect the proof to fail because not every
   number is even. However, what exactly causes the proof to fail?
Because we cannot prove some number that is not even to be even.
(* FILL IN HERE *)
*)
(** [] *)

(** Here's another exercise requiring induction on evidence. *)
(** **** Exercise: 2 stars (ev_sum)  *)
SearchAbout ["ev_"].
Theorem ev_sum : forall n m,
   ev n -> ev m -> ev (n+m).
Proof.
  intros n m H1 H2.
  induction H1.
  simpl. apply H2.
  simpl.
  apply ev_SS.
  apply IHev.
  Qed.
(** [] *)

(* ####################################################### *)
(** ** Inversion on Evidence *)

(** Having evidence for a proposition is useful while proving, because we
   can _look_ at that evidence for more information. For example, consider
    proving that, if [n] is even, then [pred (pred n)] is
    too.  In this case, we don't need to do an inductive proof.  Instead
    the [inversion] tactic provides all of the information that we need.

 *)

Theorem ev_minus2: forall n,  ev n -> ev (pred (pred n)).
Proof.
  intros n E.
  inversion E as [| n' E'].
  Case "E = ev_0". simpl. apply ev_0.
  Case "E = ev_SS n' E'". simpl. apply E'.  Qed.

(** **** Exercise: 1 star, optional (ev_minus2_n)  *)
(** What happens if we try to use [destruct] on [n] instead of [inversion] on [E]? *)

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

(** *** *)
(** Here is another example, in which [inversion] helps narrow down to
the relevant cases. *)

Theorem SSev__even : forall n,
  ev (S (S n)) -> ev n.
Proof.
  intros n E.
  inversion E as [| n' E'].
  apply E'. Qed.

(** ** The Inversion Tactic Revisited *)

(** These uses of [inversion] may seem a bit mysterious at first.
    Until now, we've only used [inversion] on equality
    propositions, to utilize injectivity of constructors or to
    discriminate between different constructors.  But we see here
    that [inversion] can also be applied to analyzing evidence
    for inductively defined propositions.

    (You might also expect that [destruct] would be a more suitable
    tactic to use here. Indeed, it is possible to use [destruct], but
    it often throws away useful information, and the [eqn:] qualifier
    doesn't help much in this case.)

    Here's how [inversion] works in general.  Suppose the name
    [I] refers to an assumption [P] in the current context, where
    [P] has been defined by an [Inductive] declaration.  Then,
    for each of the constructors of [P], [inversion I] generates
    a subgoal in which [I] has been replaced by the exact,
    specific conditions under which this constructor could have
    been used to prove [P].  Some of these subgoals will be
    self-contradictory; [inversion] throws these away.  The ones
    that are left represent the cases that must be proved to
    establish the original goal.

    In this particular case, the [inversion] analyzed the construction
    [ev (S (S n))], determined that this could only have been
    constructed using [ev_SS], and generated a new subgoal with the
    arguments of that constructor as new hypotheses.  (It also
    produced an auxiliary equality, which happens to be useless here.)
    We'll begin exploring this more general behavior of inversion in
    what follows. *)

(** **** Exercise: 1 star (inversion_practice)  *)
Theorem SSSSev__even : forall n,
  ev (S (S (S (S n)))) -> ev n.
Proof.
  intros.
  inversion H.
  inversion H1.
  apply H3.
  Qed.

(** The [inversion] tactic can also be used to derive goals by showing
    the absurdity of a hypothesis. *)

Theorem even5_nonsense :
  ev 5 -> 2 + 2 = 9.
Proof.
  intros.
  inversion H.
  inversion H1.
  inversion H3.
  Qed.
(** [] *)

(** **** Exercise: 3 stars, advanced (ev_ev__ev)  *)
(** Finding the appropriate thing to do induction on is a
    bit tricky here: *)

SearchAbout ["_0"].

Theorem mytool1 : forall n m,
                    n+m = 0 -> n=0.
Proof.
  intros. induction m.
  rewrite plus_0_r in H.
  apply H.
  inversion H.
  induction n.
  simpl.
  simpl in H.
  rewrite H. reflexivity.
  inversion H.
  Qed.

SearchAbout ["ev_"].

Theorem ev_ev__ev : forall n m,
  ev (n+m) -> ev n -> ev m.
Proof.
  intros n m H1 H2.
  induction H2.
  simpl in H1. apply H1.
  apply IHev.
  simpl in H1.
  inversion H1.
  apply H0.
  Qed.

(** [] *)

(** **** Exercise: 3 stars, optional (ev_plus_plus)  *)
(** Here's an exercise that just requires applying existing lemmas.  No
    induction or even case analysis is needed, but some of the rewriting
    may be tedious. *)

Theorem ev_plus_plus : forall n m p,
  ev (n+m) -> ev (n+p) -> ev (m+p).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ####################################################### *)
(** * Discussion and Variations *)
(** ** Computational vs. Inductive Definitions *)

(** We have seen that the proposition "[n] is even" can be
    phrased in two different ways -- indirectly, via a boolean testing
    function [evenb], or directly, by inductively describing what
    constitutes evidence for evenness.  These two ways of defining
    evenness are about equally easy to state and work with.  Which we
    choose is basically a question of taste.

    However, for many other properties of interest, the direct
    inductive definition is preferable, since writing a testing
    function may be awkward or even impossible.

    One such property is [beautiful].  This is a perfectly sensible
    definition of a set of numbers, but we cannot translate its
    definition directly into a Coq Fixpoint (or into a recursive
    function in any other common programming language).  We might be
    able to find a clever way of testing this property using a
    [Fixpoint] (indeed, it is not too hard to find one in this case),
    but in general this could require arbitrarily deep thinking.  In
    fact, if the property we are interested in is uncomputable, then
    we cannot define it as a [Fixpoint] no matter how hard we try,
    because Coq requires that all [Fixpoint]s correspond to
    terminating computations.

    On the other hand, writing an inductive definition of what it
    means to give evidence for the property [beautiful] is
    straightforward. *)

(* ####################################################### *)
(** ** Parameterized Data Structures *)

(** So far, we have only looked at propositions about natural numbers. However,
   we can define inductive predicates about any type of data. For example,
   suppose we would like to characterize lists of _even_ length. We can
   do that with the following definition.  *)

Inductive ev_list {X:Type} : list X -> Prop :=
  | el_nil : ev_list []
  | el_cc  : forall x y l, ev_list l -> ev_list (x :: y :: l).

(** Of course, this proposition is equivalent to just saying that the
length of the list is even. *)

Lemma ev_list__ev_length: forall X (l : list X), ev_list l -> ev (length l).
Proof.
    intros X l H. induction H.
    Case "el_nil". simpl. apply ev_0.
    Case "el_cc".  simpl.  apply ev_SS. apply IHev_list.
Qed.

(** However, because evidence for [ev] contains less information than
evidence for [ev_list], the converse direction must be stated very
carefully. *)

Lemma ev_length__ev_list: forall X n, ev n -> forall (l : list X), n = length l -> ev_list l.
Proof.
  intros X n H.
  induction H.
  Case "ev_0". intros l H. destruct l.
    SCase "[]". apply el_nil.
    SCase "x::l". inversion H.
  Case "ev_SS". intros l H2. destruct l.
    SCase "[]". inversion H2. destruct l.
    SCase "[x]". inversion H2.
    SCase "x :: x0 :: l". apply el_cc. apply IHev. inversion H2. reflexivity.
Qed.

(** **** Exercise: 4 stars (palindromes)  *)
(** A palindrome is a sequence that reads the same backwards as
    forwards.

    - Define an inductive proposition [pal] on [list X] that
      captures what it means to be a palindrome. (Hint: You'll need
      three cases.  Your definition should be based on the structure
      of the list; just having a single constructor
        c : forall l, l = rev l -> pal l
      may seem obvious, but will not work very well.)

    - Prove [pal_app_rev] that
       forall l, pal (l ++ rev l).
    - Prove [pal_rev] that
       forall l, pal l -> l = rev l.
*)

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

(* Again, the converse direction is much more difficult, due to the
lack of evidence. *)

(** **** Exercise: 5 stars, optional (palindrome_converse)  *)
(** Using your definition of [pal] from the previous exercise, prove
    that
     forall l, l = rev l -> pal l.
*)

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

(* ####################################################### *)
(** ** Relations *)

(** A proposition parameterized by a number (such as [ev] or
    [beautiful]) can be thought of as a _property_ -- i.e., it defines
    a subset of [nat], namely those numbers for which the proposition
    is provable.  In the same way, a two-argument proposition can be
    thought of as a _relation_ -- i.e., it defines a set of pairs for
    which the proposition is provable. *)

Module LeModule.

(** One useful example is the "less than or equal to"
    relation on numbers. *)

(** The following definition should be fairly intuitive.  It
    says that there are two ways to give evidence that one number is
    less than or equal to another: either observe that they are the
    same number, or give evidence that the first is less than or equal
    to the predecessor of the second. *)

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

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

(** Proofs of facts about [<=] using the constructors [le_n] and
    [le_S] follow the same patterns as proofs about properties, like
    [ev] in chapter [Prop].  We can [apply] the constructors to prove [<=]
    goals (e.g., to show that [3<=3] or [3<=6]), and we can use
    tactics like [inversion] to extract information from [<=]
    hypotheses in the context (e.g., to prove that [(2 <= 1) -> 2+2=5].) *)

(** *** *)
(** Here are some sanity checks on the definition.  (Notice that,
    although these are the same kind of simple "unit tests" as we gave
    for the testing functions we wrote in the first few lectures, we
    must construct their proofs explicitly -- [simpl] and
    [reflexivity] don't do the job, because the proofs aren't just a
    matter of simplifying computations.) *)

Theorem test_le1 :
  3 <= 3.
Proof.
  (* WORKED IN CLASS *)
  apply le_n.  Qed.

Theorem test_le2 :
  3 <= 6.
Proof.
  (* WORKED IN CLASS *)
  apply le_S. apply le_S. apply le_S. apply le_n.  Qed.

Theorem test_le3 :
  (2 <= 1) -> 2 + 2 = 5.
Proof.
  (* WORKED IN CLASS *)
  intros H. inversion H. inversion H2.  Qed.

(** *** *)
(** The "strictly less than" relation [n < m] can now be defined
    in terms of [le]. *)

End LeModule.

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

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

(** Here are a few more simple relations on numbers: *)

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

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

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

(** **** Exercise: 2 stars (total_relation)  *)
(** Define an inductive binary relation [total_relation] that holds
    between every pair of natural numbers. *)
Inductive total_relation : nat -> nat -> Prop :=
  tr : forall n m, total_relation n m.
(* FILL IN HERE *)
(** [] *)

(** **** Exercise: 2 stars (empty_relation)  *)
(** Define an inductive binary relation [empty_relation] (on numbers)
    that never holds. *)
Inductive empty_relation : nat -> nat -> Prop :=
  er : forall n m, 1+1=3 -> empty_relation n m.

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

(** **** Exercise: 2 stars, optional (le_exercises)  *)
(** Here are a number of facts about the [<=] and [<] relations that
    we are going to need later in the course.  The proofs make good
    practice exercises. *)

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

Lemma le_trans : forall m n o, m <= n -> n <= o -> m <= o.
Proof.
  intros.
  induction H.
  apply H0.
  apply IHle.
  apply Sn_le_m__n_le_m.
  apply H0. Qed.

Theorem O_le_n : forall n,
  0 <= n.
Proof.
  intros.
  induction n.
  apply le_n.
  apply le_S.
  apply IHn. Qed.

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

Theorem Sn_le_Sm__n_le_m : forall n m,
  S n <= S m -> n <= m.
Proof.
  intros.
  inversion H.
  apply le_n.
  apply Sn_le_m__n_le_m in H1.
  apply H1.
  Qed.

Theorem le_plus_l : forall a b,
  a <= a + b.
Proof.
  intros.
  induction a.
  apply O_le_n.
  simpl. apply n_le_m__Sn_le_Sm. apply IHa. Qed.

SearchAbout ["plus"].
Theorem plus_lt : forall n1 n2 m,
  n1 + n2 < m ->
  n1 < m /\ n2 < m.
Proof.
 unfold lt.
 intros.
 split.
 induction n2.
 rewrite plus_0_r in H.
 apply H.
 apply IHn2.
 apply Sn_le_m__n_le_m in H.
 rewrite plus_n_Sm. apply H.
 induction n1.
 simpl in H.
 apply H.
 apply IHn1.
 apply Sn_le_m__n_le_m in H.
 simpl in H.
 apply H.
 Qed.

Theorem lt_S : forall n m,
  n < m ->
  n < S m.
Proof.
  unfold lt.
  intros.
  apply Sn_le_m__n_le_m in H.
  apply n_le_m__Sn_le_Sm.
  apply H.
Qed.

Theorem ble_nat_true : forall n m,
  ble_nat n m = true -> n <= m.
Proof.
  intros n.
  induction n.
  intros.
  apply O_le_n.
  intros.
  destruct m.
  inversion H.
  apply n_le_m__Sn_le_Sm.
  apply IHn.
  inversion H.
  reflexivity. Qed.

SearchAbout ["ble"].

Theorem le_ble_nat : forall n m,
  n <= m ->
  ble_nat n m = true.
Proof.
  intros n m.
  generalize dependent n.
  induction m.
  intros.
  inversion H.
  reflexivity.
  intros.
  destruct n.
  simpl.
  reflexivity.
  simpl.
  apply IHm.
  apply Sn_le_Sm__n_le_m in H. apply H. Qed.

Theorem ble_nat_true_trans : forall n m o,
  ble_nat n m = true -> ble_nat m o = true -> ble_nat n o = true.
Proof.
  (* Hint: This theorem can be easily proved without using [induction]. *)
  intros.
  apply ble_nat_true in H.
  apply ble_nat_true in H0.
  apply le_ble_nat.
  generalize dependent H0.
  apply le_trans.
  apply H.
  Qed.

(** **** Exercise: 2 stars, optional (ble_nat_false)  *)
Theorem ble_nat_false : forall n m,
  ble_nat n m = false -> ~(n <= m).
Proof.
  intros n m.
  generalize dependent n.
  unfold not.
  induction m as [| m'].
  intros.
  inversion H0.
  rewrite H1 in H. inversion H.
  intros.
  destruct n as [| n'].
  inversion H.
  simpl in H.
  apply IHm' in H. apply H.
  apply Sn_le_Sm__n_le_m in H0. apply H0. Qed.

(** **** Exercise: 3 stars (R_provability2)  *)
Module R.
(** We can define three-place relations, four-place relations,
    etc., in just the same way as binary relations.  For example,
    consider the following three-place relation on numbers: *)

Inductive R : nat -> nat -> nat -> Prop :=
   | c1 : R 0 0 0
   | c2 : forall m n o, R m n o -> R (S m) n (S o)
   | c3 : forall m n o, R m n o -> R m (S n) (S o)
   | c4 : forall m n o, R (S m) (S n) (S (S o)) -> R m n o
   | c5 : forall m n o, R m n o -> R n m o.

(** - Which of the following propositions are provable?
      - [R 1 1 2]
      - [R 2 2 6]

    - If we dropped constructor [c5] from the definition of [R],
      would the set of provable propositions change?  Briefly (1
      sentence) explain your answer.

    - If we dropped constructor [c4] from the definition of [R],
      would the set of provable propositions change?  Briefly (1
      sentence) explain your answer.

(* FILL IN HERE *)
[]
*)

(** **** Exercise: 3 stars, optional (R_fact)  *)
(** Relation [R] actually encodes a familiar function.  State and prove two
    theorems that formally connects the relation and the function.
    That is, if [R m n o] is true, what can we say about [m],
    [n], and [o], and vice versa?
*)

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

End R.

(** **** Exercise: 4 stars, advanced (subsequence)  *)
(** A list is a _subsequence_ of another list if all of the elements
    in the first list occur in the same order in the second list,
    possibly with some extra elements in between. For example,
    [1,2,3]
    is a subsequence of each of the lists
    [1,2,3]
    [1,1,1,2,2,3]
    [1,2,7,3]
    [5,6,1,9,9,2,7,3,8]
    but it is _not_ a subsequence of any of the lists
    [1,2]
    [1,3]
    [5,6,2,1,7,3,8]

    - Define an inductive proposition [subseq] on [list nat] that
      captures what it means to be a subsequence. (Hint: You'll need
      three cases.)

    - Prove [subseq_refl] that subsequence is reflexive, that is,
      any list is a subsequence of itself.

    - Prove [subseq_app] that for any lists [l1], [l2], and [l3],
      if [l1] is a subsequence of [l2], then [l1] is also a subsequence
      of [l2 ++ l3].

    - (Optional, harder) Prove [subseq_trans] that subsequence is
      transitive -- that is, if [l1] is a subsequence of [l2] and [l2]
      is a subsequence of [l3], then [l1] is a subsequence of [l3].
      Hint: choose your induction carefully!
*)

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

(** **** Exercise: 2 stars, optional (R_provability)  *)
(** Suppose we give Coq the following definition:
    Inductive R : nat -> list nat -> Prop :=
      | c1 : R 0 []
      | c2 : forall n l, R n l -> R (S n) (n :: l)
      | c3 : forall n l, R (S n) l -> R n l.
    Which of the following propositions are provable?

    - [R 2 [1,0]]
    - [R 1 [1,2,1,0]]
    - [R 6 [3,2,1,0]]

Answer: 1 and 2 are provable
*)

(** [] *)

(* ##################################################### *)
(** * Programming with Propositions *)

(** As we have seen, a _proposition_ is a statement expressing a factual claim,
    like "two plus two equals four."  In Coq, propositions are written
    as expressions of type [Prop]. . *)

Check (2 + 2 = 4).
(* ===> 2 + 2 = 4 : Prop *)

Check (ble_nat 3 2 = false).
(* ===> ble_nat 3 2 = false : Prop *)

Check (beautiful 8).
(* ===> beautiful 8 : Prop *)

(** *** *)
(** Both provable and unprovable claims are perfectly good
    propositions.  Simply _being_ a proposition is one thing; being
    _provable_ is something else! *)

Check (2 + 2 = 5).
(* ===> 2 + 2 = 5 : Prop *)

Check (beautiful 4).
(* ===> beautiful 4 : Prop *)

(** Both [2 + 2 = 4] and [2 + 2 = 5] are legal expressions
    of type [Prop]. *)

(** *** *)
(** We've mainly seen one place that propositions can appear in Coq: in
    [Theorem] (and [Lemma] and [Example]) declarations. *)

Theorem plus_2_2_is_4 :
  2 + 2 = 4.
Proof. reflexivity.  Qed.

(** But they can be used in many other ways.  For example, we have also seen that
    we can give a name to a proposition using a [Definition], just as we have
    given names to expressions of other sorts. *)

Definition plus_fact : Prop  :=  2 + 2 = 4.
Check plus_fact.
(* ===> plus_fact : Prop *)

(** We can later use this name in any situation where a proposition is
    expected -- for example, as the claim in a [Theorem] declaration. *)

Theorem plus_fact_is_true :
  plus_fact.
Proof. reflexivity.  Qed.

(** *** *)
(** We've seen several ways of constructing propositions.

       - We can define a new proposition primitively using [Inductive].

       - Given two expressions [e1] and [e2] of the same type, we can
         form the proposition [e1 = e2], which states that their
         values are equal.

       - We can combine propositions using implication and
         quantification. *)
(** *** *)
(** We have also seen _parameterized propositions_, such as [even] and
    [beautiful]. *)

Check (even 4).
(* ===> even 4 : Prop *)
Check (even 3).
(* ===> even 3 : Prop *)
Check even.
(* ===> even : nat -> Prop *)

(** *** *)
(** The type of [even], i.e., [nat->Prop], can be pronounced in
    three equivalent ways: (1) "[even] is a _function_ from numbers to
    propositions," (2) "[even] is a _family_ of propositions, indexed
    by a number [n]," or (3) "[even] is a _property_ of numbers."  *)

(** Propositions -- including parameterized propositions -- are
    first-class citizens in Coq.  For example, we can define functions
    from numbers to propositions... *)

Definition between (n m o: nat) : Prop :=
  andb (ble_nat n o) (ble_nat o m) = true.

(** ... and then partially apply them: *)

Definition teen : nat->Prop := between 13 19.

(** We can even pass propositions -- including parameterized
    propositions -- as arguments to functions: *)

Definition true_for_zero (P:nat->Prop) : Prop :=
  P 0.

(** *** *)
(** Here are two more examples of passing parameterized propositions
    as arguments to a function.

    The first function, [true_for_all_numbers], takes a proposition
    [P] as argument and builds the proposition that [P] is true for
    all natural numbers. *)

Definition true_for_all_numbers (P:nat->Prop) : Prop :=
  forall n, P n.

(** The second, [preserved_by_S], takes [P] and builds the proposition
    that, if [P] is true for some natural number [n'], then it is also
    true by the successor of [n'] -- i.e. that [P] is _preserved by
    successor_: *)

Definition preserved_by_S (P:nat->Prop) : Prop :=
  forall n', P n' -> P (S n').

(** *** *)
(** Finally, we can put these ingredients together to define
a proposition stating that induction is valid for natural numbers: *)

Definition natural_number_induction_valid : Prop :=
  forall (P:nat->Prop),
    true_for_zero P ->
    preserved_by_S P ->
    true_for_all_numbers P.

(** **** Exercise: 3 stars (combine_odd_even)  *)
(** Complete the definition of the [combine_odd_even] function
    below. It takes as arguments two properties of numbers [Podd] and
    [Peven]. As its result, it should return a new property [P] such
    that [P n] is equivalent to [Podd n] when [n] is odd, and
    equivalent to [Peven n] otherwise. *)

Definition combine_odd_even (Podd Peven : nat -> Prop) : nat -> Prop :=
  (* FILL IN HERE *) admit.

(** To test your definition, see whether you can prove the following
    facts: *)

Theorem combine_odd_even_intro :
  forall (Podd Peven : nat -> Prop) (n : nat),
    (oddb n = true -> Podd n) ->
    (oddb n = false -> Peven n) ->
    combine_odd_even Podd Peven n.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem combine_odd_even_elim_odd :
  forall (Podd Peven : nat -> Prop) (n : nat),
    combine_odd_even Podd Peven n ->
    oddb n = true ->
    Podd n.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem combine_odd_even_elim_even :
  forall (Podd Peven : nat -> Prop) (n : nat),
    combine_odd_even Podd Peven n ->
    oddb n = false ->
    Peven n.
Proof.
  (* FILL IN HERE *) Admitted.

(** [] *)

(* ##################################################### *)
(** One more quick digression, for adventurous souls: if we can define
    parameterized propositions using [Definition], then can we also
    define them using [Fixpoint]?  Of course we can!  However, this
    kind of "recursive parameterization" doesn't correspond to
    anything very familiar from everyday mathematics.  The following
    exercise gives a slightly contrived example. *)

(** **** Exercise: 4 stars, optional (true_upto_n__true_everywhere)  *)
(** Define a recursive function
    [true_upto_n__true_everywhere] that makes
    [true_upto_n_example] work. *)

(*
Fixpoint true_upto_n__true_everywhere
(* FILL IN HERE *)

Example true_upto_n_example :
    (true_upto_n__true_everywhere 3 (fun n => even n))
  = (even 3 -> even 2 -> even 1 -> forall m : nat, even m).
Proof. reflexivity.  Qed.
*)
(** [] *)

(** $Date: 2014-12-31 11:17:56 -0500 (Wed, 31 Dec 2014) $ *)


Require Import FunInd.

Inductive is_even : nat -> Prop :=
| is_even_O : is_even 0
| is_even_S : forall n : nat, is_even n -> is_even (S (S n)).

Fixpoint even (n : nat) : Prop :=
  match n with
  | 0 => True
  | 1 => False
  | (S (S n)) => even n
  end.

Functional Scheme even_ind := Induction for even Sort Prop.

Theorem even_sound :
  forall (n : nat) (v : Prop), (even n) = True -> is_even n.

Proof.
intro.
intro.
functional induction (even n) using even_ind; intros.
apply is_even_O.
elimtype False.
rewrite H.
auto.
apply is_even_S.
apply IHP.
assumption.
Qed.

Theorem even_complete : forall (n : nat) (v : Prop), is_even n -> (even n) = True.
intro.
intro.
intro.
induction H.
simpl.
reflexivity.
simpl.
assumption.
Qed.

Inductive is_fact : nat -> nat -> Prop :=
| is_fact_1 : is_fact 0 1
| is_fact_S : forall (n : nat) (r : nat), is_fact n r -> is_fact (S n) ((S n) * r).

Fixpoint fact (n : nat) : nat :=
  match n with
  | 0 => 1
  | (S n) => (S n) * (fact n)
  end.

Functional Scheme fact_ind := Induction for fact Sort Prop.

Theorem fact_sound :
  forall (n : nat) (r : nat), (fact n) = r -> is_fact n r.

Proof.
intro.
functional induction (fact n) using fact_ind; intros.
rewrite <- H.
apply is_fact_1.
elim H.
apply is_fact_S.
apply IHn0.
reflexivity.
Qed.

Open Scope list_scope.
Inductive is_perm : list nat -> list nat -> Prop :=
| perm_base : forall (l : list nat) (a : nat), is_perm (a :: l) (l ++ a::nil)
| perm_ind  : forall (l1 : list nat) (l2 : list nat) (a : nat), is_perm l1 l2 -> is_perm (a :: l1) (a :: l2)
| perm_ref  : forall (l1 : list nat) (l2 : list nat), l1 = l2 -> is_perm l1 l2
| perm_tran : forall (l1 : list nat) (l2 : list nat) (l3 : list nat), (is_perm l1 l2) -> (is_perm l2 l3) -> is_perm l1 l3
| perm_sem  : forall (l1 : list nat) (l2 : list nat), is_perm l1 l2 -> is_perm l2 l1.

Lemma trans_1 : is_perm (1::2::3::nil) (3::2::1::nil).
apply (perm_tran (1::2::3::nil) ((2::3::nil)++(1::nil)) (3::2::1::nil)).
apply perm_base.
simpl.
apply (perm_tran (2::3::1::nil) ((3::1::nil)++(2::nil)) (3::2::1::nil)).
apply perm_base.
simpl.
apply perm_ind.
apply (perm_tran (1::2::nil) ((1::nil)++(2::nil)) (2::1::nil)).
simpl.
apply perm_ref.
reflexivity.
apply perm_base.
Qed.

Inductive sorted : list nat -> Prop :=
| sorted_empty  : sorted nil
| sorted_one    : forall n : nat, sorted (n::nil)
| sorted_rec    : forall (n : nat) (m : nat) (l : list nat), n <= m -> sorted (m::l) -> sorted (n::m::l).

Lemma sort_1 : sorted (1::2::3::nil).
apply sorted_rec.
apply le_S.
apply le_n.
apply sorted_rec.
apply le_S.
apply le_n.
apply sorted_one.
Qed.

Require Import Compare_dec.
Fixpoint insert (x : nat) (l : list nat) : list nat :=
  match l with
  | nil => (x::nil)
  | h::t => match (le_dec x h) with
            | left _ => (x::h::t)
            | right _ => (h::(insert x t))
  end
end.

Fixpoint sort (l : list nat) : list nat :=
  match l with
  | nil => nil
  | h::t => insert h (sort t)
end.

Functional Scheme sort_ind := Induction for sort Sort Prop.
Functional Scheme insert_ind := Induction for insert Sort Prop.

Require Export Omega.
Lemma perm_insert : forall (a : nat) (l : list nat), is_perm (a::l) (insert a l).
intros.
functional induction (insert a l) using insert_ind.
apply perm_ref.
reflexivity.
apply perm_ref.
reflexivity.
apply (perm_tran (a::h::t) (h::a::t) (h::insert a t)).
apply (perm_tran (a::h::t) ((h::t)++(a::nil)) (h::a::t)).
apply perm_base.
simpl.
apply perm_ind.
apply perm_sem.
apply perm_base.
apply perm_ind.
apply IHl0.
Qed.

Lemma sort_insert : forall (a : nat) (l : list nat), sorted l -> sorted (insert a l).
intros.
elim H.
simpl.
apply sorted_one.
intros.
simpl.
elim (le_dec a n).
intros.
apply sorted_rec.
omega.
apply sorted_one.
intros.
apply sorted_rec.
omega.
apply sorted_one.
intros n m.
simpl.
elim (le_dec a m).
intros.
elim (le_dec a n).
intros.
apply sorted_rec.
omega.
apply sorted_rec.
omega.
apply H1.
intros.
apply sorted_rec.
omega.
apply sorted_rec.
omega.
apply H1.
intros.
elim (le_dec a n).
intros.
apply sorted_rec.
omega.
apply sorted_rec.
omega.
apply H1.
intros.
apply sorted_rec.
auto.
auto.
Qed.
Theorem sort_sound :
  forall (l : list nat) (ls : list nat), sort l = ls -> (is_perm l ls) /\ (sorted ls).

Proof.
intro.
functional induction (sort l) using sort_ind; intros.
rewrite <- H.
split.
apply perm_ref.
reflexivity.
apply sorted_empty.
rewrite <- H.
split.
apply (perm_tran (h::t) (h::sort t) (insert h (sort t))).
apply perm_ind.
apply IHl0.
reflexivity.
apply perm_insert.
apply sort_insert.
apply IHl0.
reflexivity.
Qed.


Set Implicit Arguments.

Require Import Coq.Relations.Relations.

Class TotalOrder {A : Type} (R : relation A) := {
  reflexivity : forall (x : A), R x x;
  antisymmetry : forall (x y : A), R x y -> R y x -> x = y;
  transitivity : forall (x y z : A), R x y -> R y z -> R x z;
  compare : forall (x y : A), { R x y } + { R y x };
  eqdec : forall (x y : A), { x = y } + { x <> y }
}.

Require Import Coq.Arith.Le.
Require Import Coq.Arith.Compare_dec.
Require Import Coq.Arith.Peano_dec.

Instance TotalOrder_nat : @TotalOrder nat le.
Proof with auto with arith.
  split...
  intros. eauto with arith.
  intros.
  assert ({ x <= y } + {x >= y}) as H.
  { apply le_ge_dec. }
  destruct H...
Qed.

Inductive PairOrdering
  {A B : Type}
  (AR : relation A) (BR : relation B) : (A * B) -> (A * B) -> Prop :=
| MkPairOrdering1 : forall a b1 b2,
  BR b1 b2 ->
  PairOrdering AR BR (a,b1) (a,b2)
| MkPairOrdering2 : forall a1 a2 b1 b2,
  AR a1 a2 ->
  a1 <> a2 ->
  PairOrdering AR BR (a1,b1) (a2,b2).

Inductive SumOrdering  {A B : Type}
  (AR : relation A) (BR : relation B) : relation (A + B) :=
| MkSumOrdering1 : forall x y,
  SumOrdering AR BR (inl x) (inr y)
| MkSumOrdering2 : forall x y,
  AR x y ->
  SumOrdering AR BR (inl x) (inl y)
| MkSumOrdering3 : forall x y,
  BR x y ->
  SumOrdering AR BR (inr x) (inr y).

Section SumOrdering.

  Hint Constructors SumOrdering.

  Variable A B : Type.
  Variable AR : relation A.
  Variable BR : relation B.
  Variable OrdA : TotalOrder AR.
  Variable OrdB : TotalOrder BR.

  Lemma SumOrdering_reflexivity : forall x, SumOrdering AR BR x x.
  Proof with eauto.
    destruct x...
    apply MkSumOrdering2...
    apply reflexivity.
    apply MkSumOrdering3...
    apply reflexivity.
  Qed.

  Lemma SumOrdering_antisymmetry : forall x y,
    SumOrdering AR BR x y ->
    SumOrdering AR BR y x ->
    x = y.
  Proof with eauto.
    intros.
    inversion H; subst.
    - inversion H0; subst.
    - inversion H0; subst.
      f_equal.
      apply antisymmetry...
    - inversion H0; subst.
      f_equal.
      apply antisymmetry...
  Qed.

  Lemma SumOrdering_transitivity : forall x y z,
    SumOrdering AR BR x y ->
    SumOrdering AR BR y z ->
    SumOrdering AR BR x z.
  Proof with eauto.
    intros.
    destruct x.
    destruct y.
    destruct z.
    inversion H; inversion H0; subst.
    - apply MkSumOrdering2...
      eapply transitivity...
    - apply MkSumOrdering1...
    - destruct z...
      inversion H0.
    - destruct y.
      inversion H.
      destruct z...
      inversion H0.
      eapply MkSumOrdering3...
      inversion H; subst.
      inversion H0; subst.
      eapply transitivity...
  Qed.

  Lemma SumOrdering_compare : forall x y,
    { SumOrdering AR BR x y } + { SumOrdering AR BR y x }.
  Proof with eauto.
    intros.
    destruct x.
    destruct y.
    + assert ({AR a a0} + {AR a0 a})...
      apply compare...
      destruct H...
    + left...
    + destruct y.
      - right...
      - assert ({BR b b0} + {BR b0 b})...
        apply compare...
        destruct H...
  Qed.

  Lemma SumOrdering_eqdec : forall (x y : A + B),
    { x = y } + { x <> y }.
  Proof with eauto.
    destruct x.
    destruct y.
    decide equality.
    + apply eqdec.
    + apply eqdec.
    + right. unfold not. intros. inversion H.
    + destruct y.
      - right. unfold not. intros. inversion H.
      - destruct (eqdec b b0); subst...
        right. unfold not. intros. inversion H. subst. contradiction n...
  Qed.

  Instance TotalOrder_sum :  TotalOrder (SumOrdering AR BR) := {
    reflexivity := SumOrdering_reflexivity;
    antisymmetry := SumOrdering_antisymmetry;
    transitivity := SumOrdering_transitivity;
    compare := SumOrdering_compare;
    eqdec := SumOrdering_eqdec
  }.

End SumOrdering.

Section PairOrdering.

  Hint Constructors PairOrdering.

  Variable A B : Type.
  Variable AR : relation A.
  Variable BR : relation B.
  Variable OrdA : TotalOrder AR.
  Variable OrdB : TotalOrder BR.

  Lemma PairOrdering_reflexivity : forall x, PairOrdering AR BR x x.
  Proof with eauto.
    destruct x...
    apply MkPairOrdering1...
    apply reflexivity.
  Qed.

  Lemma PairOrdering_antisymmetry : forall x y,
    PairOrdering AR BR x y ->
    PairOrdering AR BR y x ->
    x = y.
  Proof with eauto.
    intros.
    inversion H; subst.
    - inversion H0; subst.
      assert (b1 = b2). apply antisymmetry...
      subst...
      contradiction H7...
    - inversion H0; subst.
      contradiction H2...
      assert (a1 = a2). apply antisymmetry...
      subst.
      contradiction H2...
  Qed.

  Lemma PairOrdering_transitivity : forall x y z,
    PairOrdering AR BR x y ->
    PairOrdering AR BR y z ->
    PairOrdering AR BR x z.
  Proof with eauto.
    intros.
    destruct x.
    destruct y.
    destruct z.
    inversion H; inversion H0; subst.
    - apply MkPairOrdering1...
      eapply transitivity...
    - apply MkPairOrdering2...
    - apply MkPairOrdering2...
    - apply MkPairOrdering2...
      eapply transitivity...
      assert ({a = a1 } + { a <> a1 }). apply eqdec.
      destruct H1...
      subst.
      assert (a0 = a1). apply antisymmetry...
      subst...
  Qed.

  Lemma PairOrdering_compare : forall x y,
    { PairOrdering AR BR x y } + { PairOrdering AR BR y x }.
  Proof with eauto.
    intros.
    destruct x.
    destruct y.
    assert ({AR a a0} + {AR a0 a})...
    apply compare...
    assert ({BR b b0} + {BR b0 b})...
    apply compare...
    assert ({a = a0 } + { a <> a0 }). apply eqdec.
    destruct H1; subst...
    - destruct H0...
    - destruct H...
  Qed.

  Lemma PairOrdering_eqdec : forall (x y : A * B),
    { x = y } + { x <> y }.
  Proof with eauto.
    destruct x.
    destruct y.
    decide equality.
    apply eqdec.
    apply eqdec.
  Qed.

  Instance TotalOrder_pair :  TotalOrder (PairOrdering AR BR) := {
    reflexivity := PairOrdering_reflexivity;
    antisymmetry := PairOrdering_antisymmetry;
    transitivity := PairOrdering_transitivity;
    compare := PairOrdering_compare;
    eqdec := PairOrdering_eqdec
  }.

End PairOrdering.

Existing Instances TotalOrder_pair TotalOrder_sum.

Definition inverse (A B : Type) (f : A -> B) (g : B -> A) : Prop :=
  forall x, g (f x) = x.

Inductive ProjectOrdering (A B : Type) (f : A -> B) (BR : relation B) : relation A :=
  | MkProjOrdering : forall x y,
    BR (f x) (f y) ->
    ProjectOrdering f BR x y.

Hint Constructors ProjectOrdering.

Lemma TotalOrder_Project : forall (A B : Type) (f : A -> B)
   (g : B -> A)
   (RB : relation B)
   (OrdB : TotalOrder RB),
   inverse f g ->
   TotalOrder (ProjectOrdering f RB).
Proof with eauto.
  intros.
  destruct OrdB.
  split; intros.
  + eapply MkProjOrdering...
  + unfold inverse in H.
    inversion H0; inversion H1; subst...
    assert (f x = f y) as X.
    apply antisymmetry0...
    rewrite <- H.
    rewrite <- (H x).
    rewrite -> X...
  + inversion H0; inversion H1; subst...
  + destruct (compare0 (f x) (f y))...
  + destruct (eqdec0 (f x) (f y))...
    - left.
      rewrite <- H.
      rewrite <- (H x).
      rewrite -> e...
    - right.
      unfold not in *.
      intros.
      rewrite -> H0 in n.
      apply n.
      reflexivity.
Qed.


From mathcomp
  Require Import ssreflect ssrnat.

Section naturalNumber.

Lemma add0nEqn (n : nat) : 0 + n = n.
Proof. by []. Qed.

Lemma addn3Eq2n1 (n : nat) : n + 3 = 2 + n + 1.
Proof.
rewrite addn1.
rewrite add2n.
rewrite addnC.
by [].
Qed.

Fixpoint sum n := if n is m.+1 then sum m + n else 0.

Lemma sumGauss (n : nat) : sum n * 2 = (n + 1) * n.
Proof.
elim: n => [// | n IHn].
rewrite mulnC.
rewrite (_ : sum (n.+1) = n.+1 + (sum n)); last first.
rewrite /=.
by rewrite addnC.
rewrite mulnDr.
rewrite mulnC in IHn.
rewrite IHn.
rewrite 2!addn1.
rewrite [_ * n]mulnC.
rewrite -mulnDl.
by [].
Qed.

End naturalNumber.


From mathcomp
     Require Import ssreflect ssrnat.

Section naturalNumber.

  Lemma addOnEqn(n : nat) : 0 + n = n.
  Proof. by []. Qed.

  Lemma addn3Eq2n1 (n : nat) : n + 3 = 2 + n + 1.
  Proof.
    rewrite addn1.
    rewrite add2n.
    rewrite addnC.
    by [].
  Qed.

  Fixpoint sum n := if n is m.+1 then sum m + n else 0.

  Lemma sumGauss (n : nat) : sum n * 2 = (n + 1) * n.
  Proof.
    elim: n => [// | n IHn].
    rewrite mulnC.
    rewrite (_ : sum (n.+1) = n.+1 + (sum n)); last first.
    rewrite /=.
    by rewrite addnC.
    rewrite mulnDr.
    rewrite mulnC in IHn.
    rewrite IHn.
    rewrite 2!addn1.
    rewrite [_ * n]mulnC.
    rewrite -mulnDl.
    by [].
  Qed.

End naturalNumber.


Require Import Arith.

(* Exercise 6 *)

Goal forall x y, x < y -> x + 10 < y + 10.
Proof.
intros x y H.
apply (plus_lt_compat_r x y 10). assumption.
Qed.

(* Exercise 7 *)

Goal forall P Q : nat -> Prop, P 0 -> (forall x, P x -> Q x) -> Q 0.
Proof.
intros P Q H1 H2.
apply (H2 0). assumption.
Qed.

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

Goal forall P : nat -> Prop, (forall n m, P n -> P m) -> (exists p, P p) -> forall q, P q.
Proof.
intros P H1 H2 q.
destruct H2 as [p H3]. apply (H1 p q).
assumption.
Qed.

(* Exercise 8 *)

Goal forall m n : nat, (n * 10) + m = (10 * n) + m.
Proof.
intros m n.
eapply NPeano.Nat.add_cancel_r.
eapply mult_comm.
Qed.

(* Exercise 9 *)

Goal forall n m p q : nat, (n + m) + (p + q) = (n + p) + (m + q).
Proof.
intros n m p q.
apply plus_permute_2_in_4.
Qed.

Goal forall n m : nat, (n + m) * (n + m) = n * n + m * m + 2 * n * m.
Proof.
intros n m.
erewrite mult_plus_distr_l.
repeat erewrite mult_plus_distr_r.
rewrite (plus_comm (n * m) (m * m)).
erewrite <- plus_permute_2_in_4.
eapply NPeano.Nat.add_cancel_l.
rewrite (mult_comm m n).
simpl. erewrite <- plus_n_O.
erewrite mult_plus_distr_r.
reflexivity.
Qed.

(* Exercise 10 *)

Parameter G : Set.
Parameter mult : G -> G -> G.
Notation "x * y" := (mult x y).
Parameter one : G.
Notation "1" := one.
Parameter inv : G -> G.
Notation "/ x" := (inv x).
(* Notation "x / y" := (mult x (inv y)). *) (* \u4f7f\u3063\u3066\u3082\u3088\u3044 *)

Axiom mult_assoc : forall x y z, x * (y * z) = (x * y) * z.
Axiom one_unit_l : forall x, 1 * x = x.
Axiom inv_l : forall x, /x * x = 1.

Lemma inv_r : forall x, x * / x = 1.
Proof.
intro x.
assert(H: (/(/x) * (/x)) * x * (/x) = 1).
 rewrite <- (mult_assoc (/(/x) * (/x)) x (/x)).
 rewrite <- (mult_assoc (/(/x)) (/x) (x * /x)).
 rewrite (mult_assoc (/x) x (/x)).
 rewrite (inv_l x). rewrite one_unit_l.
 apply (inv_l (/x)).
rewrite (inv_l (/x)) in H. rewrite one_unit_l in H.
assumption.
Qed.

Lemma one_unit_r : forall x, x * 1 = x.
Proof.
intros x.
rewrite <- (one_unit_l (x * 1)).
assert(H: (/(/x) * (/x)) * (x * (/x * x)) = x).
 rewrite <- (mult_assoc (/(/x)) (/x) (x* (/x * x))).
 rewrite (mult_assoc (/(/x)) (/x) (x*(/x * x))).
 rewrite <- mult_assoc.
 rewrite (mult_assoc (/x) x (/x * x)).
 replace (/x * x * (/x * x)) with (1 * (/x * x)).
  rewrite one_unit_l. rewrite mult_assoc.
  rewrite inv_l. rewrite one_unit_l. reflexivity.
 rewrite (inv_l x). reflexivity.
rewrite (inv_l x) in H. rewrite (inv_l (/x)) in H.
assumption.
Qed.