(*Functions*)

Definition f (n: nat) : nat := n + 1.

About f.
Print f.
Check f 3.
Compute f 3.

Definition g (n m : nat) : nat := n + m * 2.
Definition h (n : nat) : nat -> nat := fun m => n + m * 2.
Check g.
Check h.
Compute g 2 3.
Compute h 2 3.

Definition repeat_twice (g: nat -> nat) : nat -> nat :=
    fun x => g (g x).

Compute repeat_twice f 2.
Check (repeat_twice f).

(*Data types*)

Inductive bool := true | false.
Check true.

Definition andb (b1 b2 : bool) := if b1 then b2 else false.
Definition orb (b1 b2 : bool) := if b1 then true else b2.
Check andb.
Check orb.

Inductive nat := O | S (n : nat).
Check fun n => n+1.

Definition non_zero n :=
    match n with
    | O => false
    | S p => true
    end.

Fixpoint addn n m :=
    match n with
    | O => m
    | S p => S (addn p m)
    end.

Fixpoint subn m n :=
    match m, n with
    | (S p), (S q) => subn p q
    | _, _ => m
    end.

Fixpoint eqn m n :=
    match m, n with
    | O, O => true
    | S p, S q => eqn p q
    | _, _ => false
    end.


Require Import Arith Nat.

Inductive lst : Type :=
  | Nil : lst
  | Cons : nat -> lst -> lst.

Fixpoint len (l : lst) : nat :=
match l with
  | Nil => 0
  | Cons a l1 => 1 + (len l1)
end.

Fixpoint rev (l1 l2: lst): lst :=
  match l1 with
  | Nil => l2
  | Cons x l1' => rev l1' (Cons x l2)
  end.

Lemma list_rev2_len_lem: forall l1 l2,
len (rev l1 l2) <= (len l1) + (len l2).
Proof.
  induction l1.
  - simpl. reflexivity.
  - simpl. intros.
    apply (le_trans (len (rev l1 (Cons n l2))) (len l1 + len (Cons n l2))
                    (S (len l1 + len l2))).
    apply IHl1. simpl. rewrite <- plus_n_Sm. apply le_refl.
Qed.

Theorem list_rev2_len: forall l: lst, len (rev l Nil) <= len l.
Proof.
  induction l.
  - simpl. apply le_refl.
  - simpl. rewrite list_rev2_len_lem. simpl. rewrite <- plus_n_O. reflexivity.
Qed.


Require Import rt.util.tactics rt.util.notation rt.util.sorting rt.util.nat.
From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq fintype bigop.

