(** * Logic: Logic in Coq *)

Require Export BasicTactics.

(** Coq's built-in logic is very small: the only primitives are
    [Inductive] definitions, universal quantification ([forall]), and
    implication ([->]), while all the other familiar logical
    connectives -- conjunction, disjunction, negation, existential
    quantification, even equality -- can be encoded using just these.

    This chapter explains the encodings and shows how the tactics
    we've seen can be used to carry out standard forms of logical
    reasoning involving these connectives.

*)

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

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

(** In Coq, the type of things that can (potentially)
    be proven is [Prop]. *)

(** Here is an example of a provable proposition: *)

Check (3 = 3).
(* ===> Prop *)

(** Here is an example of an unprovable proposition: *)

Check (forall (n:nat), n = 2).
(* ===> Prop *)

(** Recall that [Check] asks Coq to tell us the type of the indicated
  expression. *)

(* ########################################################### *)
(** * Proofs and Evidence *)

(** In Coq, propositions have the same status as other types, such as
    [nat].  Just as the natural numbers [0], [1], [2], etc. inhabit
    the type [nat], a Coq proposition [P] is inhabited by its
    _proofs_.  We will refer to such inhabitants as _proof term_ or
    _proof object_ or _evidence_ for the truth of [P].

    In Coq, when we state and then prove a lemma such as:

Lemma silly : 0 * 3 = 0.
Proof. reflexivity. Qed.

    the tactics we use within the [Proof]...[Qed] keywords tell Coq
    how to construct a proof term that inhabits the proposition.  In
    this case, the proposition [0 * 3 = 0] is justified by a
    combination of the _definition_ of [mult], which says that [0 * 3]
    _simplifies_ to just [0], and the _reflexive_ principle of
    equality, which says that [0 = 0].

*)

(** *** *)

Lemma silly : 0 * 3 = 0.
Proof. reflexivity. Qed.

(** We can see which proof term Coq constructs for a given Lemma by
using the [Print] directive: *)

Print silly.
(* ===> silly = eq_refl : 0 * 3 = 0 *)

(** Here, the [eq_refl] proof term witnesses the equality. (More on
equality later!)*)

(** ** Implications _are_ functions *)

(** Just as we can implement natural number multiplication as a
function:

[
mult : nat -> nat -> nat
]

The _proof term_ for an implication [P -> Q] is a _function_ that
takes evidence for [P] as input and produces evidence for [Q] as its
output.
*)

Lemma silly_implication : (1 + 1) = 2  ->  0 * 3 = 0.
Proof. intros H. reflexivity. Qed.

(** We can see that the proof term for the above lemma is indeed a
function: *)

Print silly_implication.
(* ===> silly_implication = fun _ : 1 + 1 = 2 => eq_refl
     : 1 + 1 = 2 -> 0 * 3 = 0 *)

(** ** Defining propositions *)

(** Just as we can create user-defined inductive types (like the
    lists, binary representations of natural numbers, etc., that we
    seen before), we can also create _user-defined_ propositions.

    Question: How do you define the meaning of a proposition?
*)

(** *** *)

(** The meaning of a proposition is given by _rules_ and _definitions_
    that say how to construct _evidence_ for the truth of the
    proposition from other evidence.

    - Typically, rules are defined _inductively_, just like any other
      datatype.

    - Sometimes a proposition is declared to be true without
      substantiating evidence.  Such propositions are called _axioms_.

    In this and subsequent chapters, we'll see more about how these
    proof terms work in more detail.
*)

(* ########################################################### *)
(** * Conjunction (Logical "and") *)

(** The logical conjunction of propositions [P] and [Q] can be
    represented using an [Inductive] definition with one
    constructor. *)

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

(** The intuition behind this definition is simple: to
    construct evidence for [and P Q], we must provide evidence
    for [P] and evidence for [Q].  More precisely:

    - [conj p q] can be taken as evidence for [and P Q] if [p]
      is evidence for [P] and [q] is evidence for [Q]; and

    - this is the _only_ way to give evidence for [and P Q] --
      that is, if someone gives us evidence for [and P Q], we
      know it must have the form [conj p q], where [p] is
      evidence for [P] and [q] is evidence for [Q].

   Since we'll be using conjunction a lot, let's introduce a more
   familiar-looking infix notation for it. *)

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

(** (The [type_scope] annotation tells Coq that this notation
    will be appearing in propositions, not values.) *)

(** Consider the "type" of the constructor [conj]: *)

Check conj.
(* ===>  forall P Q : Prop, P -> Q -> P /\ Q *)

(** Notice that it takes 4 inputs -- namely the propositions [P]
    and [Q] and evidence for [P] and [Q] -- and returns as output the
    evidence of [P /\ Q]. *)

(** ** "Introducing" conjunctions *)
(** Besides the elegance of building everything up from a tiny
    foundation, what's nice about defining conjunction this way is
    that we can prove statements involving conjunction using the
    tactics that we already know.  For example, if the goal statement
    is a conjuction, we can prove it by applying the single
    constructor [conj], which (as can be seen from the type of [conj])
    solves the current goal and leaves the two parts of the
    conjunction as subgoals to be proved separately. *)

Theorem and_example :
  (0 = 0) /\ (4 = mult 2 2).
Proof.
  apply conj.
  - (* left *) reflexivity.
  - (* right *) reflexivity.  Qed.

(** Just for convenience, we can use the tactic [split] as a shorthand for
    [apply conj]. *)

Theorem and_example' :
  (0 = 0) /\ (4 = mult 2 2).
Proof.
  split.
    - (* left *) reflexivity.
    - (* right *) reflexivity.  Qed.

(** ** "Eliminating" conjunctions *)
(** Conversely, the [destruct] tactic can be used to take a
    conjunction hypothesis in the context, calculate what evidence
    must have been used to build it, and add variables representing
    this evidence to the proof context. *)

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

(** **** Exercise: 1 star, optional (proj2)  *)
Theorem proj2 : forall P Q : Prop,
  P /\ Q -> Q.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

Theorem and_commut : forall P Q : Prop,
  P /\ Q -> Q /\ P.
Proof.
  (* WORKED IN CLASS *)
  intros P Q H.
  destruct H as [HP HQ].
  split.
    - (* left *) apply HQ.
    - (* right *) apply HP.  Qed.

(** **** Exercise: 2 stars (and_assoc)  *)
(** In the following proof, notice how the _nested pattern_ in the
    [destruct] breaks the hypothesis [H : P /\ (Q /\ R)] down into
    [HP: P], [HQ : Q], and [HR : R].  Finish the proof from there: *)

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

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

(** The handy "if and only if" connective is just the conjunction of
    two implications. *)

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

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

Theorem iff_implies : forall P Q : Prop,
  (P <-> Q) -> P -> Q.
Proof.
  intros P Q H.
  destruct H as [HAB HBA]. apply HAB.  Qed.

Theorem iff_sym : forall P Q : Prop,
  (P <-> Q) -> (Q <-> P).
Proof.
  (* WORKED IN CLASS *)
  intros P Q H.
  destruct H as [HAB HBA].
  split.
    - (* -> *) apply HBA.
    - (* <- *) apply HAB.  Qed.

(** **** Exercise: 1 star, optional (iff_properties)  *)
(** Using the above proof that [<->] is symmetric ([iff_sym]) as
    a guide, prove that it is also reflexive and transitive. *)

Theorem iff_refl : forall P : Prop,
  P <-> P.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem iff_trans : forall P Q R : Prop,
  (P <-> Q) -> (Q <-> R) -> (P <-> R).
Proof.
  (* FILL IN HERE *) Admitted.

(** Hint: If you have an iff hypothesis in the context, you can use
    [inversion] to break it into two separate implications.  (Think
    about why this works.) *)
(** [] *)

(** Some of Coq's tactics treat [iff] statements specially, thus
    avoiding the need for some low-level manipulation when reasoning
    with them.  In particular, [rewrite] can be used with [iff]
    statements, not just equalities. *)

(* ############################################################ *)
(** * Disjunction (Logical "or") *)

(** ** Implementing disjunction *)

(** Disjunction ("logical or") can also be defined as an
    inductive proposition. *)

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

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

(** Consider the "type" of the constructor [or_introl]: *)

Check or_introl.
(* ===>  forall P Q : Prop, P -> P \/ Q *)

(** It takes 3 inputs, namely the propositions [P], [Q] and
    evidence of [P], and returns, as output, the evidence of [P \/ Q].
    Next, look at the type of [or_intror]: *)

Check or_intror.
(* ===>  forall P Q : Prop, Q -> P \/ Q *)

(** It is like [or_introl] but it requires evidence of [Q]
    instead of evidence of [P]. *)

(** Intuitively, there are two ways of giving evidence for [P \/ Q]:

    - give evidence for [P] (and say that it is [P] you are giving
      evidence for -- this is the function of the [or_introl]
      constructor), or

    - give evidence for [Q], tagged with the [or_intror]
      constructor. *)

(** *** *)
(** Since [P \/ Q] has two constructors, doing [destruct] on a
    hypothesis of type [P \/ Q] yields two subgoals. *)

Theorem or_commut : forall P Q : Prop,
  P \/ Q  -> Q \/ P.
Proof.
  intros P Q H.
  destruct H as [HP | HQ].
    - (* left *) apply or_intror. apply HP.
    - (* right *) apply or_introl. apply HQ.  Qed.

(** From here on, we'll use the shorthand tactics [left] and [right]
    in place of [apply or_introl] and [apply or_intror]. *)

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

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

(** **** Exercise: 2 stars (or_distributes_over_and_2)  *)
Theorem or_distributes_over_and_2 : forall P Q R : Prop,
  (P \/ Q) /\ (P \/ R) -> P \/ (Q /\ R).
Proof.
  intros. inversion H as [HPQ HPR]. inversion HPQ as [HP | HQ].
  - left. apply HP.
  - inversion HPR as [ HP | HR ].
    + left. apply HP.
    + right. apply conj.
      * apply HQ.
      * apply HR.
Qed.
(** [] *)

(** **** Exercise: 1 star, optional (or_distributes_over_and)  *)
Theorem or_distributes_over_and : forall P Q R : Prop,
  P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ################################################### *)
(** ** Relating [/\] and [\/] with [andb] and [orb] *)

(** We've already seen several places where analogous structures
    can be found in Coq's computational ([Type]) and logical ([Prop])
    worlds.  Here is one more: the boolean operators [andb] and [orb]
    are clearly analogs of the logical connectives [/\] and [\/].
    This analogy can be made more precise by the following theorems,
    which show how to translate knowledge about [andb] and [orb]'s
    behaviors on certain inputs into propositional facts about those
    inputs. *)

Theorem andb_prop : forall b c,
  andb b c = true -> b = true /\ c = true.
Proof.
  (* WORKED IN CLASS *)
  intros b c H.
  destruct b.
    - (* b = true *) destruct c.
      + (* c = true *) apply conj. reflexivity. reflexivity.
      + (* c = false *) inversion H.
    - (* b = false *) inversion H.  Qed.

Theorem andb_true_intro : forall b c,
  b = true /\ c = true -> andb b c = true.
Proof.
  (* WORKED IN CLASS *)
  intros b c H.
  destruct H.
  rewrite H. rewrite H0. reflexivity. Qed.

(** **** Exercise: 2 stars, optional (andb_false)  *)
Theorem andb_false : forall b c,
  andb b c = false -> b = false \/ c = false.
Proof.
  (* FILL IN HERE *) Admitted.

(** **** Exercise: 2 stars, optional (orb_false)  *)
Theorem orb_prop : forall b c,
  orb b c = true -> b = true \/ c = true.
Proof.
  (* FILL IN HERE *) Admitted.

(** **** Exercise: 2 stars, optional (orb_false_elim)  *)
Theorem orb_false_elim : forall b c,
  orb b c = false -> b = false /\ c = false.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

(** Logical falsehood can be represented in Coq as an inductively
    defined proposition with no constructors. *)

Inductive False : Prop := .

(** Intuition: [False] is a proposition for which there is no way
    to give evidence. *)

(** Since [False] has no constructors, inverting an assumption
    of type [False] always yields zero subgoals, allowing us to
    immediately prove any goal. *)

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

(** How does this work? The [inversion] tactic breaks [contra] into
    each of its possible cases, and yields a subgoal for each case.
    As [contra] is evidence for [False], it has _no_ possible cases,
    hence, there are no possible subgoals and the proof is done. *)

(** *** *)
(** Conversely, the only way to prove [False] is if there is already
    something nonsensical or contradictory in the context: *)

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

(** Actually, since the proof of [False_implies_nonsense]
    doesn't actually have anything to do with the specific nonsensical
    thing being proved; it can easily be generalized to work for an
    arbitrary [P]: *)

Theorem ex_falso_quodlibet : forall (P:Prop),
  False -> P.
Proof.
  (* WORKED IN CLASS *)
  intros P contra.
  inversion contra.  Qed.

(** The Latin _ex falso quodlibet_ means, literally, "from
    falsehood follows whatever you please."  This theorem is also
    known as the _principle of explosion_. *)

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

(** Since we have defined falsehood in Coq, one might wonder whether
    it is possible to define truth in the same way.  We can. *)

(** **** Exercise: 2 stars, advanced (True)  *)
(** Define [True] as another inductively defined proposition.  (The
    intuition is that [True] should be a proposition for which it is
    trivial to give evidence.) *)

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

(** However, unlike [False], which we'll use extensively, [True] is
    used fairly rarely. By itself, it is trivial (and therefore
    uninteresting) to prove as a goal, and it carries no useful
    information as a hypothesis. But it can be useful when defining
    complex [Prop]s using conditionals, or as a parameter to
    higher-order [Prop]s. *)

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

(** The logical complement of a proposition [P] is written [not
    P] or, for shorthand, [~P]: *)

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

(** The intuition is that, if [P] is not true, then anything at
    all (even [False]) follows from assuming [P]. *)

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

Check not.
(* ===> Prop -> Prop *)

(** It takes a little practice to get used to working with
    negation in Coq.  Even though you can see perfectly well why
    something is true, it can be a little hard at first to get things
    into the right configuration so that Coq can see it!  Here are
    proofs of a few familiar facts about negation to get you warmed
    up. *)

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

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

Theorem double_neg : forall P : Prop,
  P -> ~~P.
Proof.
  (* WORKED IN CLASS *)
  intros P H. unfold not. intros G. apply G. apply H.  Qed.

(** **** Exercise: 2 stars, advanced (double_neg_inf)  *)
(** Write an informal proof of [double_neg]:

   _Theorem_: [P] implies [~~P], for any proposition [P].

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

(** **** Exercise: 2 stars (contrapositive)  *)
Theorem contrapositive : forall P Q : Prop,
  (P -> Q) -> (~Q -> ~P).
Proof.
  intros. unfold not. unfold not in H0. intros HP. apply H0. apply H. apply HP.
Qed.
(** [] *)

(** **** Exercise: 1 star (not_both_true_and_false)  *)
Theorem not_both_true_and_false : forall P : Prop,
  ~ (P /\ ~P).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 1 star, advanced (informal_not_PNP)  *)
(** Write an informal proof (in English) of the proposition [forall P
    : Prop, ~(P /\ ~P)]. *)

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

(** *** Constructive logic *)
(** Note that some theorems that are true in classical logic are _not_
    provable in Coq's (constructive) logic.  E.g., let's look at how
    this proof gets stuck... *)

Theorem classic_double_neg : forall P : Prop,
  ~~P -> P.
Proof.
  (* WORKED IN CLASS *)
  intros P H. unfold not in H.
  (* But now what? There is no way to "invent" evidence for [~P]
     from evidence for [P]. *)
  Abort.
  (** **** Exercise: 5 stars, advanced, optional (classical_axioms)  *)
(** For those who like a challenge, here is an exercise
    taken from the Coq'Art book (p. 123).  The following five
    statements are often considered as characterizations of
    classical logic (as opposed to constructive logic, which is
    what is "built in" to Coq).  We can't prove them in Coq, but
    we can consistently add any one of them as an unproven axiom
    if we wish to work in classical logic.  Prove that these five
    propositions are equivalent. *)

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

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

Theorem classic_implies_peirce : classic -> peirce.
Proof.
  unfold peirce. unfold classic.
  intros. apply H. intros negP. unfold not in negP. apply negP.
  apply H0. intros Hp. apply ex_falso_quodlibet.
  apply negP. apply Hp.
Qed.

(* helper lemma *)
Lemma demorgan_neg_or_implies_and_neg : forall A B, ~ (A \/ B) -> (~ A) /\ (~ B).
Proof.
  intros. split.
  - unfold not. unfold not in H. intros Ha. apply H. left. apply Ha.
  - unfold not. unfold not in H. intros Hb. apply H. right. apply Hb.
Qed.

Theorem classic_implies_excluded_middle : classic -> excluded_middle.
Proof.
  unfold classic. unfold excluded_middle.
  intros. apply H. intros Hp. apply demorgan_neg_or_implies_and_neg with (A:=P) (B:=P->False) in H.
  - destruct H. apply H0. apply H.
  - apply double_neg. apply Hp.
Qed.

Theorem excluded_middle_implies_classic : excluded_middle -> classic.
Proof.
  unfold classic. unfold excluded_middle.
  intros. destruct (H P).
  - apply H1.
  - apply H0 in H1. inversion H1.
Qed.

Theorem classic_implies_de_morgan_not_and_not :
  classic -> de_morgan_not_and_not.
Proof.
  unfold classic. unfold de_morgan_not_and_not.
  intros. apply H. intros neg_P_or_Q.
  apply H0. apply demorgan_neg_or_implies_and_neg. apply neg_P_or_Q.
Qed.

Theorem de_morgan_not_and_not_implies_excluded_middle : de_morgan_not_and_not -> excluded_middle.
Proof.
  unfold de_morgan_not_and_not. unfold excluded_middle.
  intros. apply H.
  intros neg_negP_and_negnegP.
  destruct neg_negP_and_negnegP. apply H1. apply H0.
Qed.

Theorem excluded_middle_implies_implies_to_or : excluded_middle -> implies_to_or.
Proof.
  unfold excluded_middle. unfold implies_to_or.
  intros. destruct (H P).
  - right. apply H0. apply H1.
  - left. apply H1.
Qed.

Theorem implies_to_or_implies_excluded_middle : implies_to_or -> excluded_middle.
Proof.
  unfold implies_to_or. unfold excluded_middle.
  intros. destruct (H P P).
  - intros. apply H0.
  - right. apply H0.
  - left. apply H0.
Qed.

(** **** Exercise: 3 stars (excluded_middle_irrefutable)  *)
(** This theorem implies that it is always safe to add a decidability
axiom (i.e. an instance of excluded middle) for any _particular_ Prop [P].
Why? Because we cannot prove the negation of such an axiom; if we could,
we would have both [~ (P \/ ~P)] and [~ ~ (P \/ ~P)], a contradiction. *)

Theorem excluded_middle_irrefutable:  forall (P:Prop), ~ ~ (P \/ ~ P).
Proof.
  intros. unfold not. intros. apply H. right.  intros. apply H. left. apply H0.
Qed.

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

(** Saying [x <> y] is just the same as saying [~(x = y)]. *)

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

(** Since inequality involves a negation, it again requires
    a little practice to be able to work with it fluently.  Here
    is one very useful trick.  If you are trying to prove a goal
    that is nonsensical (e.g., the goal state is [false = true]),
    apply the lemma [ex_falso_quodlibet] to change the goal to
    [False].  This makes it easier to use assumptions of the form
    [~P] that are available in the context -- in particular,
    assumptions of the form [x<>y]. *)

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

(** **** Exercise: 2 stars (false_beq_nat)  *)
Theorem false_beq_nat : forall n m : nat,
     n <> m ->
     beq_nat n m = false.
Proof.
   intros n.
   induction n.
   -  intros. unfold not in H. destruct m.
     +  simpl. apply ex_falso_quodlibet. apply H. reflexivity.
     +  simpl.  reflexivity.
   - intros.  unfold not in H. destruct m.
     + simpl. reflexivity.
     + simpl. apply IHn. unfold not. intros Hnm. apply H. rewrite Hnm. reflexivity.
Qed.
(** [] *)

(** **** Exercise: 2 stars, optional (beq_nat_false)  *)
Theorem beq_nat_false : forall n m,
  beq_nat n m = false -> n <> m.
Proof.
  intros n. induction n.
  - intros. unfold not. intros. rewrite <- H0 in H. simpl beq_nat in H. inversion H.
  - intros. unfold not. intros. rewrite <- H0 in H. simpl beq_nat in H.
    assert (H_n_eq_n: forall k, beq_nat k k = true).
    { induction k.
      + simpl. reflexivity.
      + simpl. apply IHk.
    }
    rewrite H_n_eq_n in H. inversion H.

  Qed.
(** [] *)

(** $Date: 2015-08-17 20:23:49 +0200 (Mon, 17 Aug 2015) $ *)


From LF Require Export Basics.
From Coq Require Import Unicode.Utf8.
Set Printing All.

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

Theorem minus_n_n : ∀ n,
  minus n n = 0.
Proof.
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *) simpl. reflexivity.
  - (* n = S n' *) simpl. rewrite -> IHn'. reflexivity.
  Qed.

Theorem mul_0_r : ∀ n : nat,
  n * 0 = 0.
Proof.
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *) reflexivity.
  - (* n = S n' *) simpl. rewrite -> IHn'. reflexivity.
  Qed.

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

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

Theorem add_assoc : ∀ 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.

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

Lemma double_plus : ∀ n, double n = n + n .
Proof.
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *) reflexivity.
  - (* n = S n' *) simpl. rewrite -> IHn'. rewrite -> plus_n_Sm. reflexivity.
  Qed.

Theorem eqb_refl : ∀ n : nat,
  (n =? n) = true.
Proof.
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *) reflexivity.
  - (* n = S n' *) simpl. rewrite -> IHn'. reflexivity.
  Qed.

Theorem even_S : ∀ n : nat,
  even (S n) = negb (even n).
Proof.
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *) reflexivity.
  - (* n = S n' *)
    rewrite -> IHn'.
    rewrite -> negb_involutive.
    reflexivity.
  Qed.

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

Theorem add_shuffle3 : ∀ n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  intros n m p.
  rewrite -> add_assoc.
  rewrite -> add_assoc.
  assert (H: n + m = m + n).
  { rewrite -> add_comm. reflexivity. }
  rewrite -> H. reflexivity.
  Qed.

Theorem mul_comm : ∀ m n : nat,
  m * n = n * m.
Proof.
  intros m n.
  destruct m as [| m'].
  - (* m = 0 *) simpl. rewrite -> mul_0_r. reflexivity.
  - (* m = S m' *) induction n as [| n' IHn'].
    + (* n = 0 *)
      simpl. rewrite -> mul_0_r. reflexivity.
    + (* n = S n' *)
      simpl. rewrite <- IHn'. simpl. rewrite <- mult_n_Sm.
      assert (H1: m' + (n' + m' * n') = n' + (m' + m' * n')).
      { rewrite -> add_shuffle3. reflexivity. }
      assert (H2: m' * n' + m' = m' + m' * n').
      { rewrite -> add_comm. reflexivity. }
      rewrite -> H1. rewrite -> H2.
      reflexivity.
  Qed.

Theorem plus_leb_compat_l : ∀ n m p : nat,
  n <=? m = true → (p + n) <=? (p + m) = true.
Proof.
  intros n m p H. induction p as [| p' IHp'].
  - (* p = 0 *) simpl. rewrite -> H. reflexivity.
  - (* p = S p' *) simpl. rewrite -> IHp'. reflexivity.
  Qed.

Theorem leb_refl : ∀ n:nat,
  (n <=? n) = true.
Proof.
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *) reflexivity.
  - (* n = S n' *) simpl. rewrite -> IHn'. reflexivity.
  Qed.

Theorem zero_nbeq_S : ∀ n : nat,
  0 =? (S n) = false.
Proof.
  intros n. reflexivity. Qed.

Theorem zero_nbeq_S' : ∀ n : nat,
  0 =? (S n) = false.
Proof.
  induction n as [| n' IHn'].
  - (* n = 0 *) reflexivity.
  - (* n = S n' *) simpl. reflexivity.
  Qed.

Theorem andb_false_r : ∀ b : bool,
  andb b false = false.
Proof.
  intros b. destruct b.
  - (* b = true *) reflexivity.
  - (* b = false *) reflexivity.
  Qed.

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

Theorem all3_spec : ∀ b c : bool,
  orb
    (andb b c)
    (orb (negb b)
         (negb c))
  = true.
Proof.
  intros b c. destruct b.
  - (* b = true *) destruct c.
    + (* c = true *) reflexivity.
    + (* c = false *) reflexivity.
  - (* b = false *) destruct c.
    + (* c = true *) reflexivity.
    + (* c = false *) reflexivity.
  Qed.

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

Inductive bin : Type :=
  | Z
  | B0 (n : bin)
  | B1 (n : bin)
.

Fixpoint incr (m:bin) : bin
  := match m with
     | Z    => B1 Z
     | B0 n => B1 n
     | B1 n => B0 (incr n)
     end.

Fixpoint bin_to_nat (m:bin) : nat
  := match m with
     | Z    => O
     | B0 n => (bin_to_nat n) + (bin_to_nat n)
     | B1 n => S ((bin_to_nat n) + (bin_to_nat n))
     end.

Theorem bin_to_nat_pres_incr : forall b : bin,
  bin_to_nat (incr b) = 1 + bin_to_nat b.
Proof.
  intros b.
  induction b as [| b' | b' ].
  - reflexivity.
  - reflexivity.
  - simpl.
    rewrite -> IHb'.
    simpl. rewrite <- plus_n_Sm.
    reflexivity.
Qed.

Fixpoint nat_to_bin (n : nat) : bin
  := match n with
     | 0    => Z
     | S n' => incr (nat_to_bin n')
     end.

Theorem nat_bin_nat : forall n, bin_to_nat (nat_to_bin n) = n.
Proof.
  induction n as [|n'].
  - reflexivity.
  - simpl.
    rewrite -> bin_to_nat_pres_incr.
    rewrite -> IHn'.
    reflexivity.
Qed.

Theorem bin_nat_bin_fails : ∀ b, nat_to_bin (bin_to_nat b) = b.
Abort.

Lemma double_incr : ∀ n : nat, double (S n) = S (S (double n)).
Proof.
  intros n. reflexivity.
  Qed.

Definition double_bin (b : bin) : bin :=
  match b with
  | Z => Z
  | B0 n => B0 (B0 n)
  | B1 n => B0 (B1 n)
  end.

Lemma double_incr_bin : ∀ b,
  double_bin (incr b) = incr (incr (double_bin b)).
Proof.
  intros b. induction b as [| b0' | b1' ].
  - reflexivity.
  - reflexivity.
  - reflexivity.
  Qed.

Fixpoint normalize (b : bin) : bin :=
  match b with
  | Z     => Z
  | B0 b' => double_bin (normalize b')
  | B1 b' => incr (double_bin (normalize b'))
  end.

Lemma nat_to_bin_double : forall n : nat,
  nat_to_bin (double n) = double_bin (nat_to_bin n).
Proof.
  intros n.
  induction n.
  - reflexivity.
  - simpl. rewrite -> double_incr_bin. rewrite <- IHn.
    reflexivity.
Qed.

Theorem bin_nat_bin : forall b, nat_to_bin (bin_to_nat b) = normalize b.
Proof.
  intros b.
  induction b as [|b'|b'].
  - reflexivity.
  - simpl. rewrite <- IHb'.
    destruct (bin_to_nat b').
    + reflexivity.
    + rewrite <- double_plus. rewrite nat_to_bin_double.
      reflexivity.
  - simpl. rewrite <- IHb'.
    rewrite <- double_plus. rewrite nat_to_bin_double.
    reflexivity.
  Qed.


Require Import nat.
Require Import bool.

Theorem minus_diag : forall n:nat, n - n = 0.
Proof.
    intros n. induction n.
    - simpl. reflexivity.
    - simpl. rewrite IHn. reflexivity.
Qed.

Theorem minus_diagi' : forall n:nat, n - n = 0.
Proof.
    induction n.
    - simpl. reflexivity.
    - simpl. rewrite IHn. reflexivity.
Qed.

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

Lemma double_plus : forall n:nat, double n = n + n.
Proof.
    induction n as [|n IH].
    - reflexivity.
    - simpl. rewrite plus_n_Sm. rewrite IH. reflexivity.
Qed.

Theorem evenb_S : forall n:nat, evenb (S n) = negb (evenb n).
Proof.
    induction n.
    - reflexivity.
    - rewrite IHn. simpl. rewrite negb_involutive. reflexivity.
Qed.

Theorem all3_spec: forall a b:bool,
    orb (andb a b) (orb (negb a) (negb b)) = true.
Proof.
    destruct a, b.
    - reflexivity.
    - reflexivity.
    - reflexivity.
    - reflexivity.
Qed.

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

Theorem double_injective : forall (n m:nat),
    double n = double m -> n = m.
Proof.
    induction n as [|n H].
    - intros m H. destruct m as [|m].
        + reflexivity.
        + simpl in H. inversion H.
    - intros m H'. destruct m as [|m].
        + simpl in H'. inversion H'.
        + simpl in H'. inversion H' as [H1]. clear H'.
            apply H in H1. rewrite H1. reflexivity.
Qed.

Theorem double_induction : forall (P: nat -> nat -> Prop),
    P 0 0 ->
    (forall m, P m 0 -> P (S m) 0) ->
    (forall n, P 0 n -> P 0 (S n)) ->
    (forall m n, P m n -> P (S m) (S n)) ->
    forall m n, P m n.
Proof.
    intros P H0 H1 H2 H3. induction m as [| m H].
    - induction n as [| n H].
        + exact H0.
        + apply H2. exact H.
    - destruct n.
        + assert (forall q, P q 0).
            { induction q as [|q H'].
                - exact H0.
                - apply H1. exact H'.
            }
            apply H4.
        + apply H3. apply H.
Qed.

Lemma plus_comm3 : forall (n m p:nat),
    n + (m + p) = (p + m) + n.
Proof.
    intros n m p.
    rewrite plus_comm.
    assert (H : m + p = p + m). { rewrite plus_comm. reflexivity. }
    rewrite H. reflexivity.
Qed.

Lemma plus_comm3' : forall (n m p:nat),
    n + (m + p) = (p + m) + n.
Proof.
    intros n m p. rewrite plus_comm. rewrite (plus_comm m). reflexivity.
Qed.

Theorem evenb_double : forall (k:nat), evenb (double k) = true.
Proof.
    induction k as [|k H].
    - reflexivity.
    - simpl. exact H.
Qed.

Lemma evenb_negb_gen : forall (n:nat),
(forall b:bool, evenb n = b -> evenb (S n) = negb b) /\
(forall b:bool, evenb (S n) = b -> evenb n = negb b).
Proof.
    induction n as [|n [H1 H2]].
    - split.
        + intros b H'. rewrite <- H'. reflexivity.
        + intros b H'. rewrite <- H'. reflexivity.
    - split.
        + intros b H'. apply H2. exact H'.
        + intros b H'. apply H1. exact H'.
Qed.

Lemma evenb_negb : forall (n:nat) (b:bool),
    evenb n = b -> evenb (S n) = negb b.
Proof.
    intros n b. assert (
    (forall b:bool, evenb n = b -> evenb (S n) = negb b) /\
    (forall b:bool, evenb (S n) = b -> evenb n = negb b) ) as [H1 H2].
        { apply evenb_negb_gen. }
    apply H1.
Qed.

Theorem evenb_double_conv : forall (n:nat),
    exists k, n = if evenb n
        then double k
        else S (double k).
Proof.
    induction n as [|n H].
    - exists 0. reflexivity.
    - destruct (evenb n) eqn: H'.
        + destruct H as [k H]. exists k.
            apply evenb_negb in H'. rewrite H'. rewrite H. reflexivity.
        + destruct H as [k H]. exists (S k).
            apply evenb_negb in H'. rewrite H'. simpl. rewrite H. reflexivity.
Qed.

Theorem even_bool_prop : forall (n:nat),
    evenb n = true <-> exists k, n = double k.
Proof.
    intros n. split.
    - intros H. assert ( exists k, n = if evenb n
        then double k
        else S (double k) ) as [k H']. { apply evenb_double_conv. }
            rewrite H in H'. exists k. exact H'.
    - intros [k H]. rewrite H. apply evenb_double.
Qed.


Require Import Reals.
Require Import Classical_Prop.
Require Import Waterproof.AllTactics.
Require Import Waterproof.notations.notations.
Require Import Waterproof.load.
Import databases_RealsAndIntegers.
Require Import Waterproof.set_search_depth.To_5.

Open Scope R_scope.
Open Scope subset_scope.

(** Definitions *)
Definition open_ball (p : R) (r : R) : subset R := as_subset _ (fun x => | x - p | < r).

Definition is_interior_point (a : R) (A : R -> Prop) :=
  there exists r : R, (r > 0) /\ (for all x : R, x : (open_ball a r) -> A x).

Definition is_open (A : R -> Prop) := for all a : R, A a -> is_interior_point a A.

Definition complement (A : R -> Prop) : subset R := as_subset _ (fun x => not (A x)).

Definition is_closed (A : R -> Prop) := is_open (complement A).

(** Notations *)
Notation "B( p , r )" := (open_ball p r) (at level 68, format "B( p ,  r )").
Local Ltac2 unfold_open_ball    ()          := unfold open_ball, pred.
Local Ltac2 unfold_open_ball_in (h : ident) := unfold open_ball, pred in $h.
Ltac2 Notation "Expand" "the" "definition" "of" "B" cl(opt(seq("in", "(", ident, ")"))) :=
  expand_def_framework unfold_open_ball unfold_open_ball_in cl.
Ltac2 Notation "Expand" "the" "definition" "of" "open" "ball" cl(opt(seq("in", "(", ident, ")"))) :=
  expand_def_framework unfold_open_ball unfold_open_ball_in cl.

Notation "a 'is' 'an' '_interior' 'point_' 'of' A" := (is_interior_point a A) (at level 68).
Notation "a 'is' 'an' 'interior' 'point' 'of' A" := (is_interior_point a A) (at level 68, only parsing).
Local Ltac2 unfold_is_interior_point    ()          := unfold is_interior_point.
Local Ltac2 unfold_is_interior_point_in (h : ident) := unfold is_interior_point in $h.
Ltac2 Notation "Expand" "the" "definition" "of" "interior" "point" cl(opt(seq("in", "(", ident, ")"))) :=
  expand_def_framework unfold_is_interior_point unfold_is_interior_point_in cl.

Notation "A 'is' '_open_'" := (is_open A) (at level 68).
Notation "A 'is' 'open'" := (is_open A) (at level 68, only parsing).
Local Ltac2 unfold_is_open    ()          := unfold is_open.
Local Ltac2 unfold_is_open_in (h : ident) := unfold is_open in $h.
Ltac2 Notation "Expand" "the" "definition" "of" "open" cl(opt(seq("in", "(", ident, ")"))) :=
  expand_def_framework unfold_is_open unfold_is_open_in cl.

Notation "'ℝ\' A" := (complement A) (at level 20, format "'ℝ\' A").
Notation "'ℝ' '\' A" := (complement A) (at level 20, only parsing).
Local Ltac2 unfold_complement    ()          := unfold complement, pred.
Local Ltac2 unfold_complement_in (h : ident) := unfold complement, pred in $h.
Ltac2 Notation "Expand" "the" "definition" "of" "ℝ\" cl(opt(seq("in", "(", ident, ")"))) :=
  expand_def_framework unfold_complement unfold_complement_in cl.
Ltac2 Notation "Expand" "the" "definition" "of" "complement" cl(opt(seq("in", "(", ident, ")"))) :=
  expand_def_framework unfold_complement unfold_complement_in cl.

Notation "A 'is' '_closed_'" := (is_closed A) (at level 68).
Notation "A 'is' 'closed'" := (is_closed A) (at level 68, only parsing).
Local Ltac2 unfold_is_closed    ()          := unfold is_closed.
Local Ltac2 unfold_is_closed_in (h : ident) := unfold is_closed in $h.
Ltac2 Notation "Expand" "the" "definition" "of" "closed" cl(opt(seq("in", "(", ident, ")"))) :=
  expand_def_framework unfold_is_closed unfold_is_closed_in cl.

(** Hints *)
Lemma zero_in_interval_closed_zero_open_one : (0 : [0,1)).
Proof.
  We need to show that (0 <= 0 /\ 0 < 1).
  We show both (0 <= 0) and (0 < 1).
  - We conclude that (0 <= 0).
  - We conclude that (0 < 1).
Qed.
#[export] Hint Resolve zero_in_interval_closed_zero_open_one : wp_reals.

Lemma one_in_complement_interval_closed_zero_open_one : (1 : ℝ \ [0,1)).
Proof.
  We need to show that (~ ((0 <= 1) /\ (1 < 1))).
  It suffices to show that (~ 1 < 1).
  We conclude that (~ 1 < 1).
Qed.
#[export] Hint Resolve one_in_complement_interval_closed_zero_open_one : wp_reals.

#[export] Hint Resolve Rabs_def1 : wp_reals.
#[export] Hint Resolve not_and_or : wp_classical_logic.

Lemma not_in_compl_implies_in (A : subset R) (x : R) : (¬ x : ℝ\A) -> (x : A).
Proof. Assume that (¬ x : ℝ\A). It holds that (¬ ¬ x : A). We conclude that (x : A). Qed.
Lemma in_implies_not_in_compl (A : subset R) (x : R) : (x : A) -> (¬ x : ℝ\A).
Proof. Assume that (x : A). We conclude that (¬ x : ℝ\A). Qed.
#[export] Hint Resolve not_in_compl_implies_in : wp_negation_reals.
#[export] Hint Resolve in_implies_not_in_compl : wp_negation_reals.

Close Scope subset_scope.
Close Scope R_scope.


(* initial declaration *)
Parameter A B C D : Prop.

(* The first set of exercises are concerned with minimal logic.
   The question is to prove the lemma's
   and to print (and read) the lambda term corresponding
   to the proof. *)

(* NB: if the name of a bound variable does not matter
   then Coq may print "_" instead of for instance "x". *)

(* first an example *)
Lemma example : (A -> B) -> (B -> C) -> A -> C.
Proof.
intros x y z.
apply y.
apply x.
exact z.
Qed.

Print example.
(* fun (x : A -> B) (y : B -> C) (z : A) => y (x z) *)

(* exercise one_a *)
Lemma one_a : (A -> B -> C) -> A -> (A -> C) -> B -> C.
Proof.
intro x.
intro y.
intro z.
intro w.
apply z.
apply y.

Qed.

Print one_a.

(* exercise one_b *)
Lemma one_b : ((A -> B) -> (C ->D)) -> C -> B -> D.
Proof.
intro x.
intro y.
intro z.

apply x.
intro w.
apply z.
apply y.

Qed.

Print one_b.

(* exercise one_c *)
Lemma one_c : (A -> B) -> (A -> C) -> A -> B -> C.
Proof.
intro x.
intro y.
intro z.
intro w.

apply y.
apply z.

Qed.

Print one_c.

(* The second set of exercises is concerned with negation.
   Recall that ~A is defined as A -> False.
   The negation in the goal can be unfolded by "unfold not.". *)

(* NB: a lemma Name that is proved earlier can be used
   by "apply Name."
   NB: if you want to proceed upwards using the elimination
   rule for false, then the Coq tactic is "elimtype False." *)

(* exercise two_a; see Chapter 1 of the course notes
   NB: the converse is not true intuitionistically *)
Lemma AnotnotA : A -> ~ ~ A .
Proof.
unfold not.

intro x.
intro y.
apply y.
apply x.

Qed.

(* exercise two_b; see Chapter 1 of the course notes *)
Lemma notnotnot : ~ ~ ~ A -> ~ A.
Proof.
(*! proof *)

Qed.

(* exercise two_c; see Chapter 1 of the course notes *)
Lemma herman : ~ ~ (~ ~ A -> A).
Proof.
(*! proof *)

Qed.

Print herman.

(* The third set of exercises consist of incomplete
   lambda terms. The question is to add types in such
   a way that a typable lambda term is obtained.
   Use "Check <term>." to see whether it is ok. *)

(* example:
   question:  Check fun (x:?) => x.
   answer:   Check fun (x:A) => x. *)

(* exercises: *)
(*

Check fun (x : ?) (y : ?) (z : ?) => x y z.
Check fun (x : ?) (y : ?) (z : ?) => x (y z).
Check fun (x : ?) (y : ?) => x y .
Check fun (x : ?) (y : ?) (z : ?) => x z y .

*)

(* In the fourth set of exercises, a type is given and
   the question is to define (using "Definition") an
   inhabitant of that type.
   You can define an inhabitant with or without using Coq.
   Use "Check <name>." to see whether it is correct. *)

(* example:
   question: A -> A
   answer: Definition example := fun (x :A) => x .
           Check example.                           *)

(* exercises *)

(* four_a: (A -> B) -> (A -> C) -> A -> B -> C *)
Definition four_a := (*! term *)
  .

Check four_a.

(* four_b : A -> A -> A *)
Definition four_b := (*! term *)
  .

Check four_b.

(* four_c : A -> A -> A  but different from four_b*)
Definition four_c := (*! term *)
  .

Check four_c.

(* four_d : A -> B -> A *)
Definition four_d := (*! term *)
  .

Check four_d.

(* four_e : (A -> A) -> A -> A *)
Definition four_e := (*! term *)
  .

Check four_e.

(* four_f : (A -> A) -> A -> A but different from four_e *)
Definition four_f := (*! term *)
  .

Check four_f.

(* four_g : (A -> A -> B) -> A -> B *)
Definition four_g := (*! term *)
  .

Check four_g.


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

Check 3 = 3.

Check forall n m : nat, n + m = m + n.

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

Definition plus_fact : Prop := 2 + 2 = 4.
Check plus_fact.

Definition is_three (n : nat) : Prop :=
  n = 3.
Check is_three.

Definition injective {A B} (f : A -> B) :=
  forall x y : A, f x = f y -> x = y.

Lemma succ_inj : injective S.
Proof.
  intros n m H. injection H as H1. apply H1.
Qed.

Check @eq.

Example and_example : 3 + 4 = 7 /\ 2 * 2 = 4.
Proof.
  split.
  - reflexivity.
  - reflexivity.
Qed.

Lemma and_intro : forall A B : Prop, A -> B -> A /\ B.
Proof.
  intros A B HA HB. split.
  - apply HA.
  - apply HB.
Qed.

Example and_example' : 3 + 4 = 7 /\ 2 * 2 = 4.
Proof.
  apply and_intro.
  - reflexivity.
  - reflexivity.
Qed.

 (* standard (and_exercise)*)
Example and_exercise :
  forall n m : nat, n + m = 0 -> n = 0 /\ m = 0.
Proof.
  intros n m. induction n as [|n' IHn'].
  - intro H. split. simpl in H. reflexivity. apply H.
  - simpl. intro H. inversion H.
Qed.
 (* /standard (and_exercise)*)

Lemma and_example2 :
  forall n m : nat, n = 0 /\ m = 0 -> n + m = 0.
Proof.
  intros n m H.
  destruct H as [Hn Hm].
  rewrite Hn. rewrite Hm.
  reflexivity.
Qed.

Lemma and_example2' :
  forall n m : nat, n = 0 /\ m = 0 -> n + m = 0.
Proof.
  intros n m [Hn Hm].
  rewrite Hn. rewrite Hm.
  reflexivity.
Qed.

Lemma and_example2'' :
  forall n m : nat, n = 0 -> m = 0 -> n + m = 0.
Proof.
  intros n m Hn Hm.
  rewrite Hn. rewrite Hm.
  reflexivity.
Qed.

Lemma and_example3 :
  forall n m : nat, n + m = 0 -> n * m = 0.
Proof.
  intros n m H.
  assert (H' : n = 0 /\ m = 0).
  { apply and_exercise. apply H. }
  destruct H' as [Hn Hm].
  rewrite Hn. reflexivity.
Qed.

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

(*standard, optional (proj2)*)
Lemma proj2 : forall P Q : Prop,
  P /\ Q -> Q.
Proof.
  intros P Q [HP HQ].
  apply HQ. Qed.
(*/standard, optional (proj2)*)

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

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

Lemma or_example :
  forall n m : nat, n = 0 \/ m = 0 -> n * m = 0.
Proof.
  intros n m [Hn | Hm].
  -
    rewrite Hn. reflexivity.
  -
    rewrite Hm. rewrite <- mult_n_O.
    reflexivity.
Qed.

Lemma or_intro : forall A B : Prop, A -> A \/ B.
Proof.
  intros A B HA.
  left.
  apply HA.
Qed.

Lemma zero_or_succ :
  forall n : nat, n = 0 \/ n = S (pred n).
Proof.
  intros [|n].
  - left. reflexivity.
  - right. reflexivity.
Qed.

(*standard (mult_eq_0)*)
Lemma mult_eq_0 :
  forall n m, n * m = 0 -> n = 0 \/ m = 0.
Proof.
  intros n m H. destruct n as [|n'].
  - left. reflexivity.
  - destruct m as [|m'].
    + right. reflexivity.
    + inversion H.
  Qed.
(*/standard (mult_eq_0)*)

(*standard (or_commut)*)
Theorem or_commut : forall P Q : Prop,
  P \/ Q -> Q \/ P.
Proof.
  intros P Q [HP | HQ].
  - right. apply HP.
  - left. apply HQ.
  Qed.
(*/standard (or_commut)*)

Module MyNot.

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

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

Check not.

End MyNot.

Theorem ex_falso_quodlibet : forall (P:Prop),
  False -> P.
Proof.
  intros P contra.
  destruct contra. Qed.

(*standard, optional (not_implies_our_not)*)
Fact not_implies_our_not : forall (P:Prop),
  ~ P -> (forall (Q:Prop), P -> Q).
Proof.
  intros. apply H in H0. destruct H0. Qed.
(*/standard, optional (not_implies_our_not)*)

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

Theorem zero_not_one : 0 <> 1.
Proof.
  unfold not. intros contra. discriminate contra. Qed.

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

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

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

(*standard, recommended (contrapositive)*)
Theorem contrapositive : forall (P Q : Prop),
  (P -> Q) -> (~Q -> ~P).
Proof.
  intros P Q H. unfold not. intros G I. apply H in I. apply G in I. destruct I. Qed.
(*/standard, recommended (contrapositive)*)

(*standard (not_both_true_and_false)*)
Theorem not_both_true_and_false : forall P : Prop,
  ~ (P /\ ~P).
Proof.
  intro P. unfold not. intros [H1 H2]. apply H2 in H1. destruct H1. Qed.
(*/standard (not_both_true_and_false)*)

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

Theorem not_true_is_false' : forall b : bool,
  b <> true -> b = false.
Proof.
  intros [] H.
  -
    unfold not in H.
    exfalso.     apply H. reflexivity.
  - reflexivity.
Qed.

Lemma True_is_true : True.
Proof. apply I. Qed.

Module MyIff.

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

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

End MyIff.

Theorem iff_sym : forall P Q : Prop,
  (P <-> Q) -> (Q <-> P).
Proof.
  intros P Q [HAB HBA].
  split.
  - apply HBA.
  - apply HAB. Qed.

Lemma not_true_iff_false : forall b,
  b <> true <-> b = false.
Proof.
  intros b. split.
  - apply not_true_is_false.
  -
    intros H. rewrite H. intros H'. discriminate H'.
Qed.

(*standard, optional (iff_properties)*)
Theorem iff_refl : forall P : Prop,
  P <-> P.
Proof.
  intro P. reflexivity. Qed.

Theorem iff_trans : forall P Q R : Prop,
  (P <-> Q) -> (Q <-> R) -> (P <-> R).
Proof.
  intros P Q R [PQ QP] [QR RQ]. split.
  - (* P -> R *)
    intros HP. apply QR. apply PQ. apply HP.
  - (* R -> P*)
    intros HR. apply QP. apply RQ. apply HR. Qed.
(*/standard, optional (iff_properties)*)

(*standard (or_distributes_over_and)*)
Theorem or_distributes_over_and : forall P Q R : Prop,
  P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
Proof.
  intros P Q R. split.
  - intros [HP | [HQ HR]].
    + split; left; apply HP.
    + split; right; try (apply HQ); try (apply HR).
  - intros [[HPl | HQ] [HPr | HR]].
    + left. apply HPl.
    + left. apply HPl.
    + left. apply HPr.
    + right. split. apply HQ. apply HR.
Qed.
(*/standard (or_distributes_over_and)*)

From Coq Require Import Setoids.Setoid.

Lemma mult_0 : forall n m, n * m = 0 <-> n = 0 \/ m = 0.
Proof.
  split.
  - apply mult_eq_0.
  - apply or_example.
Qed.

Lemma or_assoc :
  forall P Q R : Prop, P \/ (Q \/ R) <-> (P \/ Q) \/ R.
Proof.
  intros P Q R. split.
  - intros [H | [H | H]].
    + left. left. apply H.
    + left. right. apply H.
    + right. apply H.
  - intros [[H | H] | H].
    + left. apply H.
    + right. left. apply H.
    + right. right. apply H.
Qed.

Lemma mult_0_3 :
  forall n m p, n * m * p = 0 <-> n = 0 \/ m = 0 \/ p = 0.
Proof.
  intros n m p.
  rewrite mult_0. rewrite mult_0. rewrite or_assoc.
  reflexivity.
Qed.

Lemma apply_iff_example :
  forall n m : nat, n * m = 0 -> n = 0 \/ m = 0.
Proof.
  intros n m H. apply mult_0. apply H.
Qed.

Lemma four_is_even : exists n : nat, 4 = n + n.
Proof.
  exists 2. reflexivity.
Qed.

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

(*standard, recommended (dist_not_exists)*)
Theorem dist_not_exists : forall (X:Type) (P : X -> Prop),
  (forall x, P x) -> ~ (exists x, ~ P x).
Proof.
  unfold not. intros X P A. intros [x NP]. apply NP. apply A.
Qed.
(*/standard, recommended (dist_not_exists)*)

(*standard (dist_exists_or)*)
Theorem dist_exists_or : forall (X:Type) (P Q : X -> Prop),
  (exists x, P x \/ Q x) <-> (exists x, P x) \/ (exists x, Q x).
Proof.
 intros X P Q. split.
  - intros [x [HP | HQ]].
    + left. exists x. apply HP.
    + right. exists x. apply HQ.
  - intros [[x HP] | [x HQ]].
    + exists x. left. apply HP.
    + exists x. right. apply HQ.
Qed.
(*/standard (dist_exists_or)*)

Fixpoint In {A : Type} (x : A) (l : list A) : Prop :=
  match l with
  | [] => False
  | x' :: l' => x' = x \/ In x l'
  end.

Example In_example_1 : In 4 [1; 2; 3; 4; 5].
Proof.
  simpl. right. right. right. left. reflexivity.
Qed.

Example In_example_2 :
  forall n, In n [2; 4] ->
  exists n', n = 2 * n'.
Proof.
  simpl.
  intros n [H | [H | []]].
  - exists 1. rewrite <- H. reflexivity.
  - exists 2. rewrite <- H. reflexivity.
Qed.

Lemma In_map :
  forall (A B : Type) (f : A -> B) (l : list A) (x : A),
    In x l ->
    In (f x) (map f l).
Proof.
  intros A B f l x.
  induction l as [|x' l' IHl'].
  -
    simpl. intros [].
  -
    simpl. intros [H | H].
    + rewrite H. left. reflexivity.
    + right. apply IHl'. apply H.
Qed.

(*standard (In_map_iff)*)
Lemma In_map_iff :
  forall (A B : Type) (f : A -> B) (l : list A) (y : B),
    In y (map f l) <->
    exists x, f x = y /\ In x l.
Proof.
  intros A B f l y. split.
  - induction l as [| h t IHt].
    + simpl. intros [].
    + simpl. intros [H1 | H2].
      * exists h. split. apply H1. left. reflexivity.
      * apply IHt in H2. destruct H2 as [w [F I]]. exists w. split.
        apply F. right. apply I.
  - intros [x [H1 H2]]. rewrite <- H1. apply In_map. apply H2. Qed.
(*/standard (In_map_iff)*)

(*standard (In_app_iff)*)
Lemma In_app_iff : forall A l l' (a:A),
  In a (l++l') <-> In a l \/ In a l'.
Proof.
  intros A l l' a. split.
  - induction l as [|h t IHt].
    + simpl. intro H. right. apply H.
    + simpl. intros [H1 | H2]. left. left. apply H1. apply IHt in H2.
      destruct H2 as [H3 | H4]. left. right. apply H3. right. apply H4.
  - induction l as [| h t IHt].
    + intros [H1 | H2]. destruct H1. simpl. apply H2.
    + simpl. intros [[H1 | H2] | H3].
      * left. apply H1.
      * right. apply IHt. left. apply H2.
      * right. apply IHt. right. apply H3.
Qed.
(*/standard (In_app_iff)*)

(*standard, recommended (All)*)
Fixpoint All {T : Type} (P : T -> Prop) (l : list T) : Prop :=
  match l with
  | nil => True
  | h :: t => P h /\ All P t
  end.

Lemma All_In :
  forall T (P : T -> Prop) (l : list T),
    (forall x, In x l -> P x) <->
    All P l.
Proof.
  intros T P l. split.
  - (*(forall x : T, In x l -> P x) -> All P l*)
    induction l as [|h t IHt].
    + intro H. simpl. reflexivity.
    + intro H. simpl. split.
      * apply H. simpl. left. reflexivity.
      * apply IHt. intros x H1. apply H. simpl. right. apply H1.
  - (*All P l -> forall x : T, In x l -> P x*)
    induction l as [|h t IHt].
    + intros. destruct H0.
    + simpl. intros [H1 H2] x [H3|H4].
      * rewrite <- H3. apply H1.
      * apply IHt. apply H2. apply H4.
Qed.
(*/standard, recommended (All)*)

(*standard (combine_odd_even)*)
Definition combine_odd_even (Podd Peven : nat -> Prop) : nat -> Prop :=
  fun n =>
    match oddb n with
    | true => Podd n
    | false => Peven n
    end.

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.
  intros Podd Peven n. destruct (oddb n) eqn:H.
  - intros H1 H2. unfold combine_odd_even. rewrite -> H. apply H1. reflexivity.
  - intros H1 H2. unfold combine_odd_even. rewrite -> H. apply H2. reflexivity.
Qed.

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.
  intros Podd Peven n. unfold combine_odd_even.
  intros H1 H2. rewrite -> H2 in H1. apply H1.
Qed.

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.
  intros Podd Peven n. unfold combine_odd_even. intros H1 H2.
  rewrite -> H2 in H1. apply H1.
Qed.
(*/standard (combine_odd_even)*)

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

Check plus_comm.

Lemma plus_comm3 :
  forall x y z, x + (y + z) = (z + y) + x.
Proof.
  intros x y z.
  rewrite plus_comm.
  rewrite plus_comm.
Abort.

Lemma plus_comm3_take2 :
  forall x y z, x + (y + z) = (z + y) + x.
Proof.
  intros x y z.
  rewrite plus_comm.
  assert (H : y + z = z + y).
  { rewrite plus_comm. reflexivity. }
  rewrite H.
  reflexivity.
Qed.

Lemma plus_comm3_take3 :
  forall x y z, x + (y + z) = (z + y) + x.
Proof.
  intros x y z.
  rewrite plus_comm.
  rewrite (plus_comm y z).
  reflexivity.
Qed.

Lemma in_not_nil :
  forall A (x : A) (l : list A), In x l -> l <> [].
Proof.
  intros A x l H. unfold not. intro Hl. destruct l.
  - simpl in H. destruct H.
  - discriminate Hl.
Qed.

Lemma in_not_nil_42 :
  forall l : list nat, In 42 l -> l <> [].
Proof.
  intros l H.
  Fail apply in_not_nil.
Abort.

Lemma in_not_nil_42_take2 :
  forall l : list nat, In 42 l -> l <> [].
Proof.
  intros l H.
  apply in_not_nil with (x := 42).
  apply H.
Qed.

Lemma in_not_nil_42_take3 :
  forall l : list nat, In 42 l -> l <> [].
Proof.
  intros l H.
  apply in_not_nil in H.
  apply H.
Qed.

Lemma in_not_nil_42_take4 :
  forall l : list nat, In 42 l -> l <> [].
Proof.
  intros l H.
  apply (in_not_nil nat 42).
  apply H.
Qed.

Lemma in_not_nil_42_take5 :
  forall l : list nat, In 42 l -> l <> [].
Proof.
  intros l H.
  apply (in_not_nil _ _ _ H).
Qed.

Example function_equality_ex1 :
  (fun x => 3 + x) = (fun x => (pred 4) + x).
Proof. reflexivity. Qed.

Example function_equality_ex2 :
  (fun x => plus x 1) = (fun x => plus 1 x).
Proof.
Abort.

Axiom functional_extensionality : forall {X Y: Type}
                                    {f g : X -> Y},
  (forall (x:X), f x = g x) -> f = g.

Example function_equality_ex2 :
  (fun x => plus x 1) = (fun x => plus 1 x).
Proof.
  apply functional_extensionality. intros x.
  apply plus_comm.
Qed.

Print Assumptions function_equality_ex2.

(*standard (tr_rev_correct)*)
Fixpoint rev_append {X} (l1 l2 : list X) : list X :=
  match l1 with
  | [] => l2
  | x :: l1' => rev_append l1' (x :: l2)
  end.

Definition tr_rev {X} (l : list X) : list X :=
  rev_append l [].

Lemma tr_rev_correct : forall X, @tr_rev X = @rev X.
Proof.
  intros X. apply functional_extensionality. unfold tr_rev. induction x as [| h t IHt].
  - simpl. reflexivity.
  - simpl. rewrite <- IHt. Admitted.
(*/standard (tr_rev_correct)*)

Example even_42_bool : evenb 42 = true.
Proof. reflexivity. Qed.

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

Example even_42_prop : exists k, 42 = double k.
Proof. exists 21. reflexivity. Qed.

Theorem evenb_double : forall k, evenb (double k) = true.
Proof.
  intros k. induction k as [|k' IHk'].
  - reflexivity.
  - simpl. apply IHk'.
Qed.

(*standard (evenb_double_conv)*)
Lemma  evenb_S : forall n : nat, evenb (S n) = negb (evenb n).
Proof.
  intro n. induction n as [|n' IHn'].
  - simpl. reflexivity.
  - rewrite -> IHn'. assert(H: forall b:bool, b=negb(negb b)).
    intro b. destruct b;reflexivity. apply H. Qed.

Theorem evenb_double_conv : forall n,
  exists k, n = if evenb n then double k
                else S (double k).
Proof.
  intro n. induction n as [|n' IHn'].
  - simpl. exists 0. reflexivity.
  - destruct IHn' as [m IHm]. destruct (evenb n') eqn:H.
    + rewrite -> evenb_S. rewrite -> H. simpl. rewrite -> IHm.
      exists m. reflexivity.
    + rewrite -> evenb_S. rewrite -> H. simpl. rewrite -> IHm. exists (S m).
      simpl. reflexivity. Qed.
(*/standard (evenb_double_conv)*)

Theorem even_bool_prop : forall n,
  evenb n = true <-> exists k, n = double k.
Proof.
  intros n. split.
  - intros H. destruct (evenb_double_conv n) as [k Hk].
    rewrite Hk. rewrite H. exists k. reflexivity.
  - intros [k Hk]. rewrite Hk. apply evenb_double.
Qed.

Require Import PeanoNat.

(* standard (logical_connectives)*)
Notation "x && y" := (andb x y).

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

Lemma andb_true_iff : forall b1 b2:bool,
  b1 && b2 = true <-> b1 = true /\ b2 = true.
Proof.
  intros b1 b2. split.
  - destruct b1 eqn:H.
    + intro H1. split. reflexivity. simpl in H1. apply H1.
    + intro H1. inversion H1.
  - intros [H1 H2]. rewrite -> H1. rewrite -> H2. reflexivity. Qed.

Lemma orb_true_iff : forall b1 b2,
  b1 || b2 = true <-> b1 = true \/ b2 = true.
Proof.
  intros b1 b2. split.
  - destruct b1 eqn:H.
    + intro H1. left. reflexivity.
    + intro H1. simpl in H1. right. apply H1.
  - intros [H1|H2].
    + rewrite -> H1. reflexivity.
    + rewrite -> H2. destruct b1 eqn:H.
      * reflexivity.
      * reflexivity.
Qed.
(* /standard (logical_connectives)*)

(*standard (eqb_neq)*)
Theorem eqb_refl: forall n: nat,
  true = (n =? n).
Proof.
  induction n as [|n' IH].
  - reflexivity.
  - rewrite IH. reflexivity.
Qed.

Theorem eqb_eq:
  forall n1 n2: nat,
  n1 =? n2 = true <-> n1 = n2.
Proof.
  intros n1 n2. split.
  - apply eqb_true.
  - intros H. rewrite H. rewrite <- eqb_refl. reflexivity.
Qed.

Theorem eqb_neq : forall x y : nat,
  x =? y = false <-> x <> y.
Proof.
  intros x y.
  rewrite <- not_true_iff_false.
  rewrite <- eqb_eq.
  reflexivity.
Qed.
(*/standard (eqb_neq)*)

(*standard (eqb_list)*)
Fixpoint eqb_list {A : Type} (eqb : A -> A -> bool)
                  (l1 l2 : list A) : bool :=
  match l1, l2 with
  | [], [] => true
  | _, [] => false
  | [], _ => false
  | h1 :: t1, h2 :: t2 => andb (eqb h1 h2) (eqb_list eqb t1 t2)
  end.

Lemma eqb_list_true_iff :
  forall A (eqb : A -> A -> bool),
    (forall a1 a2, eqb a1 a2 = true <-> a1 = a2) ->
    forall l1 l2, eqb_list eqb l1 l2 = true <-> l1 = l2.
Proof.
  intros A eqb H. induction l1 as [|h1 t1 IHt1].
  - induction l2 as [| h2 t2 IHt2].
    + split.
      * simpl. intro H1. reflexivity.
      * simpl. intro H1. reflexivity.
    + split.
      * simpl. intro H1. discriminate H1.
      * simpl. intro H1. discriminate H1.
  - induction l2 as [| h2 t2 IHt2].
    + split.
      * simpl. intro H1. discriminate H1.
      * simpl. intro H1. discriminate H1.
    + split.
      * simpl. intro H1. apply andb_true_iff in H1. destruct H1 as [H2 H3].
        apply H in H2. apply IHt1 in H3. rewrite -> H2. rewrite -> H3. reflexivity.
      * simpl. intro H1. apply andb_true_iff. split.
        apply H. inversion H1. reflexivity. apply IHt1. inversion H1. reflexivity.
Qed.
(*/standard (eqb_list)*)

(*standard, recommended (All_forallb)*)
Fixpoint forallb {X : Type} (test : X -> bool) (l : list X) : bool :=
  match l with
  | [] => true
  | x :: l' => andb (test x) (forallb test l')
  end.

Theorem forallb_true_iff : forall X test (l : list X),
   forallb test l = true <-> All (fun x => test x = true) l.
Proof.
  intros X test l. split.
  - induction l as [|h t IHt].
    + simpl. reflexivity.
    + simpl. intro H. split.
      * apply andb_true_iff in H. destruct H as [H1 H2]. apply H1.
      * apply IHt. apply andb_true_iff in H. destruct H as [H1 H2]. apply H2.
  - induction l as [|h t IHt].
    + simpl. reflexivity.
    + simpl. intros [H1 H2]. apply andb_true_iff. split.
      * apply H1.
      * apply IHt. apply H2.
Qed.
(*/standard, recommended (All_forallb)*)

Definition excluded_middle := forall P : Prop,
  P \/ ~ P.

Theorem restricted_excluded_middle : forall P b,
  (P <-> b = true) -> P \/ ~ P.
Proof.
  intros P [] H.
  - left. rewrite H. reflexivity.
  - right. rewrite H. intros contra. discriminate contra.
Qed.

Theorem restricted_excluded_middle_eq : forall (n m : nat),
  n = m \/ n <> m.
Proof.
  intros n m.
  apply (restricted_excluded_middle (n = m) (n =? m)).
  symmetry.
  apply eqb_eq.
Qed.

(*standard (excluded_middle_irrefutable)*)
Theorem excluded_middle_irrefutable: forall (P:Prop),
  ~ ~ (P \/ ~ P).
Proof.
  intros P H.
  unfold not in H.
  apply H.
  right.
  intros HP.
  apply H.
  left.
  apply HP.
Qed.
(*/standard (excluded_middle_irrefutable)*)

(* Exercise 20 *)
Theorem not_exists_dist:
  excluded_middle ->
  forall (X: Type) (P: X -> Prop),
    ~(exists x, ~P x) -> (forall x, P x).
Proof.
  intros EM X P.
  unfold not.
  intros H.
  intros x.

  destruct (EM (P x)) as [EM1 | EM2].
  - apply EM1.
  - exfalso. apply H.
    exists x.
    apply EM2.
Qed.

(* Exercise 21 *)
(* Definition excluded_middle := forall P: Prop, P \/ ~P. *)

Definition peirce := forall P Q: Prop,
  ((P -> Q) -> P) -> P.

Definition double_negation_elimination := 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).

Fact dne_eq_lem: double_negation_elimination <-> excluded_middle.
Proof.
  split.
  - intros dne.
    intros P.
    apply dne.
    apply excluded_middle_irrefutable.
  - intros lem.
    intros P H.
    destruct (lem P) as [lem1 | lem2].
    + apply lem1.
    + destruct (H lem2).
Qed.

Fact dmnn_eq_lem: de_morgan_not_and_not <-> excluded_middle.
Proof.
  split.
  - intros dmnn.
    intros P.
    apply dmnn.
    intros [H1 H2].
    destruct (H2 H1).
  - intros lem.
    intros P Q H.
    destruct (lem P) as [H1 | H2].
    + left. apply H1.
    + destruct (lem Q) as [H3 | H4].
      * right. apply H3.
      * exfalso. apply H.
        split. apply H2. apply H4.
Qed.


(******************************)
(******************************)
(****                      ****)
(****   Proof techniques   ****)
(****                      ****)
(******************************)
(******************************)

(****************************)
(* Equality of applications *)
(****************************)

(*
  To prove two applications of a function or constructor are equal, we can
  prove the arguments are pairwise equal.
*)

Definition successorsEqual n1 n2 : n1 = n2 -> S n1 = S n2 :=
  fun H =>
    match H in _ = x return S n1 = S x with
    | eq_refl => eq_refl (S n1)
    end.

(* We can use the `rewrite` tactic to prove this with forward reasoning. *)

Goal forall n1 n2, n1 = n2 -> S n1 = S n2.
Proof.
  intros.
  rewrite H.
  reflexivity.
Qed.

(* We can use the `f_equal` tactic to prove this with backward reasoning. *)

Goal forall n1 n2, n1 = n2 -> S n1 = S n2.
Proof.
  intros.
  f_equal.
  apply H.
Qed.

(*******************************)
(* Injectivity of constructors *)
(*******************************)

(*
  Given an equality between two applications of a constructor, we can conclude
  the arguments are pairwise equal.
*)

Definition successorInjective n1 n2 : S n1 = S n2 -> n1 = n2 :=
  fun H =>
    match H in _ = x return pred (S n1) = pred x with
    | eq_refl => eq_refl (pred (S n1))
    end.

(* We can use the `inversion` (or `injection`) tactic to prove this. *)

Goal forall n1 n2, S n1 = S n2 -> n1 = n2.
Proof.
  intros.
  inversion H. (* Generate a proof of `n1 = n2` and substitute in the goal. *)
  reflexivity.
Qed.

(********************************)
(* Disjointness of constructors *)
(********************************)

(*
  Here we show how to refute the equality between applications of two different
  constructors. This only works for constructors of types in the `Set` or
  `Type` universes, not `Prop`. See Lessons 5 and 6 for details about
  universes.
*)

Definition trueNeqFalse : true <> false :=
  fun H =>
    match H
    in _ = x
    return
      match x with
      | true => True
      | false => False
      end
    with
    | eq_refl => I
    end.

(* Fortunately, the `discriminate` tactic automates this. *)

Goal true <> false. (* Unfolds to `true = false -> False` *)
Proof.
  discriminate. (* Prove the goal via an impossible structural equality. *)
Qed.

(*************)
(* Induction *)
(*************)

(* Let's prove that zero is a left identity for addition. *)

Definition zeroPlusNEqualsN n : 0 + n = n := eq_refl n.

Goal forall n, 0 + n = n.
Proof.
  intros.
  reflexivity.
Qed.

(* That was easy! Now let's try to prove that zero is also a right identity. *)

Fail Definition nPlusZeroEqualsN n : n + 0 = n := eq_refl n.

(*
  ```
  The command has indeed failed with message:
  In environment
  n : nat
  The term "eq_refl" has type "n = n" while it is expected to have type
  "n + 0 = n".
  ```
*)

Goal forall n, n + 0 = n.
Proof.
  intros.
  (* `reflexivity.` reports `Unable to unify "n" with "n + 0".` *)
Abort.

(* What went wrong? Recall the definition of addition. *)

Print "+".

(*
  ```
  fix add (n m : nat) {struct n} : nat :=
    match n with
    | 0 => m
    | S p => S (add p m)
    end
  ```
*)

(*
  From this, it's clear why `0 + n = n`. But how do we prove `n + 0 = n`? We
  need *induction*. Just as we defined recursive functions with `Fixpoint` in
  Lesson 1, we can use `Fixpoint` to write a proof by induction.
*)

Fixpoint nPlusZeroEqualsN n : n + 0 = n :=
  match n return n + 0 = n with
  | O => eq_refl 0
  | S p =>
    match nPlusZeroEqualsN p in _ = x return S p + 0 = S x with
    | eq_refl => eq_refl ((S p) + 0)
    end
  end.

(*
  To help with doing induction in proof mode, Coq automatically constructs an
  induction principle for every inductive type. For example, here's the
  induction principle for `nat`:
*)

Check nat_ind.

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

  Let's use that induction principle to prove our theorem.
*)

Goal forall n, n + 0 = n.
Proof.
  intros.

  (*
    We could write `apply (nat_ind (fun q => q + 0 = q))`, but it's easier to
    just write `induction n`.
  *)
  induction n.

  (* Two subgoals are generated: *)
  - cbn.
    reflexivity.
  - cbn.
    rewrite IHn.
    reflexivity.
Qed.

(*
  To illustrate a few more useful techniques, let's prove addition is
  commutative.
*)

Theorem commutativity : forall n1 n2, n1 + n2 = n2 + n1.
Proof.
  intros.
  induction n1.
  - rewrite nPlusZeroEqualsN. (* We can use our previous theorem! *)
    reflexivity.
  - cbn. (* `cbn` simplifies the goal by computation. *)
    rewrite IHn1.
    clear IHn1. (* We won't need this hypothesis anymore, so remove it. *)
    induction n2. (* An induction proof within an induction proof! *)
    + reflexivity. (* Use `+` instead of `-` for nested subgoals. *)
    + cbn.
      rewrite IHn2.
      reflexivity.
Qed.

(**************************)
(* Automation with `auto` *)
(**************************)

(*
  We can often save time by asking Coq to find proofs automatically. The first
  step is to create a database of *hints* (e.g., lemmas) that Coq is allowed to
  use when synthesizing proofs. Let's create one called `myHintDb`.
*)

Create HintDb myHintDb.

(*
  Now let's add our `commutativity` theorem to the database. Change `local` to
  `export` if you want the hint to also work in other modules that `Import`
  this one.
*)

#[local] Hint Resolve commutativity : myHintDb.

(*
  Now we can use `auto with myHintDb` to do automatic proof search using our
  hint database.
*)

Goal forall n, n + 42 = n \/ n + 42 = 42 + n.
Proof.
  auto with myHintDb. (* Coq found a proof for us! *)
Qed.

(* Without automation, the proof looks like this: *)

Goal forall n, n + 42 = n \/ n + 42 = 42 + n.
Proof.
  intros.
  right.
  apply commutativity.
Qed.

(*
  Coq has a few built-in hint databases. One such database is `core`, which has
  basic facts about logical connectives, e.g., `forall (A : Type) (x y : A),
  x <> y -> y <> x`. By default, `auto` uses `core` implicitly, so there's no
  need to write `with core`.
*)

Goal forall (A : Type) (x y : A), x = y -> False \/ (True /\ y = x).
Proof.
  auto. (* The `core` database has everything we need here. *)
Qed.

(*
  Another built-in database is `arith`, which contains useful facts about
  natural numbers when the appropriate modules are loaded. For example, it
  contains a commutativity theorem just like ours.
*)

Require Import Coq.Arith.Arith.

Goal forall n, n + 42 = n \/ n + 42 = 42 + n.
Proof.
  auto with arith.
Qed.

(*
  If `auto` doesn't find a proof of your goal, you can always try asking it to
  search harder. This will make `auto` take more time, though.
*)

Goal False \/ False \/ False \/ False \/ False \/ True.
Proof.
  auto. (* Nothing? *)
  auto 6. (* Increase the maximum search depth. The default is 5. *)
Qed.

(***********************************)
(* Other useful automation tactics *)
(***********************************)

(* The `congruence` tactic can solve many goals by equational reasoning. *)

Goal forall f (n1 n2 n3 : nat), f n1 = n2 -> f n2 = n3 -> f (f n1) = n3.
Proof.
  congruence.
Qed.

(* The `lia` tactic can solve many goals that deal with integers. *)

Require Import Coq.micromega.Lia.

Goal forall n1 n2 n3, n1 * (n2 + n3) = n1 * n2 + n1 * n3.
Proof.
  lia.
Qed.

(*************)
(* Exercises *)
(*************)

(*
  1. Prove `0 <> 1`.
  2. Prove that addition is associative, i.e.,
     `forall n1 n2 n3, n1 + (n2 + n3) = (n1 + n2) + n3`.
  3. Look up the induction principle for `eq` with `Check eq_ind.`. Informally,
     what does it mean?
  4. Prove the *strong induction* principle for natural numbers:

     ```
     forall P : nat -> Prop,
     (forall n1, (forall n2, n2 < n1 -> P n2) -> P n1) ->
     forall n, P n.
     ```

     Hint: Start the proof with `intros`, then use a tactic called `assert` to
     prove a fact involving `P` and `n`. The goal should easily follow from
     that fact.
*)