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

(* Axiom replace_with_your_solution_here : forall {A : Type}, A. *)

(** * Exercise *)

Fixpoint fib (n : nat) : nat :=
  if n is (n''.+1 as n').+1 then
    fib n'' + fib n'
  else n.

Arguments fib : simpl nomatch.

Fixpoint fib_iter (n : nat) (f0 f1 : nat) : nat :=
  if n is n'.+1 then
    fib_iter n' f1 (f0 + f1)
  else f0.

Arguments fib_iter : simpl nomatch.

Lemma fib_iterS n f0 f1 :
  fib_iter n.+1 f0 f1 = fib_iter n f1 (f0 + f1).
Proof. by []. Qed.

(** Sometimes instead of a custom induction
    principle we can come up with a different
    formulation of the specification.*)
Lemma fib_iter_spec n f0 f1 :
  fib_iter n.+1 f0 f1 = f0 * fib n + f1 * fib n.+1.
Proof.
elim: n f0 f1 => [| n IHn] f0 f1 ; first by rewrite /(fib 0) /(fib 1) muln0 muln1.
by rewrite fib_iterS IHn /= mulnDr mulnDl addnCA.
Qed.

Lemma fib_iter_correct' n :
  fib_iter n 0 1 = fib n.
Proof.
by case: n=> [| n] // ; rewrite (fib_iter_spec n 0 1) mul0n add0n mul1n.
Qed.

(** * Exercise *)
(** Implement a recursive function performing integer division by 2 *)
Fixpoint div2 (n : nat) : nat :=
    if n is (n''.+1 as n').+1 then
        1 + div2 n''
    else 0.

Arguments div2 : simpl nomatch.

(** * Exercise *)
Lemma nat_ind2' (P : nat -> Prop) :
  P 0 ->
  P 1 ->
  (forall n, P n -> P n.+2) ->
  forall n, P n.
Proof.
move=> p0 p1 IHyp n.
suff: P n /\ P n.+1 by case.
by elim: n => [| n] // [] /IHyp.
Qed.

(** Exercise: use [nat_ind2'] to prove the following *)
Lemma div2_le n : div2 n <= n.
Proof.
elim/nat_ind2': n=> // n IHn /=.
rewrite leqW //.
Qed.

(** Hints: you might want to use [leqW] view lemma *)

Lemma catA T :
  associative (@cat T).
Proof.
by move=> x y z ; elim: x=> // a l /= ->.
Qed.

(* Double induction *)
Lemma seq_ind2 {S T} (P : seq S -> seq T -> Type) :
  P [::] [::] ->
  (forall x y s t, size s = size t ->
                   P s t -> P (x :: s) (y :: t)) ->
  forall s t, size s = size t -> P s t.
Proof.
move=> P00 IHyp ; elim; first by move=> t /= st0 ; rewrite [t]size0nil.
by move=> x s IHs [// | y t /= [] st]; apply: IHyp => //; apply: IHs.
Qed.

(* === Optional exercises === *)

(* due to D.A. Turner, see his "Total Functional
Programming" (2004) paper *)

(** * Optional Exercise *)
Lemma fib_iter_spec' n p :
  fib_iter n (fib p) (fib p.+1) = fib (p + n).
Proof.
Admitted.

(** * Optional Exercise *)
Lemma fib_iter_correct'' n :
  fib_iter n 0 1 = fib n.
Proof.
Admitted.

(** * Optional Exercise *)
Lemma ltn_ind (P : nat -> Prop) :
  (forall m, (forall k : nat, (k < m) -> P k) -> P m) ->
  forall n, P n.
Proof.
Admitted.


Require Export Induction.
Module NatList.

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 length (l:natlist) : nat :=
  match l with
  | nil => O
  | h :: t => S (length t)
  end.

Fixpoint snoc (l:natlist) (x:nat) : natlist :=
  match l with
  | nil => x :: nil
  | h :: t => h :: (snoc t x)
  end.

(* Exercise: Define the "member" function on natlists *)
Fixpoint member (l:natlist) (x:nat) : bool := admit.

(* Prove the following three theorems. Looking at them: Which do you
need to use induction on? Which require destruct (only)? Which require
only intros and reflexivity? *)

Theorem member_in_cons : forall (l : natlist) (x : nat),
  member (x :: l) x = true.
Proof. Admitted.

Theorem member_not_in_nil : forall (x : nat),
  member (nil) x = false.
Proof. Admitted.

Theorem snoc_plus_one : forall (x : nat) (l : natlist),
  length (snoc l x) = 1 + (length l).
Proof. Admitted.

(* To do: Quick visit of PartialMap from Lists.v *)


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

Lemma excluded_middle_peirce : excluded_middle -> peirce.
Proof.
 unfold peirce; intros H P Q H0.
 destruct (H P) as [p | np].
 -  assumption.
 -  apply H0; intro H1; now absurd P.
Qed.

Lemma peirce_classic : peirce -> classic.
Proof.
 intros HPeirce P H0; apply (HPeirce P False).
 intro H1; now destruct H0.
Qed.

Lemma classic_excluded_middle: classic -> excluded_middle.
Proof.
 unfold excluded_middle; intros H P.
 apply H; intro H0; absurd P.
 -  intro H1; apply H0 ; now left.
 -  apply H; intro H1; apply H0; now right.
Qed.

Lemma excluded_middle_implies_to_or :  excluded_middle -> implies_to_or.
Proof.
 intros H P Q H0;
  destruct (H P) as [p | np].
  -  right; auto.
  - now  left.
Qed.

Lemma implies_to_or_excluded_middle : implies_to_or -> excluded_middle.
Proof.
 unfold excluded_middle; intros H P; destruct (H P P);auto.
Qed.

Lemma classic_de_morgan_not_and_not : classic ->
                                      de_morgan_not_and_not.
Proof.
 unfold de_morgan_not_and_not; intros H P Q H0.
 apply H.
 intro H1; apply H0; split;intro;apply H1; auto.
Qed.

Lemma de_morgan_not_and_not_excluded_middle : de_morgan_not_and_not ->
                                              excluded_middle.
Proof.
 unfold excluded_middle; intros H P.
 apply H; intros [H1 H2]; contradiction.
Qed.


Require Import Nat Arith.

Inductive Nat : Type := zero : Nat | succ : Nat -> Nat.

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

Inductive Tree : Type := node : Nat -> Tree -> Tree -> Tree |  leaf : Tree.

Inductive Pair : Type := mkpair : Nat -> Nat -> Pair
with ZLst : Type := zcons : Pair -> ZLst -> ZLst |  znil : ZLst.

Fixpoint plus (plus_arg0 : Nat) (plus_arg1 : Nat) : Nat
           := match plus_arg0, plus_arg1 with
              | zero, n => n
              | succ n, m => succ (plus n m)
              end.

Fixpoint mult (mult_arg0 : Nat) (mult_arg1 : Nat) : Nat
           := match mult_arg0, mult_arg1 with
              | zero, n => zero
              | succ n, m => plus (mult n m) m
              end.

Fixpoint fac (fac_arg0 : Nat) : Nat
           := match fac_arg0 with
              | zero => succ zero
              | succ n => mult (fac n) n
              end.

Fixpoint qfac (qfac_arg0 : Nat) (qfac_arg1 : Nat) : Nat
           := match qfac_arg0, qfac_arg1 with
              | zero, n => n
              | succ n, m => qfac n (mult m n)
              end.

Lemma plus_succ : forall (x y : Nat), plus x (succ y) = succ (plus x y).
Proof.
  intros.
  induction x.
  - reflexivity.
  - simpl. rewrite IHx. reflexivity.
Qed.

Lemma plus_assoc : forall (x y z : Nat), plus (plus x y) z = plus x (plus y z).
Proof.
  intros.
  induction x.
  - reflexivity.
  - simpl. rewrite IHx. reflexivity.
Qed.

Lemma plus_zero : forall (x : Nat), plus x zero = x.
Proof.
  intros.
  induction x.
  - reflexivity.
  - simpl. rewrite IHx. reflexivity.
Qed.

Lemma plus_commut : forall (x y : Nat), plus x y = plus y x.
Proof.
  intros.
  induction x.
  - rewrite plus_zero. reflexivity.
  - simpl. rewrite plus_succ. rewrite IHx. reflexivity.
Qed.

Lemma mult_zero : forall (x : Nat), mult x zero = zero.
Proof.
  intros.
  induction x.
  - reflexivity.
  - simpl. rewrite IHx. reflexivity.
Qed.

Lemma mult_succ : forall (x y : Nat), plus (mult x y) x = mult x (succ y).
Proof.
  intros.
  induction x.
  - reflexivity.
  - simpl. rewrite plus_succ. rewrite plus_assoc. rewrite (plus_commut y x). rewrite <- plus_assoc. rewrite IHx. rewrite plus_succ. reflexivity.
Qed.

Lemma mult_commut : forall (x y : Nat), mult x y = mult y x.
Proof.
  intros.
  induction x.
  - rewrite mult_zero. reflexivity.
  - simpl. rewrite IHx. rewrite mult_succ. reflexivity.
Qed.

Lemma distrib : forall (x y z : Nat), mult (plus x y) z = plus (mult x z) (mult y z).
Proof.
  intros.
  induction x.
  - reflexivity.
  - simpl. rewrite IHx. rewrite plus_assoc. rewrite (plus_commut (mult y z) z). rewrite <- plus_assoc. reflexivity.
Qed.

Lemma mult_assoc : forall (x y z : Nat), mult (mult x y) z = mult x (mult y z).
Proof.
  intros.
  induction x.
  - reflexivity.
  - simpl. rewrite distrib. rewrite IHx. reflexivity.
Qed.

Lemma qfac_mult : forall (x y : Nat), qfac x y = mult (qfac x (succ zero)) y.
Proof.
  intro.
  induction x.
  - reflexivity.
  - intros. simpl. rewrite IHx. rewrite (IHx x). rewrite mult_assoc. rewrite (mult_commut y x). reflexivity.
Qed.

Theorem fac_eq_qfac : forall (x : Nat), eq (fac x) (qfac x (succ zero)).
Proof.
  intros.
  induction x.
  - reflexivity.
  - simpl. rewrite qfac_mult. rewrite IHx. reflexivity.
Qed.


From Coq Require Import ssreflect ssrfun ssrbool.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Theorem contrapositive : forall (P Q : Prop), (P -> Q) -> (~Q -> ~P).
Proof.
  intros P Q H NQ PP.
  apply (NQ (H PP)).
Qed.

Inductive seq : nat -> Set :=
  | niln : seq 0
  | consn : forall n : nat, nat -> seq n -> seq (S n).

Fixpoint length (n : nat) (s : seq n) {struct s} : nat :=
  match s with
  | niln => 0
  | consn _ s' => S (length s')
  end.

Theorem length_corr : forall (n : nat) (s : seq n), length s = n.
Proof.
  intros n s.
  induction s.
  simpl.
  trivial.
  simpl.
  rewrite IHs.
  trivial.
Qed.

Lemma add_succ : forall (n m : nat), n + S m = S (n + m).
Proof.
  intros n m.
  induction n.

  simpl.
  trivial.

  simpl.
  rewrite IHn.
  trivial.
Qed.

Theorem add_comm : forall (n m : nat), n + m = m + n.
Proof.
  intros n m.

  induction m.
  induction n.
  trivial.

  simpl.
  rewrite IHn.
  simpl.
  trivial.

  simpl.
  symmetry in IHm.
  rewrite IHm.
  apply add_succ.
Qed.

Lemma add_zero : forall (n : nat), n + 0 = n.
Proof.
  intros.
  rewrite add_comm.
  simpl.
  trivial.
Qed.

Theorem add_assoc : forall (n m k : nat), n + (m + k) = (n + m) + k.
Proof.
  intros n m k.

  induction n.
  simpl.
  trivial.

  rewrite add_comm.
  rewrite add_succ.
  rewrite add_comm.
  rewrite IHn.
  simpl.
  trivial.
Qed.

Theorem add_switch : forall (n m k : nat), n + (m + k) = m + (n + k).
Proof.
  intros.
  rewrite add_assoc.
  rewrite [n + m]add_comm.
  rewrite -add_assoc.
  trivial.
Qed.

Theorem add_elim : forall (n m k : nat), (n + m = n + k) -> (m = k).
Proof.
  intros.
  induction n.
  apply H.

  assert (P : n + m = n + k).
  simpl in H.
  injection H.
  trivial.
  apply IHn in P.
  trivial.
Qed.

Theorem add_elim_simple : forall (n m : nat), n + m = n -> m = 0.
Proof.
  intros.
  rewrite -[n]add_zero in H.
  rewrite -add_assoc in H.
  simpl in H.
  apply add_elim in H.
  apply H.
Qed.

Theorem mult_succ : forall (n m : nat), m + m * n = m * S n.
Proof.
  intros.
  induction m.
  trivial.
  simpl.
  rewrite add_assoc.
  rewrite [m + n]add_comm.
  rewrite -add_assoc.
  rewrite IHm.
  trivial.
Qed.

Theorem mult_comm : forall (n m : nat), n * m = m * n.
Proof.
  intros.
  induction n.
  induction m.
  trivial.
  trivial.

  simpl.
  rewrite IHn.
  apply mult_succ.
Qed.

Theorem mult_dist : forall (n m k : nat), n * (m + k) = n * m + n * k.
Proof.
  intros.
  induction n.
  trivial.

  simpl.
  rewrite IHn.
  rewrite -[m + k + (n * m + n * k)]add_assoc.
  rewrite [k + (n * m + n * k)]add_assoc.
  rewrite [k + n * m]add_comm.
  rewrite -[n * m + k + n * k]add_assoc.
  rewrite add_assoc.
  trivial.
Qed.

Theorem mult_assoc : forall (n m k : nat), n * (m * k) = (n * m) * k.
Proof.
  intros.
  induction n.
  trivial.
  simpl.
  rewrite IHn.
  rewrite mult_comm.
  rewrite [n * m * k]mult_comm.
  rewrite -mult_dist.
  rewrite mult_comm.
  trivial.
Qed.

Theorem add_zpp : forall (n m : nat), n + m = 0 -> n = 0 /\ m = 0.
Proof.
  split.
  induction n.
  trivial.
  simpl in H.
  inversion H.

  induction m.
  trivial.
  rewrite add_succ in H.
  inversion H.
Qed.

Theorem mult_zpp : forall (n m : nat), n * m = 0 -> n = 0 \/ m = 0.
Proof.
  intros.
  induction n.
  left.
  trivial.

  right.
  simpl in H.
  apply add_zpp in H.
  destruct H as [Hl Hr].
  apply Hl.
Qed.

Definition le (n m : nat) : Prop := exists (k : nat), k + n = m.

Theorem le_trans : forall (n m k : nat), le n m -> le m k -> le n k.
Proof.
  intros n m k [i Hi] [j Hj].
  exists (j + i).
  rewrite -Hi in Hj.
  rewrite add_assoc in Hj.
  apply Hj.
Qed.

Theorem le_refl : forall (n : nat), le n n.
Proof.
  intros.
  exists 0.
  trivial.
Qed.

Theorem le_succ : forall (n : nat), le n (S n).
Proof.
  intro n.
  exists 1.
  simpl.
  trivial.
Qed.

Theorem le_anti_sym : forall (n m : nat), le n m -> le m n -> n = m.
Proof.
  intros n m [i Hi] [j Hj].
  rewrite -Hi in Hj.
  rewrite [i + n]add_comm in Hj.
  rewrite add_switch in Hj.
  apply add_elim_simple in Hj.
  apply add_zpp in Hj.
  destruct Hj as [_ Pi].
  rewrite Pi in Hi.
  simpl in Hi.
  apply Hi.
Qed.

Definition divides_with (n m r : nat) : Prop := exists (q : nat), r + q * n = m /\ 0 <= r < q.

Definition divides (n m : nat) : Prop := exists (k : nat), k * n = m.

Theorem divides_both : forall (n m k : nat), n * m = k -> divides n k /\ divides m k.
Proof.
  split.
  exists m; rewrite mult_comm; apply H.
  exists n; apply H.
Qed.

Theorem divides_trans : forall (n m k : nat), divides n m -> divides m k -> divides n k.
Proof.
  intros n m k [i Hn] [j Hm].
  rewrite -Hn in Hm.
  rewrite mult_assoc in Hm.
  exists (j * i).
  apply Hm.
Qed.

Theorem divides_refl : forall (n : nat), divides n n.
Proof.
  intros.
  exists 1.
  simpl; rewrite add_comm; simpl.
  trivial.
Qed.

Theorem divides_one : forall (n : nat), divides 1 n.
Proof.
  intros.
  exists n.
  rewrite mult_comm.
  simpl.
  rewrite add_zero. trivial.
Qed.

Theorem divides_le : forall (n m : nat), divides n m -> le n m \/ m = 0.
Proof.
  intros n m [k Hk].
  induction k.
  simpl in Hk.
  right; symmetry; apply Hk.

  left.
  simpl in Hk.
  exists (k * n).
  rewrite add_comm in Hk.
  apply Hk.
Qed.

Theorem divides_anti_sym : forall (n m : nat), divides n m -> divides m n -> n = m.
  intros n m p q.
  pose proof (divides_le p) as Hp.
  pose proof (divides_le q) as Hq.
  destruct p as [k Hk]; destruct q as [j Hj].
  destruct Hp as [ple | p0].
  destruct Hq as [qle | q0].
  - apply ((le_anti_sym ple) qle).
  - transitivity 0.
    apply q0.
    rewrite q0 in Hk.
    rewrite mult_comm in Hk; simpl in Hk; apply Hk.
  - symmetry; transitivity 0.
    apply p0.
    rewrite p0 in Hj; rewrite mult_comm in Hj; simpl in Hj; apply Hj.
Qed.

Theorem mult_one : forall (n m : nat), n * m = 1 -> n = 1 /\ m = 1.
  intros.
  pose proof (divides_both H) as [Pn Pm].
  split.
  apply ((divides_anti_sym Pn) (divides_one n)).
  apply ((divides_anti_sym Pm) (divides_one m)).
Qed.

Definition prime (p : nat) : Prop := forall (n : nat), divides n p -> n = 1 \/ n = p.

Definition composite (c : nat) : Prop := exists (n m : nat), n * m = c /\ n <> 1 /\ n <> c.

Theorem decidable_eq : forall (n m : nat), n = m \/ n <> m.
Proof.
  intros n.
  induction n.
  intro m.
  destruct m.
  left; trivial.
  right; trivial.

  intro m.
  destruct m.
  right.
  inversion 1.

  destruct (IHn m) as [IHn_eq | IHn_neq].
  - left. rewrite IHn_eq. trivial.
  - right. injection. apply IHn_neq.
Defined.

Theorem prime_not_comp : forall (p : nat), p <> 1 -> prime p <-> ~ composite p.
  intros p H. split. intro Pp.
  unfold not; intro Cp.
  destruct Cp as [n [m [Hnm [Hnn Hnc]]]].
  cut (divides n p).
  intro L.
  apply Pp in L.
  destruct L as [Lpn | Lnp].
  - apply (Hnn Lpn).
  - apply (Hnc Lnp).
  - exists (m).
    rewrite mult_comm; apply Hnm.
  - intro NCp. unfold not in NCp.
    intros m [k Hk].
    pose proof (decidable_eq m 1) as [Mone_eq | Mone_neq].
    -- left. apply Mone_eq.
    -- right.
       pose proof (decidable_eq m p) as [Mp_eq | Mp_neq].
       * apply Mp_eq.
       * cut (composite p).
         intro Cp. exfalso. apply (NCp Cp).
         exists m.
         exists k.
         rewrite mult_comm in Hk.
         split.
         apply Hk.
         split.
         apply Mone_neq.
         apply Mp_neq.
Qed.

Definition less (n m : nat) : Prop := le n m /\ n <> m.

Theorem less_succ : forall (n : nat), less n (S n).
Proof.
  intro n. split.
  apply le_succ.
  induction n.
  trivial.

  injection. apply IHn.
Qed.

Theorem less_zero : forall (n : nat), ~ less n 0.
Proof.
  intro n. unfold not. intro P.
  destruct P as [Ple Pneq].
  induction n.
  auto.

  destruct Ple as [k Pk].
  pose proof (add_zpp Pk) as [Hk HSn].
  inversion HSn.
Qed.

Theorem le_ind : forall (n m : nat), le n (S m) -> le n m \/ n = S m.
Proof.
  intros n m [k Hk].
  destruct k.
  right.
  simpl in Hk. apply Hk.

  left; exists k.
  simpl in Hk.
  injection Hk.
  trivial.
Qed.

Theorem le_less : forall (n m : nat), le n m <-> less n (S m).
Proof.
  intros n m.
  split.
  - intro H.
    split.
    -- apply ((le_trans H) (le_succ m)).
    -- destruct H as [k Hk].
       destruct k.
       --- simpl in Hk.
           rewrite Hk.
           trivial.
       --- rewrite add_comm in Hk; simpl in Hk.
           rewrite -Hk.
           rewrite -add_succ.
           rewrite -[n]add_zero.
           rewrite -add_assoc.
           simpl.
           cut (0 <> S (S k)). intro P.
           pose proof ((decidable_eq (n + 0)) (n + S (S k))) as [Qeq | Qneq].
           * pose proof (add_elim Qeq) as NQ.
             exfalso. apply (P NQ).
           * apply Qneq.
           * trivial.
  - intro H.
    destruct H as [Hle Hneq].
    pose proof (le_ind Hle) as [Hlem | Heq].
    -- apply Hlem.
    -- exfalso. apply (Hneq Heq).
Qed.

Theorem less_trans : forall (n m k : nat), less n m -> less m k -> less n k.
Proof.
  intros n m k P Q.
  destruct m.
  - exfalso. apply (less_zero P).
  - destruct k.
    exfalso; apply (less_zero Q).
    apply le_less in P.
    apply le_less in Q.
    pose proof (le_succ m) as H.
    pose proof ((le_trans P) H) as A.
    pose proof ((le_trans A) Q) as J.
    apply le_less in J.
    apply J.
Qed.

Theorem succ_neq : forall (n m k : nat), n <> 0 -> n + m = k -> m <> k.
Proof.
  intros n m k H P.
  pose proof (decidable_eq m k) as [Qeq | Qneq].
  - rewrite -[k]add_zero in P.
    rewrite add_comm in P.
    rewrite Qeq in P.
    apply add_elim in P.
    exfalso.
    apply (H P).
  - apply Qneq.
Qed.

Theorem less_ind : forall (n m : nat), less n (S m) -> less n m \/ n = m.
Proof.
  intros n m [Hle Hneq].
  apply le_ind in Hle.
  destruct Hle as [[k Hk] | Hle_eq].
  - destruct k.
    -- simpl in Hk. right. apply Hk.
    -- cut (S k <> 0). intro A.
       pose proof ((succ_neq A) Hk) as Q.
       left.
       split.
       * exists (S k). apply Hk.
       * apply Q.
       * auto.
  - exfalso. apply (Hneq Hle_eq).
Qed.

Theorem le_def : forall (n m : nat), le n m <-> less n m \/ n = m.
Proof.
  intros n m.
  split.
  intro P.
  apply le_less in P.
  apply less_ind.
  apply P.
  intro Q.
  destruct Q as [Qless | Qeq].
  - pose proof (less_succ m) as H.
    pose proof ((less_trans Qless) H) as K.
    apply le_less in K.
    apply K.
  - rewrite Qeq.
    apply (le_refl m).
Qed.

Theorem strong_ind : forall (P : nat -> Prop), (forall (n : nat), (forall (k : nat), less k n -> P k) -> P n) -> (forall (n : nat), P n).
Proof.
  intros P H n.
  cut (forall (m j : nat), le j m -> P j).
  * intro A.
    pose proof (le_refl n) as RefN.
    pose proof ((A n) n) as AN.
    apply (AN RefN).
  * intro m.
    induction m.

    ** intro j; intro Q.
       apply le_def in Q.
       destruct Q as [Qless | Qeq].
       - exfalso. apply (less_zero Qless).
       - cut (forall (k : nat), less k 0 -> P k).
         -- intro A.
            rewrite Qeq.
            apply ((H 0) A).
         -- intros k K. exfalso. apply (less_zero K).
    ** intros j LEJ.
       apply le_def in LEJ.
       destruct LEJ as [LEJ_less | LEJ_eq].
       - apply le_less in LEJ_less.
         apply ((IHm j) LEJ_less).
       - rewrite LEJ_eq.
         cut (forall (k : nat), less k (S m) -> P k).
         -- intro L.
            apply ((H (S m)) L).
         -- intros k K.
            apply le_less in K.
            apply le_def in K.
            destruct K as [K_less | K_eq].
            --- pose proof (less_succ m) as A.
                pose proof ((less_trans K_less) A) as K_le.
                apply le_less in K_le.
                apply ((IHm k) K_le).
            --- pose proof (le_refl m) as A.
                rewrite K_eq.
                apply ((IHm m) A).
Qed.


Require Import Bool Arith List.

Variables P Q R : Prop.

(* 5. Write the script that proves the following formula
   (P -> (P /\ Q) -> R) -> P /\ (Q /\ P) -> R. *)

Lemma ex5 :
   (P -> (P /\ Q) -> R) -> P /\ (Q /\ P) -> R.
Proof.
intros r_if_pq_if_p.
intros pqp.
  destruct pqp as [p qp].
  apply r_if_pq_if_p.
  exact p.
  split.
  exact p.
apply qp.

Qed.

(* 7. Write the script that proves the following formula
     (P /\ Q) \/ R -> P \/ R *)

Lemma ex6 :
  (P /\ Q) \/ R -> P \/ R.
Proof.
intros p_a_q_o_r.
destruct p_a_q_o_r as [ pq | r].

destruct pq as [ p q].

left.
exact p.
right.
exact r.

Qed.

(* 7. Write the script that proves the following formula
   ((P -> Q \/ P) -> R) -> R \/ Q  *)

Lemma ex7 :
  ((P -> Q \/ P) -> R) -> R \/ Q.
Proof.

intros qp_if_p.
left.
apply qp_if_p.
intros qop_if_p.
right.
exact qop_if_p.
Qed.

(*
8. P \/ R -> (P -> Q) -> ~ Q -> R
*)
Lemma ex8 :
  P \/ R -> (P -> Q) -> ~ Q -> R.
Proof.
  intros pr.
  intros q_if_p.
  intros nq.
  destruct pr as [p | r].
  case nq.
  apply q_if_p.
  exact p.
  exact r.
Qed.

(*
9. P \/ ~Q -> ~P -> (Q -> R) \/ P
*)

Lemma ex9 :
  P \/ ~Q -> ~P -> (Q -> R) \/ P.
Proof.
intros p_o_nq.
intros np.
destruct p_o_nq as [p | nq].
right.
exact p.
left.
intros q.
case nq.
exact q.
Qed.