(* Lemmas about arithmetic with sums. *)
Section SumArithmetic.

  (* Inequality with sums is monotonic with their functions. *)
  Lemma sum_diff_monotonic :
    forall n G F,
      (forall i : nat, i < n -> G i <= F i) ->
      (\sum_(0 <= i < n) (G i)) <= (\sum_(0 <= i < n) (F i)).
  Proof.
    intros n G F ALL.
    rewrite big_nat_cond [\sum_(0 <= i < n) F i]big_nat_cond.
    apply leq_sum; intros i LT; rewrite andbT in LT.
    move: LT => /andP LT; des.
    by apply ALL, leq_trans with (n := n); ins.
  Qed.

  Lemma sum_diff :
    forall n F G,
      (forall i (LT: i < n), F i >= G i) ->
      \sum_(0 <= i < n) (F i - G i) =
        (\sum_(0 <= i < n) (F i)) - (\sum_(0 <= i < n) (G i)).
  Proof.
    intros n F G ALL.
    induction n; ins; first by rewrite 3?big_geq.
    assert (ALL': forall i, i < n -> G i <= F i).
      by ins; apply ALL, leq_trans with (n := n); ins.
    rewrite 3?big_nat_recr // IHn //; simpl.
    rewrite subh1; last by apply sum_diff_monotonic.
    rewrite subh2 //; try apply sum_diff_monotonic; ins.
    rewrite subh1; ins; apply sum_diff_monotonic; ins.
    by apply ALL; rewrite ltnS leqnn.
  Qed.

  Lemma telescoping_sum :
    forall (T: Type) (F: T->nat) r (x0: T),
    (forall i, i < (size r).-1 -> F (nth x0 r i) <= F (nth x0 r i.+1)) ->
      F (nth x0 r (size r).-1) - F (nth x0 r 0) =
        \sum_(0 <= i < (size r).-1) (F (nth x0 r (i.+1)) - F (nth x0 r i)).
  Proof.
    intros T F r x0 ALL.
    have ADD1 := big_add1.
    have RECL := big_nat_recl.
    specialize (ADD1 nat 0 addn 0 (size r) (fun x => true) (fun i => F (nth x0 r i))).
    specialize (RECL nat 0 addn (size r).-1 0 (fun i => F (nth x0 r i))).
    rewrite sum_diff; last by ins.
    rewrite addmovr; last by rewrite -[_.-1]add0n; apply prev_le_next; try rewrite add0n leqnn.
    rewrite subh1; last by apply sum_diff_monotonic.
    rewrite addnC -RECL //.
    rewrite addmovl; last by rewrite big_nat_recr // -{1}[\sum_(_ <= _ < _) _]addn0; apply leq_add.
    by rewrite addnC -big_nat_recr.
  Qed.

End SumArithmetic.

(* Additional lemmas about sum and max big operators. *)
Section ExtraLemmasSumMax.

  Lemma leq_big_max I r (P : pred I) (E1 E2 : I -> nat) :
    (forall i, P i -> E1 i <= E2 i) ->
      \max_(i <- r | P i) E1 i <= \max_(i <- r | P i) E2 i.
  Proof.
    move => leE12; elim/big_ind2 : _ => // m1 m2 n1 n2.
    intros LE1 LE2; rewrite leq_max; unfold maxn.
    by destruct (m2 < n2) eqn:LT; [by apply/orP; right | by apply/orP; left].
  Qed.

  Lemma sum_nat_eq0_nat (T : eqType) (F : T -> nat) (r: seq T) :
    all (fun x => F x == 0) r = (\sum_(i <- r) F i == 0).
  Proof.
    destruct (all (fun x => F x == 0) r) eqn:ZERO.
    {
      move: ZERO => /allP ZERO; rewrite -leqn0.
      rewrite big_seq_cond (eq_bigr (fun x => 0));
        first by rewrite big_const_seq iter_addn mul0n addn0 leqnn.
      intro i; rewrite andbT; intros IN.
      specialize (ZERO i); rewrite IN in ZERO.
      by move: ZERO => /implyP ZERO; apply/eqP; apply ZERO.
    }
    {
      apply negbT in ZERO; rewrite -has_predC in ZERO.
      move: ZERO => /hasP ZERO; destruct ZERO as [x IN NEQ]; simpl in NEQ.
      rewrite (big_rem x) /=; last by done.
      symmetry; apply negbTE; rewrite neq_ltn; apply/orP; right.
      apply leq_trans with (n := F x); last by apply leq_addr.
      by rewrite lt0n.
    }
  Qed.

  Lemma extend_sum :
    forall t1 t2 t1' t2' F,
      t1' <= t1 ->
      t2 <= t2' ->
      \sum_(t1 <= t < t2) F t <= \sum_(t1' <= t < t2') F t.
  Proof.
    intros t1 t2 t1' t2' F LE1 LE2.
    destruct (t1 <= t2) eqn:LE12;
      last by apply negbT in LE12; rewrite -ltnNge in LE12; rewrite big_geq // ltnW.
    rewrite -> big_cat_nat with (m := t1') (n := t1); try (by done); simpl;
      last by apply leq_trans with (n := t2).
    rewrite -> big_cat_nat with (p := t2') (n := t2); try (by done); simpl.
    by rewrite addnC -addnA; apply leq_addr.
  Qed.

  Lemma leq_sum_nat m n (P : pred nat) (E1 E2 : nat -> nat) :
    (forall i, m <= i < n -> P i -> E1 i <= E2 i) ->
    \sum_(m <= i < n | P i) E1 i <= \sum_(m <= i < n | P i) E2 i.
  Proof.
    intros LE.
    rewrite big_nat_cond [\sum_(_ <= _ < _| P _)_]big_nat_cond.
    by apply leq_sum; move => j /andP [IN H]; apply LE.
  Qed.

  Lemma leq_sum_seq (I: eqType) (r: seq I) (P : pred I) (E1 E2 : I -> nat) :
    (forall i, i \in r -> P i -> E1 i <= E2 i) ->
    \sum_(i <- r | P i) E1 i <= \sum_(i <- r | P i) E2 i.
  Proof.
    intros LE.
    rewrite big_seq_cond [\sum_(_ <- _| P _)_]big_seq_cond.
    by apply leq_sum; move => j /andP [IN H]; apply LE.
  Qed.

End ExtraLemmasSumMax.


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

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

Fixpoint append(m n :natlist) : natlist :=
match m with
|[] => n
|a :: b => a::(append b n)
end.

Notation "x ++ y" := (append x y)(at level 60, right associativity).

Fixpoint snoc(m:natlist)(n:nat) :natlist:=
match m with
|[] => [n]
|a::b => a:: (snoc b n)
end.

Fixpoint reverse(n:natlist) : natlist :=
match n with
|[] => []
|a::b => snoc(reverse b) a
end.

Theorem appendEmptyList : forall list : natlist, list ++ [] = list.
Proof.
  intros.

    induction list as [| x xs].
    simpl.
    reflexivity.
    simpl.
    rewrite -> IHxs.
    reflexivity.
Qed.

Theorem rev_snoc : forall l :natlist, forall n:nat, reverse(snoc l n) = n :: reverse l.
Proof.
intros.
induction l.
simpl.
simpl. reflexivity.
simpl. rewrite -> IHl.
simpl. reflexivity.
Qed.

Theorem reverseInvolutive : forall list : natlist, reverse(reverse list) = list.
Proof.
  intros.
    induction list as [| x xs].
    simpl. reflexivity.
    simpl.
    rewrite -> rev_snoc.
rewrite IHxs.
reflexivity.
Qed.


(** * Rel: Properties of Relations *)

(** This short (and optional) chapter develops some basic definitions
    and a few theorems about binary relations in Coq.  The key
    definitions are repeated where they are actually used (in the
    [Smallstep] chapter), so readers who are already comfortable with
    these ideas can safely skim or skip this chapter.  However,
    relations are also a good source of exercises for developing
    facility with Coq's basic reasoning facilities, so it may be
    useful to look at this material just after the [IndProp]
    chapter. *)

Require Export IndProp.

(** A binary _relation_ on a set [X] is a family of propositions
    parameterized by two elements of [X] -- i.e., a proposition about
    pairs of elements of [X].  *)

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

(** Confusingly, the Coq standard library hijacks the generic term
    "relation" for this specific instance of the idea. To maintain
    consistency with the library, we will do the same.  So, henceforth
    the Coq identifier [relation] will always refer to a binary
    relation between some set and itself, whereas the English word
    "relation" can refer either to the specific Coq concept or the
    more general concept of a relation between any number of possibly
    different sets.  The context of the discussion should always make
    clear which is meant. *)

(** An example relation on [nat] is [le], the less-than-or-equal-to
    relation, which we usually write [n1 <= n2]. *)

Print le.
(* ====> Inductive le (n : nat) : nat -> Prop :=
             le_n : n <= n
           | le_S : forall m : nat, n <= m -> n <= S m *)
Check le : nat -> nat -> Prop.
Check le : relation nat.
(** (Why did we write it this way instead of starting with [Inductive
    le : relation nat...]?  Because we wanted to put the first [nat]
    to the left of the [:], which makes Coq generate a somewhat nicer
    induction principle for reasoning about [<=].) *)

(* ######################################################### *)
(** * Basic Properties *)

(** As anyone knows who has taken an undergraduate discrete math
    course, there is a lot to be said about relations in general,
    including ways of classifying relations (as reflexive, transitive,
    etc.), theorems that can be proved generically about certain sorts
    of relations, constructions that build one relation from another,
    etc.  For example... *)

(** *** Partial Functions *)

(** A relation [R] on a set [X] is a _partial function_ if, for every
    [x], there is at most one [y] such that [R x y] -- i.e., [R x y1]
    and [R x y2] together imply [y1 = y2]. *)

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

(** For example, the [next_nat] relation defined earlier is a partial
    function. *)

Print next_nat.
(* ====> Inductive next_nat (n : nat) : nat -> Prop :=
           nn : next_nat n (S n) *)
Check next_nat : relation nat.

Theorem next_nat_partial_function :
   partial_function next_nat.
Proof.
  unfold partial_function.
  intros x y1 y2 H1 H2.
  inversion H1. inversion H2.
  reflexivity.  Qed.

(** However, the [<=] relation on numbers is not a partial
    function.  (Assume, for a contradiction, that [<=] is a partial
    function.  But then, since [0 <= 0] and [0 <= 1], it follows that
    [0 = 1].  This is nonsense, so our assumption was
    contradictory.) *)

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

(** **** Exercise: 2 stars, optional  *)
(** Show that the [total_relation] defined in earlier is not a partial
    function. *)
Print total_relation.
(* FILL IN HERE *)
Theorem total_relation_not_partial :
  ~ (partial_function total_relation).
Proof. unfold not. unfold partial_function. intros H.
  assert (ns: 0 = 1). {
  apply H with (x := 23).
   - apply tr.
   - apply tr.
  }
  inversion ns.
Qed.

(** [] *)

(** **** Exercise: 2 stars, optional  *)
(** Show that the [empty_relation] that we defined earlier is a
    partial function. *)

Check empty_relation.
Print empty_relation.
(* FILL IN HERE *)
Theorem empty_relation_partial :
  partial_function empty_relation.
Proof. unfold partial_function.
  intros x y1 y2 H1 H2.
  destruct H1. inversion H.
Qed.

(** [] *)

(** *** Reflexive Relations *)

(** A _reflexive_ relation on a set [X] is one for which every element
    of [X] is related to itself. *)

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

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

(** *** Transitive Relations *)

(** A relation [R] is _transitive_ if [R a c] holds whenever [R a b]
    and [R b c] do. *)

Definition transitive {X: Type} (R: relation X) :=
  forall a b c : X, (R a b) -> (R b c) -> (R a c).
Print le.
Check le.
Theorem le_trans :
  transitive le.
Proof.
  intros n m o Hnm Hmo.
  induction Hmo.
  - (* le_n *) apply Hnm.
  - (* le_S *) apply le_S. apply IHHmo.  Qed.

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

(** **** Exercise: 2 stars, optional  *)
(** We can also prove [lt_trans] more laboriously by induction,
    without using [le_trans].  Do this.*)

Theorem lt_trans' :
  transitive lt.
Proof.
  (* Prove this by induction on evidence that [m] is less than [o]. *)
  unfold lt. unfold transitive.
  intros n m o Hnm Hmo.
  induction Hmo as [| m' Hm'o].
    (* FILL IN HERE *)
  - apply le_S in Hnm. apply Hnm.
  - apply le_S in IHHm'o. apply IHHm'o.
Qed.
(** [] *)

(** **** Exercise: 2 stars, optional  *)
(** Prove the same thing again by induction on [o]. *)

Theorem lt_trans'' :
  transitive lt.
Proof.
  unfold lt. unfold transitive.
  intros n m o Hnm Hmo.
  induction o as [| o'].
  (* FILL IN HERE *)
  - inversion Hmo.
  - apply le_S in Hnm. apply le_trans with (b:= S m).
    apply Hnm. apply Hmo.
Qed.
(** [] *)

(** The transitivity of [le], in turn, can be used to prove some facts
    that will be useful later (e.g., for the proof of antisymmetry
    below)... *)

Theorem le_Sn_le : forall n m, S n <= m -> n <= m.
Proof.
  intros n m H. apply le_trans with (S n).
  - apply le_S. apply le_n.
  - apply H.
Qed.

(** **** Exercise: 1 star, optional  *)
Theorem le_S_n : forall n m,
  (S n <= S m) -> (n <= m).
Proof.
  (* FILL IN HERE *)
  intros. inversion H.
  - apply le_n.
  - apply le_trans with (S n).
    apply le_S. apply le_n. apply H1.
Qed.
(** [] *)

(** **** Exercise: 2 stars, optional (le_Sn_n_inf)  *)
(** Provide an informal proof of the following theorem:

    Theorem: For every [n], [~ (S n <= n)]

    A formal proof of this is an optional exercise below, but try
    writing an informal proof without doing the formal proof first.

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

(** **** Exercise: 1 star, optional  *)
Theorem le_Sn_n : forall n,
  ~ (S n <= n).
Proof.
  (* FILL IN HERE *) intros n H.
  induction n as [|n' IHn'].
  - inversion H.
  - apply IHn'. apply le_S_n. apply H.
Qed.
(** [] *)

(** Reflexivity and transitivity are the main concepts we'll need for
    later chapters, but, for a bit of additional practice working with
    relations in Coq, let's look at a few other common ones... *)

(** *** Symmetric and Antisymmetric Relations *)

(** A relation [R] is _symmetric_ if [R a b] implies [R b a]. *)

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

(** **** Exercise: 2 stars, optional  *)
Theorem le_not_symmetric :
  ~ (symmetric le).
Proof.
  (* FILL IN HERE *) intro H. unfold symmetric in H.
  assert (1 <= 0) as ns.
   { apply H. apply le_S. apply le_n. }
   inversion ns.
Qed.
(** [] *)

(** A relation [R] is _antisymmetric_ if [R a b] and [R b a] together
    imply [a = b] -- that is, if the only "cycles" in [R] are trivial
    ones. *)

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

(** **** Exercise: 2 stars, optional  *)
Theorem le_antisymmetric :
  antisymmetric le.
Proof.
  (* FILL IN HERE *)
  intros a b Hab Hba. inversion Hab.
  - reflexivity.
  - inversion Hba.
    + rewrite <- H1. symmetry. apply H0.
    + rewrite <- H0 in H1. rewrite <- H2 in H.
      assert (contra: S m <= m).
       { apply le_trans with m0. apply H1.
         apply le_trans with (S m0). apply le_S. apply le_n. apply H. }
      apply le_Sn_n in contra. inversion contra.
Qed.

(** [] *)

(** **** Exercise: 2 stars, optional  *)
Theorem le_step : forall n m p,
  n < m ->
  m <= S p ->
  n <= p.
Proof.
  (* FILL IN HERE *)
  intros n m p H1 H2. unfold lt in H1.
  apply le_S_n. apply le_trans with m. apply H1. apply H2.
Qed.
(** [] *)

(** *** Equivalence Relations *)

(** A relation is an _equivalence_ if it's reflexive, symmetric, and
    transitive.  *)

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

(** *** Partial Orders and Preorders *)

(** A relation is a _partial order_ when it's reflexive,
    _anti_-symmetric, and transitive.  In the Coq standard library
    it's called just "order" for short. *)

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

(** A preorder is almost like a partial order, but doesn't have to be
    antisymmetric. *)

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

Theorem le_order :
  order le.
Proof.
  unfold order. split.
    - (* refl *) apply le_reflexive.
    - split.
      + (* antisym *) apply le_antisymmetric.
      + (* transitive. *) apply le_trans.  Qed.

(* ########################################################### *)
(** * Reflexive, Transitive Closure *)

(** The _reflexive, transitive closure_ of a relation [R] is the
    smallest relation that contains [R] and that is both reflexive and
    transitive.  Formally, it is defined like this in the Relations
    module of the Coq standard library: *)

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

Print clos_refl_trans_ind.
(** For example, the reflexive and transitive closure of the
    [next_nat] relation coincides with the [le] relation. *)

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

(** The above definition of reflexive, transitive closure is natural:
    it says, explicitly, that the reflexive and transitive closure of
    [R] is the least relation that includes [R] and that is closed
    under rules of reflexivity and transitivity.  But it turns out
    that this definition is not very convenient for doing proofs,
    since the "nondeterminism" of the [rt_trans] rule can sometimes
    lead to tricky inductions.  Here is a more useful definition: *)

Inductive clos_refl_trans_1n {A : Type}
                             (R : relation A) (x : A)
                             : A -> Prop :=
  | rt1n_refl : clos_refl_trans_1n R x x
  | rt1n_trans (y z : A) :
      R x y -> clos_refl_trans_1n R y z ->
      clos_refl_trans_1n R x z.

(** Our new definition of reflexive, transitive closure "bundles"
    the [rt_step] and [rt_trans] rules into the single rule step.
    The left-hand premise of this step is a single use of [R],
    leading to a much simpler induction principle.

    Before we go on, we should check that the two definitions do
    indeed define the same relation...

    First, we prove two lemmas showing that [clos_refl_trans_1n] mimics
    the behavior of the two "missing" [clos_refl_trans]
    constructors.  *)

Lemma rsc_R : forall (X:Type) (R:relation X) (x y : X),
       R x y -> clos_refl_trans_1n R x y.
Proof.
  intros X R x y H.
  apply rt1n_trans with y. apply H. apply rt1n_refl.   Qed.

(** **** Exercise: 2 stars, optional (rsc_trans)  *)
Lemma rsc_trans :
  forall (X:Type) (R: relation X) (x y z : X),
      clos_refl_trans_1n R x y  ->
      clos_refl_trans_1n R y z ->
      clos_refl_trans_1n R x z.
Proof.
  (* FILL IN HERE *)
  intros X R x y z Hxy.
  induction Hxy.
  - intro H. apply H.
  - intro H'. apply IHHxy in H'.  apply rt1n_trans with y.
    apply H. apply H'.
Qed.
(** [] *)

(** Then we use these facts to prove that the two definitions of
    reflexive, transitive closure do indeed define the same
    relation. *)

(** **** Exercise: 3 stars, optional (rtc_rsc_coincide)  *)
Theorem rtc_rsc_coincide :
         forall (X:Type) (R: relation X) (x y : X),
  clos_refl_trans R x y <-> clos_refl_trans_1n R x y.
Proof.
  (* FILL IN HERE *)
  intros X R x y. split.
  - intro H. induction H.
    + apply rsc_R. apply H.
    + apply rt1n_refl.
    + apply rsc_trans with y. apply IHclos_refl_trans1.
      apply IHclos_refl_trans2.
  - intro H. induction H.
    + apply rt_refl.
    + apply rt_trans with y.
      * apply rt_step. apply H.
      * apply IHclos_refl_trans_1n.
Qed.
(** [] *)

(** $Date: 2016-05-26 16:17:19 -0400 (Thu, 26 May 2016) $ *)


(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

Require Import Orders NatOrderedType GenericMinMax.

(** * Maximum and Minimum of two natural numbers *)

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

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

(** These functions implement indeed a maximum and a minimum *)

Lemma max_l : forall x y, y<=x -> max x y = x.
Proof.
 induction x; destruct y; simpl; auto with arith.
Qed.

Lemma max_r : forall x y, x<=y -> max x y = y.
Proof.
 induction x; destruct y; simpl; auto with arith.
Qed.

Lemma min_l : forall x y, x<=y -> min x y = x.
Proof.
 induction x; destruct y; simpl; auto with arith.
Qed.

Lemma min_r : forall x y, y<=x -> min x y = y.
Proof.
 induction x; destruct y; simpl; auto with arith.
Qed.

Module NatHasMinMax <: HasMinMax Nat_as_OT.
 Definition max := max.
 Definition min := min.
 Definition max_l := max_l.
 Definition max_r := max_r.
 Definition min_l := min_l.
 Definition min_r := min_r.
End NatHasMinMax.

(** We obtain hence all the generic properties of [max] and [min],
    see file [GenericMinMax] or use SearchAbout. *)

Module Export MMP := UsualMinMaxProperties Nat_as_OT NatHasMinMax.

(** * Properties specific to the [nat] domain *)

(** Simplifications *)

Lemma max_0_l : forall n, max 0 n = n.
Proof. reflexivity. Qed.

Lemma max_0_r : forall n, max n 0 = n.
Proof. destruct n; auto. Qed.

Lemma min_0_l : forall n, min 0 n = 0.
Proof. reflexivity. Qed.

Lemma min_0_r : forall n, min n 0 = 0.
Proof. destruct n; auto. Qed.

(** Compatibilities (consequences of monotonicity) *)

Lemma succ_max_distr : forall n m, S (max n m) = max (S n) (S m).
Proof. auto. Qed.

Lemma succ_min_distr : forall n m, S (min n m) = min (S n) (S m).
Proof. auto. Qed.

Lemma plus_max_distr_l : forall n m p, max (p + n) (p + m) = p + max n m.
Proof.
intros. apply max_monotone. repeat red; auto with arith.
Qed.

Lemma plus_max_distr_r : forall n m p, max (n + p) (m + p) = max n m + p.
Proof.
intros. apply max_monotone with (f:=fun x => x + p).
repeat red; auto with arith.
Qed.

Lemma plus_min_distr_l : forall n m p, min (p + n) (p + m) = p + min n m.
Proof.
intros. apply min_monotone. repeat red; auto with arith.
Qed.

Lemma plus_min_distr_r : forall n m p, min (n + p) (m + p) = min n m + p.
Proof.
intros. apply min_monotone with (f:=fun x => x + p).
repeat red; auto with arith.
Qed.

Hint Resolve
 max_l max_r le_max_l le_max_r
 min_l min_r le_min_l le_min_r : arith v62.


From NaturalNumbers Require Export Base Tutorial Addition Multiplication AdvProposition.

Require Coq.Classes.RelationClasses.

Fact succ_inj {a b : mynat} : S a = S b -> a = b.
Proof.
    intro h.
    inversion h.
    reflexivity.
Qed.

Fact zero_ne_succ (a : mynat) : 0 <> S a.
Proof.
    discriminate.
Qed.

(* Level 0 data *)
(* name `succ_inj`. A function. *)
(* tactics exfalso *)
(* theorems zero_ne_succ *)
(* Level prologue *)
(*
Peano's axioms actually included two more assumptions, which
we haven't seen (or used) yet:

`Fact succ_inj {a b : mynat} : S a = S b -> a = b.`

`Fact zero_ne_succ (a : mynat) : 0 <> S a.`

In the second statement, we see the `<>`, which is the "not equal" operator.
The reason they have not been introduced yet is that they are implications.

For `succ_inj a b` this is obvious, as there is an implication in the statement.
For the second statement it's a bit more subtle, as `zero_ne_succ a` actually means
```
0 = S a -> False.
```
Let's first learn to use `succ_inj` by using it to prove our own variant
of the statement: `succ_inj'`.
*)
Lemma succ_inj' {a b : mynat} (hs : S a = S b) : a = b.
Proof.
    exact (succ_inj hs).
Qed.
(* Level epilogue *)
(* Level end *)

(* Level 1 data *)
(* name `succ_succ_inj` *)
(* tactics exfalso *)
(* theorems zero_ne_succ *)
(* Level prologue *)
(*
In this theorem, we will need to use the `succ_inj` axiom twice.
You can do it with `exact` (and maybe some `specialize` statements) or `apply`.
Try either way to get more used to these tactics!
*)
Lemma succ_succ_inj {a b : mynat} (h : S (S a) = S (S b)) : a = b.
Proof.
    exact (succ_inj (succ_inj h)).
Qed.
(* Level epilogue *)
(* Level end *)

(* Level 2 data *)
(* name `succ_eq_succ_of_eq` *)
(* tactics exfalso *)
(* theorems zero_ne_succ *)
(* Level prologue *)
(*
Now let's prove something completely obvious, using the same
input for the successor gives the same output. Remember our
rule of thumb about implications and the `intro` tactic,
and use it to prove this lemma!
*)
Lemma succ_eq_succ_of_eq {a b : mynat} : a = b -> S a = S b.
Proof.
    intro h.
    now rewrite h.
Qed.
(* Level epilogue *)
(* Level end *)

(* Level 3 data *)
(* name `eq_iff_succ_eq_succ` *)
(* tactics exfalso *)
(* theorems zero_ne_succ *)
(* Level prologue *)
(*
Now let's combine our previous lemmas into an `<->` statement.
Remember the `split` tactic to prove the implications separately!

The first goal will be the same as `succ_inj`, so we can simply
`exact succ_inj.` to prove it. For the second goal we can do something
similar, but with the statement from the previous lemma.
*)
Lemma eq_iff_succ_eq_succ (a b : mynat) : S a = S b <-> a = b.
Proof.
    split.
    - exact succ_inj.
    - exact succ_eq_succ_of_eq.
Qed.
(* Level epilogue *)
(* Level end *)

(* Level 4 data *)
(* name `add_right_cancel` *)
(* tactics exfalso *)
(* theorems zero_ne_succ *)
(* Level prologue *)
(*
Now we show that we can cancel on the right when doing addition,
i.e. that `a = b` whenever `a + t = b + t` for some `t`.

Now the `rewrite` tactic has some more magic to it. We can
rewrite theorems/hypothesis in other hypotheses!

If we `intro h.` in this level we get `h : a + t = b + t`.
Doing induction on `t` gives us hypotheses and a subgoal
```plaintext
a, b : mynat
h : a + 0 = b + 0
============================
a = b
```
now we can type
```
rewrite add_zero in h.
```
to turn `h : a + 0 = b + 0` into `h : a = b`.
Try it out below!
*)
Lemma add_right_cancel (a b t : mynat) : a + t = b + t -> a = b.
Proof.
    intro h.
    induction t as [| ? Ht].
    - rewrite add_zero in h.
      exact h.
    - repeat rewrite add_succ in h.
      inversion h.
      exact (Ht H0).
Qed.
(* Level epilogue *)
(* Level end *)

(* Level 5 data *)
(* name `add_left_cancel` *)
(* tactics exfalso *)
(* theorems zero_ne_succ *)
(* Level prologue *)
(*
Using `add_comm`, you can rewrite `add_left_cancel` in a way that
allows us to simply `exact (add_right_cancel _ _ _).`, i.e. we can
tell Coq that `add_right_cancel` finishes off the goal, with three
paramters, which Coq can deduce by itself (denoted by the `_` wildcards).
*)
Lemma add_left_cancel (t a b : mynat) : t + a = t + b -> a = b.
Proof.
    rewrite add_comm, (add_comm t b).
    exact (add_right_cancel _ _ _).
Qed.
(* Level epilogue *)
(* Level end *)

(* Level 6 data *)
(* name `add_right_cancel_iff` *)
(* tactics exfalso *)
(* theorems zero_ne_succ *)
(* Level prologue *)
(*
Similar to before, it may be useful to have an if and only if
statement, so we can `rewrite` it later on. Use the previous
level (`add_right_cancel`) to show this if and only if statement.

Tip: if you type
```
exact (add_right_cancel _ _ _).
```
Coq will figure out what inputs to use by itself!
*)
Lemma add_right_cancel_iff (t a b : mynat) : a + t = b + t <-> a = b.
Proof.
    split.
    - exact (add_right_cancel _ _ _).
    - intro h.
      now rewrite h.
Qed.
(* Level epilogue *)
(* Level end *)

(* Level 7 data *)
(* name `eq_zero_of_add_right_eq_self` *)
(* tactics exfalso *)
(* theorems zero_ne_succ *)
(* Level prologue *)
(*
This next level will be useful later on in Inequality World, when
we will prove that `<=` is an antisymmetric relation.
*)
Lemma eq_zero_of_add_right_eq_self {a b : mynat} : a + b = a -> b = 0.
Proof.
    intro h.
    specialize (add_left_cancel a b 0) as h_simpl.
    rewrite (add_zero a) in h_simpl.
    exact (h_simpl h).
Qed.
(* Level epilogue *)
(* Level end *)

(* Unused 8 data *)
(* name `succ_ne_zero` *)
(* tactics exfalso *)
(* theorems zero_ne_succ *)
(* Unused prologue *)
(*
I don't want to use this level because it introduces
a new tactic that we are not going to use in other levels.
*)
Lemma succ_ne_zero (a : mynat) : S a <> 0.
Proof.
    (* todo: symmetry for <>? *)
    discriminate.
Qed.
(* Unused epilogue *)
(* Unused end *)

(* Level 8 data *)
(* name `add_left_eq_zero` *)
(* tactics exfalso *)
(* theorems zero_ne_succ *)
(* Level prologue *)
(*
Inequalities `a <> b` in Coq are defined as `a = b -> False`.
So if you read `a <> b`, you should read it as `a = b -> False`.

The following lemma will be useful in Inequality World.
It will require a lot of the tactics you have learnt before,
like `destruct`, which similar to logical ors, we can use to
go over the cases of a natural number. In this level, it will be
useful to start with
```
destruct b.
- ...
```
which will create two subgoals, one for `b = 0`, and one for `b = S n`
for some natural number `n : mynat`.

Also remember that any negations (like `~` but also `<>`) can be turned
into their `-> False` form by typing `unfold not`. In fact, we can also do
this in any hypotheses. Suppose we have `a b : mynat`, then we can
```
specialize (succ_ne_zero (a + b)) as snz.
```
to obtain a hypothesis
```
snz : S (a + b) <> 0.
```
If we then
```
unfold not in snz.
```
it gets turned into
```
snz : S (a + b) = 0 -> False.
```
which we may be able to use for an `exfalso` proof!

*)
Lemma add_left_eq_zero {a b : mynat} (h : a + b = 0) : b = 0.
Proof.
    destruct b.
    - reflexivity.
    - exfalso.
      rewrite add_succ in h.
      specialize (succ_ne_zero (a + b)) as snz.
      unfold not in snz.
      exact (snz h).
Qed.
(* Level epilogue *)
(* Level end *)

(* Level 9 data *)
(* name `add_right_eq_zero` *)
(* tactics exfalso *)
(* theorems zero_ne_succ *)
(* Level prologue *)
(*
Now that we know `add_left_eq_zero`, proving `add_right_eq_zero` should
not be too hard, especially knowing that addition is commutative,
witnessed by `add_comm`!
*)
Lemma add_right_eq_zero {a b : mynat} : a + b = 0 -> a = 0.
Proof.
    rewrite add_comm.
    apply add_left_eq_zero.
Qed.
(* Level epilogue *)
(* Level end *)

(* Level 10 data *)
(* name `add_one_eq_succ` *)
(* tactics symmetry *)
(* theorems zero_ne_succ *)
(* Level prologue *)
(*
We know that `succ_eq_add_one (n : mynat) : S n = n + 1.`
but it may be useful to know it the other way around as well.
Did you know that for equalities, we can use the
`symmetry` tactic to flip the sides of the goal?

Try it out below!
*)
Lemma add_one_eq_succ (d : mynat) : d + 1 = S d.
Proof.
    symmetry.
    exact (succ_eq_add_one _).
Qed.
(* Level epilogue *)
(* Level end *)

(* Level 11 data *)
(* name `ne_succ_self` (boss level!) *)
(* tactics symmetry *)
(* theorems zero_ne_succ *)
(* Level prologue *)
(*
Another boss level! Try to show that numbers
are not equal to their successor. Remember that
`unfold not` will turn negations and inequalities
into `-> False`!
*)
Lemma ne_succ_self (n : mynat) : n <> S n.
Proof.
    unfold not.
    induction n as [| ? h].
    - easy.
    - intro h1.
      now specialize (succ_inj h1) as h2.
Qed.
(* Level epilogue *)
(* Level end *)


(** * Prop: Propositions and Evidence *)

Require Export MoreCoq.

(** In previous chapters, we have seen many examples of factual
    claims (_propositions_) and ways of presenting evidence of their
    truth (_proofs_).  In particular, we have worked extensively with
    _equality propositions_ of the form [e1 = e2], with
    implications ([P -> Q]), and with quantified propositions
    ([forall x, P]).

    This chapter will take us on a first tour of the
    propositional (logical) side of Coq.
    In particular, we will expand our repertoire of primitive
    propositions to include _user-defined_ propositions, not just
    equality propositions (which are more-or-less "built in" to Coq).
*)

(** Material covered at OPLSS proper starts here. *)

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

(**  As a running example, 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 hold 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]? *)

(** Infinitely many, because we can just keep adding 0: 0 + (3 + 5) is
    beautiful (0 + 0) + (3 + 5) is beautiful; etc. *)

(** Is it possible to prove this sort of metaproperty in Coq?  Can I
    prove that there are infinite proofs of the beauty of 8? *)

(** 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 first line declares that [beautiful] 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
    [beautiful]" is a proposition.)  Such a family of propositions is
    often called a _property_ of numbers.  Each of the remaining lines
    embodies one of the rules for [beautiful] numbers.

    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.

(** Here, B is just a name; we could have used some other name as
    well. Moreover, here's another proof of the same theorem, where we
    don't have to provide (m:=n): *)

Theorem beautiful_plus_eight_2: forall n, beautiful n -> beautiful (8+n).
Proof.
  intros n B.
  apply b_sum with (n:=8). (* Here n is bound in b_sum, not in this proof! *)
  apply eight_is_beautiful.
  apply B.
Qed.

(** **** Exercise: 2 stars (b_timesm) *)
Theorem b_timesm: forall n m, beautiful n -> beautiful (m*n).
Proof.
   (* FILL IN HERE *) Admitted.
(** [] *)

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

(** Was that a typo in the previous para? *)

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

(* FILL IN HERE *)
[]
*)

(** **** Exercise: 1 star (gorgeous_plus13) *)
Theorem gorgeous_plus13: forall n,
  gorgeous n -> gorgeous (13+n).
Proof.
   (* FILL IN HERE *) Admitted.
(** [] *)

(** 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 : 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.

(** Notice that the argument proceeds by induction on the _evidence_ [H]! *)

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

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]. *)

(** **** Exercise: 2 stars (gorgeous_sum) *)
Theorem gorgeous_sum : forall n m,
  gorgeous n -> gorgeous m -> gorgeous (n + m).
Proof.
 (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars, advanced (beautiful__gorgeous) *)
Theorem beautiful__gorgeous : forall n, beautiful n -> gorgeous n.
Proof.
 (* FILL IN HERE *) Admitted.
(** [] *)

(** **** 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.
   (* FILL IN HERE *) Admitted.

Theorem g_times2: forall n, gorgeous n -> gorgeous (2*n).
Proof.
   intros n H. simpl.
   induction H.
   (* FILL IN HERE *) Admitted.
(** [] *)

(* ####################################################### *)
(** ** From Boolean Functions to 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)).

(** This definition says that there are 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.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

(** **** Exercise: 1 star (ev__even) *)
(** 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.

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

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

(** The induction principle for inductively defined propositions does
    not follow quite the same form as that of inductively defined
    sets.  For now, you can take the intuitive view that induction on
    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.  We'll look at the induction principle of [ev] in more
    depth below, to explain what's really going on. *)

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

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

(** **** Exercise: 2 stars (ev_sum) *)
(** Here's another exercise requiring induction. *)

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

(* ####################################################### *)
(** ** [Inversion] on Evidence *)

(** Another situation where we want to analyze evidence for evenness
    is when proving that, if [n] is even, then [pred (pred n))] is
    too.  In this case, we don't need to do an inductive proof.  The
    right tactic turns out to be [inversion].  *)

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

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

(** Why do you only get one case here -- only the inductive case, and
    not the base case?  According to Tolmach, it's because Coq is
    smart enough to know that the ev_0 constructor couldn't possibly
    have been used to build ev (S (S n)), because they don't unify.
    So, the case that we don't care about gets thrown away.  (If we
    had been doing this proof on paper, we'd have just written
    something like "Can't happen" for that case.) *)

(** 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.
  (* FILL IN HERE *) Admitted.

(** 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.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

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

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

(* ####################################################### *)
(** * Additional Exercises *)

(** **** 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 that
       forall l, pal (l ++ rev l).
    - Prove that
       forall l, pal l -> l = rev l.
*)

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

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

(** **** 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 that subsequence is reflexive, that is, any list is a
      subsequence of itself.

    - Prove 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 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]]
*)

(** [] *)

(* $Date: 2013-07-01 18:48:47 -0400 (Mon, 01 Jul 2013) $ *)


Inductive nat : Type :=
  | O
  | S (n: nat).

Definition inc (n: nat): nat :=
  S n.

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

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

Compute (inc O).
Compute (dec (S (S O))).

Example arith:
  (inc O) = (dec (S (S O))).

Proof. simpl. reflexivity. Qed.

(* Prove that for all n, (recur n) = 0 by induction *)
Theorem recur_O: forall n : nat, recur n = O.
Proof.
  intros n. induction n as [| n' IHn'].
  - (* n = O *) simpl. reflexivity.
  - (* n = S n' *) simpl. rewrite <- IHn'. reflexivity.
  Qed.


Require Import Arith.

Set Implicit Arguments.
Require Import List.
Require Import ZArith.

Fixpoint sum (l:list nat) {struct l} : nat :=
  match l with
  | nil => O
  | b :: m => b + sum(m)
  end.

Inductive Prefix (A:Type) : list A -> list A -> Prop :=
  | PreNil : forall (l:list A), Prefix nil l
  | PreCons : forall (x:A) (l1 l2:list A), Prefix l1 l2 -> Prefix (x::l1) (x::l2).

Lemma Ex1A : forall l1 l2, sum (l1 ++ l2) = sum l1 + sum l2.
Proof.
induction l1.
(* base *)
intro l2.
simpl.
reflexivity.
(* ind *)
simpl.
intro l2.
rewrite IHl1.
SearchRewrite (_ + _).
rewrite plus_assoc_reverse.
reflexivity.
Qed.

Lemma Ex1B : forall l, sum (rev l) = sum l.
Proof.
induction l.
(* base *)
simpl.
reflexivity.
(* ind *)
simpl.
rewrite Ex1A.
simpl.
rewrite IHl.
SearchRewrite (_ + 0).
rewrite plus_0_r.
SearchPattern (?x + ?y = ?y + ?x).
rewrite plus_comm.
reflexivity.
Qed.

Lemma Ex1C : forall l1 l2, Prefix l1 l2 -> sum l1 <= sum l2.
Proof.
induction l1.
(* base *)
intros l2 H.
simpl.
apply le_0_n.
(* ind *)
intros l2.
intro.
induction H.
simpl.
apply le_0_n.
simpl.
SearchPattern (?x + _ <= ?x + _).
apply plus_le_compat_l.
assumption.
Qed.s


Require Import Omega.

Fixpoint lt_rem (a b : nat) : option nat :=
  match b with
    | 0 => Some a
    | S b' => match a with
                | 0 => None
                | S a' => lt_rem a' b'
              end
  end.

Lemma lt_rem_sound
: forall b a,
    match lt_rem a b with
      | None => a < b
      | Some c => a >= b /\ a - b = c
    end.
Proof.
  induction b; destruct a; simpl; intros; auto.
  { split; auto. red. omega. }
  { omega. }
  { specialize (IHb a).
    destruct (lt_rem a b); intuition. }
Qed.


(* 4 Coq で定理の証明 *)

(*
前述の Curry-Howard 同型のおかげで，Coq の中で直接に命題を書くことができる．その型を
満すプログラムが見付かれば，定理になる．
*)

(*
変数宣言 まずは，準備として論理変数の宣言を行う．Section というコマンドを使うと，局所
的な論理変数が宣言できるようになる．宣言自体は Variables コマンドを使う．そして，宣言範
囲が終ると End コマンドでセクションを閉じる．
*)

Section Koushin.
Variables P Q : Prop.
(* P is assumed *)
(* Q is assumed *)

(*
論理式自身は型であると先に説明したが，通常の型の型だった Set と異なり，論理式の型は Prop
になる．普段はあまり影響はないが，区別すると便利なことができる．
*)

(* 命題と証明プログラム *)

(*
まず，前の二つの恒真式を証明してみよう．
2 つ目は関数適用だけなので，簡単にできる．
*)

Theorem modus_ponens : P -> (P -> Q) -> Q. (* 名前を付けなければならない *)
Proof (fun p pq => pq p).
(* modus_ponens is defined *)

Print modus_ponens. (* 実際には関数定義と変わらない *)
(* modus_ponens = fun (p : P) (pq : P -> Q) => pq p *)
(* : P -> (P -> Q) -> Q  *)

(* しかし，一つ目ではデータの直積ではなく，命題の論理積を使ったので，作り方を調べなければならない．*)

Locate "/\". (* 論理積の定義を調べる *)
(* Notation Scope                   *)
(* "A /\ B" := and A B : type_scope *)

Print and.
(* Inductive and (A B : Prop) : Prop := conj : A -> B -> A / B *)

(* conj が論理積の証明の構成子だとわかる． *)
Theorem and_self : P -> P /\ P.
Proof (fun x => conj x x).
(* and_self is defined *)

(* 作戦 (tactic) の利用 *)

(*
上のように，プログラムを与えることで定理を証明することができる．しかし，複雑な定理に
なると，途中で出て来る命題が煩雑になり，正しいプログラムを書くのが至難の技になる．
通常は，定理は関数と違う定義方法を使う．証明モードに入り，作戦 (tactic) によって証明を
構築していく．各 tactic は導出規則と対応している．
 *)

Theorem modus_ponens' : P -> (P -> Q) -> Q. (* 異なる名前にする *)

(*
1 subgoal (* 証明の状況が表示される *)

P : Prop
Q : Prop

============================
P -> (P -> Q) -> Q
*)

Proof.
intros p pq. (* 仮定に名前を付ける (抽象) *)

(*
p : P
pq : P -> Q
============================
Q
 *)

apply pq. (* 目標を関数 pq の結果とみなす (適用) *)

(*
p : P
pq : P -> Q
============================
P
*)

assumption.
(* Proof completed. *)
Qed.
(* modus_ponens’ is defined *)

(* 実際の証明をもう一度みよう．*)

Theorem modus_ponens'' : P -> (P -> Q) -> Q.
Proof.
intros p pq.
apply pq.
assumption.
Qed.

(* and_self について同じことをする．*)
Theorem and_self' : P -> P /\ P.
Proof.
intros p.

(*
1 subgoal
p : P
============================
P /\ P
*)

split. (* 論理積の導入 (∧ 導入) *)

(*
2 subgoals (* 前提が二つある *)
p : P
============================
P

subgoal 2 is:
P
*)

assumption. (* 順番に解いていく *)

(*
1 subgoal
p : P
============================
P
*)

assumption.
Qed.

(* and_self’ is defined *)

Print and_self'. (* 実際の定義は前と変わらない *)

(* and_self’ = fun p : P => conj p p *)
(* : P -> P /\ P *)

(* セクションを閉じる *)
End Koushin.

Print and_self.
(* and_self = *) (* 必要な変数が定義に挿入される *)
(* fun (P : Prop) (x : P) => conj x x *)
(* : forall P : Prop, P -> P /\ P     *)

(* 否定に関する定理 *)
(* 証明状態の表示が作戦を読みにくくするので，これ以降は省くことにする．自分で Coq の中で実行して，確認して下さい．*)
Section Negation.

Variables P Q : Prop.
Theorem DeMorgan : ~ (P \/ Q) -> ~ P /\ ~ Q.
Proof.
  unfold not. (* ~ の定義を展開する *)
  intros npq.
  split; intros q. (* ; で両方の subgoal について intros q を行う *)
  apply npq.
  left. (* ∨ 導入の左を使う *)
  assumption.
  apply npq.
  right.
  assumption.
Qed.
(* DeMorgan is defined *)

(*
しかし，双対的な定理 (￢(P ∧ Q) ⊃ ￢P ∨ ￢Q) は直観主義論理ではなりたたない．
Hypothesisコマンドによって二重否定の除去を仮定すると証明できる．ちなみに，Hypothesis コマンドはVariables の異名でしかなくて，動作は全く同じである．
*)

Hypothesis classic : forall P, ~~P -> P. (* 任意の P について *)
(* classic is assumed *)

Theorem DeMorgan' : ~ (P /\ Q) -> ~ P \/ ~ Q.
Proof.
  intros npq.
  apply classic.
  intro nnpq.
  apply npq.
  clear npq. (* 不要な仮定を忘れる *)
  split; apply classic.
  intros np.
  apply nnpq.
  left.
  assumption.
  intros np; apply nnpq; right; assumption.
Qed.
(* DeMorgan’ is defined *)
End Negation.

(* 仮定を破壊する *)

(*
Coq の帰納的データ型に対して，値を破壊しながら中身を取り出すという tactic が便利であ
る．直接に対応する論理規則はないが，当然ながら他の論理規則から同じ結果を導くことは可能である．
*)

Section Destruct.
Variables P Q : Prop.
Theorem and_comm : P /\ Q -> Q /\ P.
Proof.
  intros pq.
  destruct pq as [p q]. (* 中身を取り出す *)
  split; assumption. (* 一気に終らせる *)
Qed.
(* and_comm is defined *)

Theorem or_comm : P \/ Q -> Q \/P.
Proof.
  intros pq.
  destruct pq as [p | q]. (* 場合が二つある *)
  right; assumption.
  left; assumption.
Qed.
(* or_comm is defined *)
End Destruct.

(* 論理規則と tactic の対応 *)

(*
論理規則 型付け規則 作戦
公理 変数 assumption
⊃ 導入 抽象 intros h
⊃ 除去 適用 apply h
矛盾 elimtype False
∧ 導入 直積 split
∧ 除去 射影 destruct h as [h1 h2]
∨ 導入 直和 left, right
∨ 除去 match destruct h as [h1 | h2]
*)

(* 練習問題 4.1 以下の定理を Coq で証明せよ．*)
Section Coq2.
Variables P Q R : Prop.

Theorem imp_trans : (P -> Q) -> (Q -> R) -> P -> R.
Proof.
Admitted.
Theorem not_false : ~False.
Proof.
Admitted.
Theorem double_neg : P -> ~~P.
Proof.
Admitted.
Theorem contraposition : (P -> Q) -> ~Q -> ~P.
Proof.
Admitted.
Theorem and_assoc : P /\ (Q /\ R) -> (P /\ Q) /\ R.
Proof.
Admitted.
Theorem and_distr : P /\ (Q \/ R) -> (P /\ Q) \/ (P /\ R).
Proof.
Admitted.
Theorem absurd : P -> ~P -> Q.
Proof.
Admitted.

End Coq2.


(** * Review: Midterm I  *)

Require Import Coq.omega.Omega.
Require Export Logic.

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

Questions:

1.  Check (nat -> list nat)    :: Set
2.  are forall and exists necesary and sufficient to enclose
    a Prop? what type of expression are allowed to be inside a prop?
     Set, Prop or Type ??

    {Set | Prop } << Type << ... << Type_{n+1} << ..

*)

Check (nat -> list nat).

(* Check (forall n : nat, n). not ok since n in nat *)
Check (forall n:Type, n).     (* ok since n in type *)
Check (forall n:nat, n = n).  (* ok since [n=n] in prop *)

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

Check (le 4).
Check (le_S 5 5).
Check (forall m : nat, le 5 m -> le 5 (S m)).

(* list a = nil | cons a (list a) *)

Inductive lists (X : Type) : Type :=
  | nils  : lists X
  | conss : X -> lists X -> lists X.

Check (conss).             (* forall X : Type, X -> lists X -> lists X *)
Check (conss nat 12).      (* lists nat -> lists nat*)

Inductive or (P Q : Prop) : Prop :=
  | or_l :  P -> or P Q
  | or_r :  Q -> or P Q.

Check (or_l True).


Add LoadPath "/home/sami/Programming/langs/coq/".
Require Export Basics.
Require Export SZUtility.

(*<------------------------------------------------------------------------->*)

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

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

(*<------------------------------------------------------------------------->*)

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

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

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

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

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

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

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

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

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

Theorem mult_m_Sn : forall m n : nat,
  m * S n = m + m * n.
Proof.
  intros.
  induction m as [| m'].
  Case "m = 0".
    reflexivity.
  Case "m = S m'".
    simpl.
    rewrite -> IHm'.
    rewrite -> plus_swap.
    reflexivity.
Qed.

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

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

(*<------------------------------------------------------------------------->*)

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

Theorem zero_nbeq_S : forall n : nat,
  beq_nat 0 (S n) = false.
Proof.
  intros.
  destruct n as [| n'].
  Case "n = 0".
    reflexivity.
  Case "n = S n'".
    reflexivity.
Qed.

Theorem andb_false_r : forall b : bool,
  andb b false = false.
Proof.
  intros.
  destruct b.
    reflexivity.
    reflexivity.
Qed.

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

Theorem S_nbeq_0 : forall n:nat,
  beq_nat (S n) 0 = false.
Proof.
  intros.
  destruct n as [| n'].
  Case "n = 0".
    reflexivity.
  Case "n = S n'".
    reflexivity.
Qed.

Theorem mult_1_l : forall n:nat,
  1 * n = n.
Proof.
  intros.
  simpl.
  rewrite -> plus_0_r.
  reflexivity.
Qed.

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

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

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

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

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

(*<------------------------------------------------------------------------->*)

Inductive bin : Type :=
  | BO :  bin
  | BT :  bin -> bin
  | BST : bin -> bin.

Fixpoint bin_incr (a : bin) : bin :=
  match a with
  | BO    => BST a
  | BT b  => BST b
  | BST c => BT (bin_incr c)
  end.

Fixpoint bin_to_nat (a : bin) : nat :=
  match a with
  | BO    => O
  | BT b  => 2 * (bin_to_nat b)
  | BST c => 1 + 2 * (bin_to_nat c)
  end.

Theorem bin_to_nat_pres_incr : forall n : bin,
  bin_to_nat (bin_incr n) = S (bin_to_nat n).
Proof.
  intros n.
  induction n.
  Case "n = BO".
    reflexivity.
  Case "n = BT b".
    reflexivity.
  Case "n = BST c".
    simpl.
    rewrite -> IHn.
    rewrite <- plus_n_O.
    rewrite <- plus_n_O.
    assert (forall x: nat, S(x) + S(x) = S(S(x + x))) as H.
      intros x.
      simpl.
      rewrite <- plus_n_Sm.
      reflexivity.
    rewrite -> H.
    reflexivity.
Qed.

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

Theorem nat_bin_nat : forall n : nat,
  n = bin_to_nat (nat_to_bin n).
Proof.
  intros n.
  induction n.
  Case "n = 0".
    reflexivity.
  Case "n = S n'".
    simpl.
    rewrite -> bin_to_nat_pres_incr.
    rewrite <- IHn.
    reflexivity.
Qed.