(** * Logic: Logic in Coq *)

Require Export MoreProp.

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

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

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

(** Note that, like the definition of [ev] in a previous
    chapter, this definition is parameterized; however, in this case,
    the parameters are themselves propositions, rather than numbers. *)

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

(** 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 :
  (beautiful 0) /\ (beautiful 3).
Proof.
  apply conj.
  Case "left". apply b_0.
  Case "right". apply b_3.  Qed.

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

Theorem and_example' :
  (ev 0) /\ (ev 4).
Proof.
  split.
    Case "left". apply ev_0.
    Case "right". apply ev_SS. apply ev_SS. apply ev_0.  Qed.

(** Conversely, the [inversion] 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.
  inversion H as [HP HQ].
  apply HP.  Qed.

(** **** Exercise: 1 star, optional (proj2) *)
Theorem proj2 : forall P Q : Prop,
  P /\ Q -> Q.
Proof.
  intros.
  inversion H.
  apply H1. Qed.

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

(** **** Exercise: 2 stars (and_assoc) *)
(** In the following proof, notice how the _nested pattern_ in the
    [inversion] 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.
  inversion H as [HP [HQ HR]].
  split. split.
  apply HP. apply HQ. apply HR.
  Qed.

(** **** Exercise: 2 stars (even__ev) *)
(** Now we can prove the other direction of the equivalence of [even]
   and [ev], which we left hanging in chapter [Prop].  Notice that the
   left-hand conjunct here is the statement we are actually interested
   in; the right-hand conjunct is needed in order to make the
   induction hypothesis strong enough that we can carry out the
   reasoning in the inductive step.  (To see why this is needed, try
   proving the left conjunct by itself and observe where things get
   stuck.) *)

Theorem even__ev : forall n : nat,
  (even n -> ev n) /\ (even (S n) -> ev (S n)).
Proof.
  induction n. split. intros. apply ev_0.
  unfold even. intros. inversion H.
  split. inversion IHn. apply H0.
  unfold even. simpl. intros. apply ev_SS.
  inversion IHn. generalize H. unfold even in H0. apply H0.
  Qed.

(* ###################################################### *)
(** ** 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.
  inversion 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.
  inversion H as [HAB HBA].
  split.
    Case "->". apply HBA.
    Case "<-". 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.
  split. intros. apply H. intros. apply H. Qed.

Theorem iff_trans : forall P Q R : Prop,
  (P <-> Q) -> (Q <-> R) -> (P <-> R).
Proof.
  intros. inversion H. inversion H0. split.
  intros. apply H1 in H5. apply H3 in H5. apply H5.
  intros. apply H4 in H5. apply H2 in H5. apply H5.
  Qed.

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

(** 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 [inversion] 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.
  inversion H as [HP | HQ].
    Case "left". apply or_intror. apply HP.
    Case "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.
  inversion H as [HP | HQ].
    Case "left". right. apply HP.
    Case "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. inversion H as [HP | [HQ HR]].
    Case "left". split.
      SCase "left". left. apply HP.
      SCase "right". left. apply HP.
    Case "right". split.
      SCase "left". right. apply HQ.
      SCase "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. inversion H0. left. apply H2.
  inversion H1. left. apply H3. assert(H4 : Q /\ R).
  split.  apply H2. apply H3. right. apply H4.
  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.
  intros. split. intros. split. inversion H. left.
  apply H0. inversion H0. right. apply H1.
  inversion H. left. apply H0. inversion H0.
  right. apply H2. apply or_distributes_over_and_2.
  Qed.

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

(** 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.
    Case "b = true". destruct c.
      SCase "c = true". apply conj. reflexivity. reflexivity.
      SCase "c = false". inversion H.
    Case "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.
  inversion H.
  rewrite H0. rewrite H1. reflexivity. Qed.

(** **** Exercise: 2 stars, optional (bool_prop) *)
Theorem andb_false : forall b c,
  andb b c = false -> b = false \/ c = false.
Proof.
  intros. destruct b.
  {destruct c.
   {inversion H. }
   {right. reflexivity. }
  }
  {destruct c.
   {left. reflexivity. }
   {left.  reflexivity. }
  }
Qed.

Theorem orb_prop : forall b c,
  orb b c = true -> b = true \/ c = true.
Proof.
  intros. destruct b.
  {left. reflexivity. }
  {destruct c.
   {right. reflexivity. }
   {inversion H. }
  }
Qed.

Theorem orb_false_elim : forall b c,
  orb b c = false -> b = false /\ c = false.
Proof.
  intros. destruct b.
  {destruct c.
   {inversion H. }
   {inversion H. }
  }
  {destruct c.
   {inversion H. }
   {split. reflexivity. reflexivity. }
  }
Qed.

(* ################################################### *)
(** * 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
    intution is that [True] should be a proposition for which it is
    trivial to give evidence.) *)

Inductive TrueP : Prop :=
  |True : TrueP.

(** 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. inversion 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 in *. intros. apply H in H1.
  apply H0 in H1. apply H1. Qed.

(** **** Exercise: 1 star (not_both_true_and_false) *)
Theorem not_both_true_and_false : forall P : Prop,
  ~ (P /\ ~P).
Proof.
  intros. unfold not. intros. inversion H.
  apply H1 in H0. apply H0. Qed.

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

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

Theorem five_not_even :
  ~ ev 5.
Proof.
  (* WORKED IN CLASS *)
  unfold not. intros Hev5. inversion Hev5 as [|n Hev3 Heqn].
  inversion Hev3 as [|n' Hev1 Heqn']. inversion Hev1.  Qed.

(** **** Exercise: 1 star (ev_not_ev_S) *)
(** Theorem [five_not_even] confirms the unsurprising fact that five
    is not an even number.  Prove this more interesting fact: *)

Theorem ev_not_ev_S : forall n,
  ev n -> ~ ev (S n).
Proof.
  unfold not. intros n H. induction H. (* not n! *)
  intros. inversion H. intros. apply SSev__even in H0.
  apply IHev in H0. apply H0. Qed.

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

(* ########################################################## *)
(** ** 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.
  Case "b = true". reflexivity.
  Case "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.
  induction n. intros. unfold not in H.
  {destruct m.
   {simpl. apply ex_falso_quodlibet.
    apply H. reflexivity. }
   {reflexivity. }
  }
  {intros. destruct m.
   {reflexivity. }
   {simpl. apply IHn. unfold not in *.
    assert((S n = S m -> False) -> (n = m -> False)).
    intros. apply H0. rewrite -> H1. reflexivity.
    apply H0. apply H. }
  }
  Qed.

(** **** Exercise: 2 stars, optional (beq_nat_false) *)
Theorem beq_nat_false : forall n m,
  beq_nat n m = false -> n <> m.
Proof.
  intros.
  unfold not. intros. rewrite -> H0 in H.
  assert(H1:beq_nat m m = true). apply XEqX.
  rewrite -> H1 in H. inversion H.
  Qed.

(** **** Exercise: 2 stars, optional (ble_nat_false) *)
Theorem ble_nat_false : forall n m,
  ble_nat n m = false -> ~(n <= m).
Proof.
  unfold not. intros. apply le_ble_nat in H0.
  rewrite -> H0 in H. inversion H.
  Qed.

(* ############################################################ *)
(** * Existential Quantification *)

(** Another critical logical connective is _existential
    quantification_.  We can express it with the following
    definition: *)

Inductive ex (X:Type) (P : X->Prop) : Prop :=
  ex_intro : forall (witness:X), P witness -> ex X P.

(** That is, [ex] is a family of propositions indexed by a type [X]
    and a property [P] over [X].  In order to give evidence for the
    assertion "there exists an [x] for which the property [P] holds"
    we must actually name a _witness_ -- a specific value [x] -- and
    then give evidence for [P x], i.e., evidence that [x] has the
    property [P].

*)

(** Coq's [Notation] facility can be used to introduce more
    familiar notation for writing existentially quantified
    propositions, exactly parallel to the built-in syntax for
    universally quantified propositions.  Instead of writing [ex nat
    ev] to express the proposition that there exists some number that
    is even, for example, we can write [exists x:nat, ev x].  (It is
    not necessary to understand exactly how the [Notation] definition
    works.) *)

Notation "'exists' x , p" := (ex _ (fun x => p))
  (at level 200, x ident, right associativity) : type_scope.
Notation "'exists' x : X , p" := (ex _ (fun x:X => p))
  (at level 200, x ident, right associativity) : type_scope.

(** We can use the usual set of tactics for
    manipulating existentials.  For example, to prove an
    existential, we can [apply] the constructor [ex_intro].  Since the
    premise of [ex_intro] involves a variable ([witness]) that does
    not appear in its conclusion, we need to explicitly give its value
    when we use [apply]. *)

Example exists_example_1 : exists n, n + (n * n) = 6.
Proof.
  apply ex_intro with (witness:=2).
  reflexivity.  Qed.

(** Note that we have to explicitly give the witness. *)

(** Or, instead of writing [apply ex_intro with (witness:=e)] all the
    time, we can use the convenient shorthand [exists e], which means
    the same thing. *)

Example exists_example_1' : exists n, n + (n * n) = 6.
Proof.
  exists 2.
  reflexivity.  Qed.

(** Conversely, if we have an existential hypothesis in the
    context, we can eliminate it with [inversion].  Note the use
    of the [as...] pattern to name the variable that Coq
    introduces to name the witness value and get evidence that
    the hypothesis holds for the witness.  (If we don't
    explicitly choose one, Coq will just call it [witness], which
    makes proofs confusing.) *)

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

(** **** Exercise: 1 star, optional (english_exists) *)
(** In English, what does the proposition
      ex nat (fun n => beautiful (S n))
]]
    mean? *)

(* FILL IN HERE *)

(** **** Exercise: 1 star (dist_not_exists) *)
(** Prove that "[P] holds for all [x]" implies "there is no [x] for
    which [P] does not hold." *)

Theorem dist_not_exists : forall (X:Type) (P : X -> Prop),
  (forall x, P x) -> ~ (exists x, ~ P x).
Proof.
  intros.
  unfold not. intros. inversion H0 as [m Hm].
  apply Hm. apply H. Qed.

(** **** Exercise: 3 stars, optional (not_exists_dist) *)
(** (The other direction of this theorem requires the classical "law
    of the excluded middle".) *)

Theorem not_exists_dist :
  excluded_middle ->
  forall (X:Type) (P : X -> Prop),
    ~ (exists x, ~ P x) -> (forall x, P x).
Proof.
  unfold excluded_middle. unfold not. intros.
  assert(H1:P x \/ (P x -> False)). apply H.
  inversion H1. apply H2. assert(H3 : exists x : X, P x -> False).
  exists x. apply H2. apply H0 in H3. inversion H3.
  Qed.

(** **** Exercise: 2 stars (dist_exists_or) *)
(** Prove that existential quantification distributes over
    disjunction. *)

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. split. intros. inversion H. inversion H0.
  left. exists witness. apply H1. right. exists witness. apply H1.
  intros. inversion H. inversion H0. exists witness. left. apply H1.
  inversion H0. exists witness. right. apply H1.
  Qed.

(* Print dist_exists_or. *)

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

(** Even Coq's equality relation is not built in.  It has (roughly)
    the following inductive definition. *)

(* (We enclose the definition in a module to avoid confusion with the
    standard library equality, which we have used extensively
    already.) *)

Module MyEquality.

Inductive eq {X:Type} : X -> X -> Prop :=
  refl_equal : forall x, eq x x.
(** Standard infix notation: *)

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

(** The definition of [=] is a bit subtle.  The way to think about it
    is that, given a set [X], it defines a _family_ of propositions
    "[x] is equal to [y]," indexed by pairs of values ([x] and [y])
    from [X].  There is just one way of constructing evidence for
    members of this family: applying the constructor [refl_equal] to a
    type [X] and a value [x : X] yields evidence that [x] is equal to
    [x]. *)

(** **** Exercise: 2 stars (leibniz_equality) *)
(** The inductive definitions of equality corresponds to _Leibniz equality_:
   what we mean when we say "[x] and [y] are equal" is that every
   property on [P] that is true of [x] is also true of [y].  *)

Lemma leibniz_equality : forall (X : Type) (x y: X),
 x = y -> forall P : X -> Prop, P x -> P y.
Proof.
  intros X x y H P H1. inversion H. rewrite <- H2. apply H1. Qed.

(** We can use
    [refl_equal] to construct evidence that, for example, [2 = 2].
    Can we also use it to construct evidence that [1 + 1 = 2]?  Yes:
    indeed, it is the very same piece of evidence!  The reason is that
    Coq treats as "the same" any two terms that are _convertible_
    according to a simple set of computation rules.  These rules,
    which are similar to those used by [Eval compute], include
    evaluation of function application, inlining of definitions, and
    simplification of [match]es.
*)

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

(** The [reflexivity] tactic that we have used to prove equalities up
to now is essentially just short-hand for [apply refl_equal]. *)

End MyEquality.

(* ###################################################### *)
(** * Evidence-carrying booleans. *)

(** So far we've seen two different forms of equality predicates:
[eq], which produces a [Prop], and
the type-specific forms, like [beq_nat], that produce [boolean]
values.  The former are more convenient to reason about, but
we've relied on the latter to let us use equality tests
in _computations_.  While it is straightforward to write lemmas
(e.g. [beq_nat_true] and [beq_nat_false]) that connect the two forms,
using these lemmas quickly gets tedious.

It turns out that we can get the benefits of both forms at once
by using a construct called [sumbool]. *)

Inductive sumbool (A B : Prop) : Set :=
 | left : A -> sumbool A B
 | right : B -> sumbool A B.

Notation "{ A } + { B }" :=  (sumbool A B) : type_scope.

(** Think of [sumbool] as being like the [boolean] type, but instead
of its values being just [true] and [false], they carry _evidence_
of truth or falsity. This means that when we [destruct] them, we
are left with the relevant evidence as a hypothesis -- just as with [or].
(In fact, the definition of [sumbool] is almost the same as for [or].
The only difference is that values of [sumbool] are declared to be in
[Set] rather than in [Prop]; this is a technical distinction
that allows us to compute with them.) *)

(** Here's how we can define a [sumbool] for equality on [nat]s *)

Theorem eq_nat_dec : forall n m : nat, {n = m} + {n <> m}.
Proof.
  intros n.
  induction n as [|n'].
  Case "n = 0".
    intros m.
    destruct m as [|m'].
    SCase "m = 0".
      left. reflexivity.
    SCase "m = S m'".
      right. intros contra. inversion contra.
  Case "n = S n'".
    intros m.
    destruct m as [|m'].
    SCase "m = 0".
      right. intros contra. inversion contra.
    SCase "m = S m'".
      destruct IHn' with (m := m') as [eq | neq].
      left. apply f_equal.  apply eq.
      right. intros Heq. inversion Heq as [Heq']. apply neq. apply Heq'.
Defined.

(** Read as a theorem, this says that equality on [nat]s is decidable:
that is, given two [nat] values, we can always produce either
evidence that they are equal or evidence that they are not.
Read computationally, [eq_nat_dec] takes two [nat] values and returns
a [sumbool] constructed with [left] if they are equal and [right]
if they are not; this result can be tested with a [match] or, better,
with an [if-then-else], just like a regular [boolean].
(Notice that we ended this proof with [Defined] rather than [Qed].
The only difference this makes is that the proof becomes _transparent_,
meaning that its definition is available when Coq tries to do reductions,
which is important for the computational interpretation.)

Here's a simple example illustrating the advantages of the [sumbool] form. *)

Definition override' {X: Type} (f: nat->X) (k:nat) (x:X) : nat->X:=
  fun (k':nat) => if eq_nat_dec k k' then x else f k'.

Theorem override_same' : forall (X:Type) x1 k1 k2 (f : nat->X),
  f k1 = x1 ->
  (override' f k1 x1) k2 = f k2.
Proof.
  intros X x1 k1 k2 f. intros Hx1.
  unfold override'.
  destruct (eq_nat_dec k1 k2).   (* observe what appears as a hypothesis *)
  Case "k1 = k2".
    rewrite <- e.
    symmetry. apply Hx1.
  Case "k1 <> k2".
    reflexivity.  Qed.

(** Compare this to the more laborious proof (in MoreCoq.v) for the
   version of [override] defined using [beq_nat], where we had to
   use the auxiliary lemma [beq_nat_true] to convert a fact about booleans
   to a Prop. *)

(** **** Exercise: 1 star (override_shadow') *)
Theorem override_shadow' : forall (X:Type) x1 x2 k1 k2 (f : nat->X),
  (override' (override' f k1 x2) k1 x1) k2 = (override' f k1 x1) k2.
Proof.
  intros. unfold override'.
  destruct (eq_nat_dec k1 k2). reflexivity. reflexivity. Qed.

(* ####################################################### *)
(** ** Inversion, Again (Advanced) *)

(** We've seen [inversion] used with both equality hypotheses and
    hypotheses about inductively defined propositions.  Now that we've
    seen that these are actually the same thing, we're in a position
    to take a closer look at how [inversion] behaves...

    In general, the [inversion] tactic

    - takes a hypothesis [H] whose type [P] is inductively defined,
      and

    - for each constructor [C] in [P]'s definition,

      - generates a new subgoal in which we assume [H] was
        built with [C],

      - adds the arguments (premises) of [C] to the context of
        the subgoal as extra hypotheses,

      - matches the conclusion (result type) of [C] against the
        current goal and calculates a set of equalities that must
        hold in order for [C] to be applicable,

      - adds these equalities to the context (and, for convenience,
        rewrites them in the goal), and

      - if the equalities are not satisfiable (e.g., they involve
        things like [S n = O]), immediately solves the subgoal. *)

(** _Example_: If we invert a hypothesis built with [or], there are two
   constructors, so two subgoals get generated.  The
   conclusion (result type) of the constructor ([P \/ Q]) doesn't
   place any restrictions on the form of [P] or [Q], so we don't get
   any extra equalities in the context of the subgoal.

   _Example_: If we invert a hypothesis built with [and], there is
   only one constructor, so only one subgoal gets generated.  Again,
   the conclusion (result type) of the constructor ([P /\ Q]) doesn't
   place any restrictions on the form of [P] or [Q], so we don't get
   any extra equalities in the context of the subgoal.  The
   constructor does have two arguments, though, and these can be seen
   in the context in the subgoal.

   _Example_: If we invert a hypothesis built with [eq], there is
   again only one constructor, so only one subgoal gets generated.
   Now, though, the form of the [refl_equal] constructor does give us
   some extra information: it tells us that the two arguments to [eq]
   must be the same!  The [inversion] tactic adds this fact to the
   context.  *)

(** **** Exercise: 1 star, optional (dist_and_or_eq_implies_and) *)
Lemma dist_and_or_eq_implies_and : forall P Q R,
       P /\ (Q \/ R) /\ Q = R -> P/\Q.
Proof.
  intros.
  inversion H. inversion H1. split. apply H0. inversion H2.
  apply H4. rewrite -> H3. apply H4. Qed.

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

(** **** Exercise: 3 stars (all_forallb) *)
(** Inductively define a property [all] of lists, parameterized by a
    type [X] and a property [P : X -> Prop], such that [all X P l]
    asserts that [P] is true for every element of the list [l]. *)

Inductive all (X : Type) (P : X -> Prop) : list X -> Prop :=
  |allNil : all X P nil
  |allCons : forall (x : X) (l : list X), P x -> (all X P l) -> all X P (x::l).

(** Recall the function [forallb], from the exercise
    [forall_exists_challenge] in chapter [Poly]: *)

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

(** Using the property [all], write down a specification for [forallb],
    and prove that it satisfies the specification. Try to make your
    specification as precise as possible.

    Are there any important properties of the function [forallb] which
    are not captured by your specification? *)

Theorem forallbSpec : forall (X : Type) (test:X -> bool) (l : list X),
                        forallb test l = true -> all X (fun x => test x = true) l.
Proof.
  induction l.
  {intros. apply allNil. }
  {intros. inversion H. apply andb_prop in H1. inversion H1.
   apply allCons with (x := x). apply andb_true_intro in H1. symmetry.
   rewrite -> H0. rewrite -> H0 in H1. apply H1.

  Admitted.

Theorem forallbSpec2 : forall (X : Type) (test : X -> bool) (l : list X),
                         all X (fun x => test x = true) l -> forallb test l = true.
Proof.
  intros. induction H. reflexivity.
  {simpl. apply andb_true_intro. split.
   {apply H. }
   {apply IHall. }
  }
  Qed.

(** **** Exercise: 4 stars, advanced (filter_challenge) *)
(** One of the main purposes of Coq is to prove that programs match
    their specifications.  To this end, let's prove that our
    definition of [filter] matches a specification.  Here is the
    specification, written out informally in English.

    Suppose we have a set [X], a function [test: X->bool], and a list
    [l] of type [list X].  Suppose further that [l] is an "in-order
    merge" of two lists, [l1] and [l2], such that every item in [l1]
    satisfies [test] and no item in [l2] satisfies test.  Then [filter
    test l = l1].

    A list [l] is an "in-order merge" of [l1] and [l2] if it contains
    all the same elements as [l1] and [l2], in the same order as [l1]
    and [l2], but possibly interleaved.  For example,
    [1,4,6,2,3]
    is an in-order merge of
    [1,6,2]
    and
    [4,3].
    Your job is to translate this specification into a Coq theorem and
    prove it.  (Hint: You'll need to begin by defining what it means
    for one list to be a merge of two others.  Do this with an
    inductive relation, not a [Fixpoint].)  *)

Inductive InOrderMerge : forall (X : Type) (l1 l2 l3 : list X), Prop :=
  |mergeNil : forall (X : Type), InOrderMerge X nil nil nil
  |mergenilL : forall(X : Type) (l1 : list X), InOrderMerge X l1 nil l1
  |mergeNilR : forall(X : Type) (l1 : list X), InOrderMerge X l1 l1 nil
  |mergeCons : forall(X : Type) (x y : X) (l1 l2 l3 : list X),
                InOrderMerge X l1 l2 l3 -> InOrderMerge X (x::y::l1) (x::l2) (y::l3).

(** **** Exercise: 5 stars, advanced, optional (filter_challenge_2) *)
(** A different way to formally characterize the behavior of [filter]
    goes like this: Among all subsequences of [l] with the property
    that [test] evaluates to [true] on all their members, [filter test
    l] is the longest.  Express this claim formally and prove it. *)

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

(** **** Exercise: 4 stars, advanced (no_repeats) *)
(** The following inductively defined proposition... *)

Inductive appears_in {X:Type} (a:X) : list X -> Prop :=
  | ai_here : forall l, appears_in a (a::l)
  | ai_later : forall b l, appears_in a l -> appears_in a (b::l).

(** ...gives us a precise way of saying that a value [a] appears at
    least once as a member of a list [l].

    Here's a pair of warm-ups about [appears_in].
*)

Lemma appears_in_app : forall (X:Type) (xs ys : list X) (x:X),
     appears_in x (xs ++ ys) -> appears_in x xs \/ appears_in x ys.
Proof.
  induction xs.
  {intros. simpl in *. inversion H.
   {right. rewrite <- H0 in H. apply H. }
   {rewrite <- H1 in H. right. apply H. }
  }
  intros. simpl in *. inversion H. left. apply ai_later.
  Admitted.

Lemma app_appears_helper : forall (X : Type) (xs ys : list X) (x : X),
                             appears_in x (xs ++ (x::ys)).
Proof.
  intros.
  induction xs.
  {simpl. apply ai_here. }
  {simpl. apply ai_later. apply IHxs. }
  Qed.

Lemma app_appears_in : forall (X:Type) (xs ys : list X) (x:X),
     appears_in x xs \/ appears_in x ys -> appears_in x (xs ++ ys).
Proof.
  intros. generalize dependent ys. induction xs.
  {intros. simpl. inversion H. inversion H0. apply H0. }
  { intros. simpl. inversion H. inversion H0. apply ai_here.
    apply ai_later. apply IHxs. left. apply H2. apply ai_later.
    apply IHxs. right. apply H0. }
Qed.

(** Now use [appears_in] to define a proposition [disjoint X l1 l2],
    which should be provable exactly when [l1] and [l2] are
    lists (with elements of type X) that have no elements in common. *)

Inductive disjoint (X : Type) : list X -> list X -> Prop :=
  |disjointNil : forall (l : list X), disjoint X nil l
  |disjointCons : forall (x : X) (l1 l2 : list X),
                    disjoint X l1 l2 -> not(appears_in x l2) ->
                    disjoint X (x::l1) l2.

(** Next, use [appears_in] to define an inductive proposition
    [no_repeats X l], which should be provable exactly when [l] is a
    list (with elements of type [X]) where every member is different
    from every other.  For example, [no_repeats nat [1,2,3,4]] and
    [no_repeats bool []] should be provable, while [no_repeats nat
    [1,2,1]] and [no_repeats bool [true,true]] should not be.  *)

Inductive no_repeats (X : Type) : list X -> Prop :=
  |no_repeats_nil : no_repeats X nil
  |no_repeats_cons : forall (x : X) (l : list X),
                       no_repeats X l -> not(appears_in x l) -> no_repeats X (x::l).

(** Finally, state and prove one or more interesting theorems relating
    [disjoint], [no_repeats] and [++] (list append).  *)

Theorem AppNoRepeats : forall (X : Type) (l1 l2 : list X),
                         no_repeats X l1 -> no_repeats X l2 ->
                         disjoint X l1 l2 -> no_repeats X (l1++l2).
Proof.
  induction l1.
  {intros. simpl. apply H0. }
  intros. simpl. apply no_repeats_cons. apply IHl1.
   inversion H. apply H4. apply H0. inversion H1. apply H4.
   inversion H. apply IHl1 in H4. inversion H4. inversion H1.
   assert(H12 : l1 = []). destruct l1. reflexivity. inversion H7.
   rewrite -> H12. simpl. apply H11. Admitted.

(** **** Exercise: 3 stars (nostutter) *)
(** Formulating inductive definitions of predicates is an important
    skill you'll need in this course.  Try to solve this exercise
    without any help at all (except from your study group partner, if
    you have one).

    We say that a list of numbers "stutters" if it repeats the same
    number consecutively.  The predicate "[nostutter mylist]" means
    that [mylist] does not stutter.  Formulate an inductive definition
    for [nostutter].  (This is different from the [no_repeats]
    predicate in the exercise above; the sequence [1,4,1] repeats but
    does not stutter.) *)

Inductive nostutter:  list nat -> Prop :=
  |nostutterNil : nostutter nil
  |noStutterCons : forall (n : nat), nostutter (n::nil)
  |nostutterCons2 : forall (n1 n2 : nat) (l : list nat), nostutter (n2 :: l) -> (n1 <> n2) -> nostutter(n1::n2::l).

(** Make sure each of these tests succeeds, but you are free
    to change the proof if the given one doesn't work for you.
    Your definition might be different from mine and still correct,
    in which case the examples might need a different proof.

    The suggested proofs for the examples (in comments) use a number
    of tactics we haven't talked about, to try to make them robust
    with respect to different possible ways of defining [nostutter].
    You should be able to just uncomment and use them as-is, but if
    you prefer you can also prove each example with more basic
    tactics.  *)

Example test_nostutter_1:      nostutter [3;1;4;1;5;6].
  Proof. repeat constructor; apply beq_nat_false; auto. Qed.

Example test_nostutter_2:  nostutter [].
  Proof. repeat constructor; apply beq_nat_false; auto. Qed.

Example test_nostutter_3:  nostutter [5].
  Proof. repeat constructor; apply beq_nat_false; auto. Qed.

Example test_nostutter_4:      not (nostutter [3;1;1;4]).
 Proof. intro.
  repeat match goal with
    h: nostutter _ |- _ => inversion h; clear h; subst
  end. unfold not in H5. apply H5. reflexivity. Qed.

(** **** Exercise: 4 stars, advanced (pigeonhole principle) *)
(** The "pigeonhole principle" states a basic fact about counting:
   if you distribute more than [n] items into [n] pigeonholes, some
   pigeonhole must contain at least two items.  As is often the case,
   this apparently trivial fact about numbers requires non-trivial
   machinery to prove, but we now have enough... *)

(** First a pair of useful lemmas (we already proved these for lists
    of naturals, but not for arbitrary lists). *)

Lemma app_length : forall (X:Type) (l1 l2 : list X),
  length (l1 ++ l2) = length l1 + length l2.
Proof.
  intros. induction l1.
  {simpl. reflexivity. }
  {simpl. apply f_equal. apply IHl1. }
  Qed.

Lemma appears_in_app_split : forall (X:Type) (x:X) (l:list X),
  appears_in x l ->
  exists l1, exists l2, l = l1 ++ (x::l2).
Proof.
  intros.
  induction H.
  {exists []. exists l. simpl. reflexivity. }
  {inversion IHappears_in. inversion H0. rewrite -> H1.
   exists (b::witness). exists witness0. simpl. reflexivity. }
  Qed.

(** Now define a predicate [repeats] (analogous to [no_repeats] in the
   exercise above), such that [repeats X l] asserts that [l] contains
   at least one repeated element (of type [X]).  *)

Inductive repeats {X:Type} : list X -> Prop :=
 |repeatsHit : forall (x : X) (l : list X), appears_in x l -> repeats (x::l)
 |repeatsMiss : forall (x : X) (l : list X), repeats l -> repeats (x::l).

(** Now here's a way to formalize the pigeonhole principle. List [l2]
   represents a list of pigeonhole labels, and list [l1] represents an
   assignment of items to labels: if there are more items than labels,
   at least two items must have the same label.  You will almost
   certainly need to use the [excluded_middle] hypothesis. *)

Theorem pigeonhole_principle: forall (X:Type) (l1 l2:list X),
  excluded_middle ->
  (forall x, appears_in x l1 -> appears_in x l2) ->
  length l2 < length l1 ->
  repeats l1.
Proof.
  intros X l1. induction l1.
  {intros. simpl in *. inversion H1. }
  {intros. unfold excluded_middle in *.
   apply IHl1 with(l2 := l2) in H. apply repeatsMiss. apply H.
   intros. apply IHl1 with(l2 := l2) in H. Admitted.

(* $Date: 2013-07-17 16:19:11 -0400 (Wed, 17 Jul 2013) $ *)


Require Import Cpdt.CpdtTactics.

Check (fun x : nat => x).

Check (fun x : True => x).

Check I.

Check (fun _ : False => I).

(* Enumeration *)

Inductive unit : Set := tt.

Theorem unit_singleton : forall x : unit, x = tt.
Proof.
  induction x. reflexivity.
Qed.

Check unit_ind.

(* Set: the type of normal types, the values of Set are programs.
 * Prop: the type of logical propositions, the values of Prop are proofs
 *)

Inductive EmptySet : Set := .

Theorem the_sky_is_falling : forall x : EmptySet, 2 + 2 = 5.
Proof.
  intros. destruct x.
Qed.

Check EmptySet_ind.

Definition e2u (e : EmptySet) : unit := match e with end.

Inductive bool : Set :=
| true
| false.

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

Definition negb' (b : bool) : bool :=
  if b then false else true.

Theorem negb_inverse : forall b : bool, negb (negb b) = b.
Proof.
  destruct b; simpl; reflexivity.
Qed.

Theorem negb_ineq : forall b : bool, negb b <> b.
  destruct b; discriminate.
Qed.

Check bool_ind.

(* Simple Recursive Types *)

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

Definition isZero (n : nat) : bool :=
  match n with
    | O => true
    | S _ => false
  end.

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

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

Theorem O_plus_n : forall n : nat, plus O n = n.
  intro; reflexivity.
Qed.

Theorem n_plus_O : forall n : nat, plus n O = n.
  induction n; simpl; auto.
  rewrite IHn. reflexivity.
Qed.

Check nat_ind.

Theorem S_inj : forall n m : nat, S n = S m -> n = m.
  intros. inversion H. auto.
Qed.

Inductive nat_list : Set :=
| NNil : nat_list
| NCons : nat -> nat_list -> nat_list.

Fixpoint nlength (ls : nat_list) : nat :=
  match ls with
    | NNil => O
    | NCons _ ls' => S (nlength ls')
  end.

Fixpoint napp (ls1 ls2 : nat_list) : nat_list :=
  match ls1 with
    | NNil => ls2
    | NCons n ls1' => NCons n (napp ls1' ls2)
  end.

Theorem nlength_napp : forall ls1 ls2 : nat_list,
    nlength (napp ls1 ls2) = plus (nlength ls1) (nlength ls2).
  induction ls1; crush.
Qed.

Check nat_list_ind.

Inductive nat_btree : Set :=
| NLeaf : nat_btree
| NNode : nat_btree -> nat -> nat_btree -> nat_btree.

Fixpoint nsize (tr : nat_btree) : nat :=
  match tr with
    | NLeaf => S O
    | NNode tr1 _ tr2 => plus (nsize tr1) (nsize tr2)
  end.

Fixpoint nsplice (t1 t2 : nat_btree) : nat_btree :=
  match t1 with
  | NLeaf => NNode t2 O NLeaf
  | NNode t1' n t2' => NNode (nsplice t1' t2) n t2'
  end.

Theorem plus_assoc : forall n1 n2 n3 : nat, plus (plus n1 n2) n3 = plus n1 (plus n2 n3).
  induction n1; crush.
Qed.

Hint Rewrite n_plus_O plus_assoc.

Theorem nsize_nsplice : forall tr1 tr2 : nat_btree,
    nsize (nsplice tr1 tr2) = plus (nsize tr2) (nsize tr1).
  induction tr1; crush.
Qed.

Check nat_btree_ind.

(* Parameterized Types *)

Section list.
  Variable T : Set.

  Inductive list : Set :=
  | Nil : list
  | Cons : T -> list -> list.

  Fixpoint length (ls : list) : nat :=
    match ls with
      | Nil => O
      | Cons _ ls' => S (length ls')
    end.

  Fixpoint app (ls1 ls2 : list) : list :=
    match ls1 with
      | Nil => ls2
      | Cons x ls1' => Cons x (app ls1' ls2)
    end.

  Theorem length_app : forall ls1 ls2 : list, length (app ls1 ls2)
    = plus (length ls1) (length ls2).
    induction ls1; crush.
  Qed.

End list.

Arguments Nil {T}.

Print list.

Check length.

Check list_ind.

(* Mutually Inductive Types *)

Inductive even_list : Set :=
| ENil : even_list
| ECons : nat -> odd_list -> even_list
with odd_list : Set :=
| OCons : nat -> even_list -> odd_list
.

Fixpoint elength (el : even_list) : nat :=
  match el with
  | ENil => O
  | ECons _ ol => S (olength ol)
  end
with olength (ol : odd_list) : nat :=
  match ol with
  | OCons _ el => S (elength el)
  end.

Fixpoint eapp (el1 el2 : even_list) : even_list :=
  match el1 with
    | ENil => el2
    | ECons n ol => ECons n (oapp ol el2)
  end
with oapp (ol : odd_list) (el : even_list) : odd_list :=
  match ol with
    | OCons n el' => OCons n (eapp el' el)
  end.

Scheme even_list_mut := Induction for even_list Sort Prop
with odd_list_mut := Induction for odd_list Sort Prop.

Check even_list_mut.
Check odd_list_mut.

Theorem n_plus_O' : forall n, plus n O = n.
  apply nat_ind.
  Undo.
  apply (nat_ind (fun n => plus n O = n)); crush.
Qed.

Theorem elength_eapp : forall el1 el2 : even_list,
    elength (eapp el1 el2) = plus (elength el1) (elength el2).
Proof.
  apply (even_list_mut
           (fun el1 : even_list => forall el2 : even_list,
                elength (eapp el1 el2) = plus (elength el1) (elength el2))
           (fun ol : odd_list => forall el : even_list,
                olength (oapp ol el) = plus (olength ol) (elength el))).
  - intros. simpl. reflexivity.
  - intros. simpl. f_equal. rewrite H. reflexivity.
  - intros. simpl. f_equal. rewrite H. reflexivity.
Qed.

(* Reflexive Types *)

(* Encoding the syntax of first-order logic *)

Inductive pformula : Set :=
| Truth : pformula
| Falsehood : pformula
| Conjunction : pformula -> pformula -> pformula
.

Fixpoint pformulaDenote (f : pformula) : Prop :=
  match f with
  | Truth => True
  | Falsehood => False
  | Conjunction f1 f2 => pformulaDenote f1 /\ pformulaDenote f2
  end.

Inductive formula : Set :=
| Eq : nat -> nat -> formula
| And : formula -> formula -> formula
| Forall : (nat -> formula) -> formula
.

Example forall_refl : formula := Forall (fun x => Eq x x).

Fixpoint formulaDenote (f : formula) : Prop :=
  match f with
    | Eq n1 n2 => n1 = n2
    | And f1 f2 => formulaDenote f1 /\ formulaDenote f2
    | Forall f' => forall n : nat, formulaDenote (f' n)
  end.

Fixpoint swapper (f : formula) : formula :=
  match f with
    | Eq n1 n2 => Eq n2 n1
    | And f1 f2 => And (swapper f2) (swapper f1)
    | Forall f' => Forall (fun n => swapper (f' n))
  end.

Theorem swapper_preserves_truth : forall f, formulaDenote f -> formulaDenote (swapper f).
  induction f; crush.
Qed.

Check formula_ind.

(* An Interlude on Induction Principles *)

(* difference: P ranges over Prop, Type, or Set *)

Print nat_ind.  (* Prop *)
Print nat_rect. (* Type *)
Print nat_rec.  (* Set *)

(* Type is a supertype of Set and Prop *)

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

Definition plus_rec : nat -> nat -> nat :=
  nat_rec (fun _ : nat => nat -> nat) (fun m => m) (fun _ rec m => S (rec m)).

Theorem plus_equivalent : plus_recursive = plus_rec.
  reflexivity.
Qed.

(* nat_rect can be defined manually *)

Fixpoint nat_rect' (P : nat -> Type)
         (HO : P O)
         (HS : forall n, P n -> P (S n)) (n : nat) : P n :=
  match n return P n with
  | O => HO
  | S n' => HS n' (nat_rect' P HO HS n')
  end.

Section nat_ind'.
  Variable P : nat -> Prop.
  Hypothesis O_case : P O.
  Hypothesis S_case : forall n : nat, P n -> P (S n).

  Fixpoint nat_ind' (n : nat) : P n :=
    match n with
    | O => O_case
    | S n' => S_case n' (nat_ind' n')
    end.

End nat_ind'.

Check nat_ind'.

(* Implementing even_list_mut directly *)

Section even_list_mut'.
  Variable Peven : even_list -> Prop.
  Variable Podd : odd_list -> Prop.

  Hypothesis ENil_case : Peven ENil.
  Hypothesis ECons_case : forall (n : nat) (o : odd_list),
      Podd o -> Peven (ECons n o).
  Hypothesis OCons_case : forall (n : nat) (e : even_list),
      Peven e -> Podd (OCons n e).

  Fixpoint even_list_mut' (e : even_list) : Peven e :=
    match e with
    | ENil => ENil_case
    | ECons n o => ECons_case n o (odd_list_mut' o)
    end
  with
    odd_list_mut' (o : odd_list) : Podd o :=
    match o with
    | OCons n e => OCons_case n e (even_list_mut' e)
    end.
End even_list_mut'.

Section formula_ind'.
  Variable P : formula -> Prop.
  Hypothesis Eq_case : forall n1 n2 : nat, P (Eq n1 n2).
  Hypothesis And_case : forall f1 f2 : formula,
    P f1 -> P f2 -> P (And f1 f2).
  Hypothesis Forall_case : forall f : nat -> formula,
    (forall n : nat, P (f n)) -> P (Forall f).

  Fixpoint formula_ind' (f : formula) : P f :=
    match f with
      | Eq n1 n2 => Eq_case n1 n2
      | And f1 f2 => And_case f1 f2 (formula_ind' f1) (formula_ind' f2)
      | Forall f' => Forall_case f' (fun n => formula_ind' (f' n))
    end.
End formula_ind'.

(* Nested Inductive Types *)

Inductive nat_tree : Set :=
| NNode' : nat -> list nat_tree -> nat_tree.

Check nat_tree_ind.

Section All.
  Variable T : Set.
  Variable P : T -> Prop.

  Fixpoint All (ls : list T) : Prop :=
    match ls with
      | Nil => True
      | Cons _ h t => P h /\ All t
    end.
End All.

Print True.
Locate "/\".
Print and.

Section nat_tree_ind'.
  Variable P : nat_tree -> Prop.
  Hypothesis NNode'_case : forall (n : nat) (ls : list nat_tree),
      All nat_tree P ls -> P (NNode' n ls).

  (* Neste types requrie neste recursion *)
  Fixpoint nat_tree_ind' (tr : nat_tree) : P tr :=
    match tr with
    | NNode' n ls =>
        NNode'_case n ls
                    ((fix list_nat_tree_ind (ls : list nat_tree) : All nat_tree P ls :=
                        match ls with
                        | Nil => I
                        | Cons _ tr' rest => conj (nat_tree_ind' tr')
                                               (list_nat_tree_ind rest)
                        end)
                       ls)
    end.

End nat_tree_ind'.

Section map.
  Variables T T' : Set.
  Variable F : T -> T'.

  Fixpoint map (ls : list T) : list T' :=
    match ls with
      | Nil => Nil
      | Cons _ h t => Cons _ (F h) (map t)
    end.
End map.

Fixpoint sum (ls : list nat) : nat :=
  match ls with
    | Nil => O
    | Cons _ h t => plus h (sum t)
  end.

Fixpoint ntsize (tr : nat_tree) : nat :=
  match tr with
    | NNode' _ trs => S (sum (map _ _ ntsize trs))
  end.

Fixpoint ntsplice (tr1 tr2 : nat_tree) : nat_tree :=
  match tr1 with
    | NNode' n Nil => NNode' n (Cons _ tr2 Nil)
    | NNode' n (Cons _ tr trs) => NNode' n (Cons _ (ntsplice tr tr2) trs)
  end.

Lemma plus_S : forall n1 n2 : nat,
  plus n1 (S n2) = S (plus n1 n2).
  induction n1; crush.
Qed.

#[global] Hint Rewrite plus_S.

Theorem ntsize_ntsplice : forall tr1 tr2 : nat_tree,
    ntsize (ntsplice tr1 tr2) = plus (ntsize tr2) (ntsize tr1).
Proof.
  induction tr1 using nat_tree_ind'.
  crush. destruct ls; crush.
Qed.

(* Manual Proofs About Constructors *)

Definition toProp (b : bool) := if b then True else False.

Theorem true_neq_false : true <> false.
Proof.
  red. intro. change (toProp false). rewrite <- H. red. trivial.
Qed.

Theorem S_inj' : forall n m : nat, S n = S m -> n = m.
  intros n m H.
  change (pred (S n) = pred (S m)).
  rewrite H. reflexivity.
Qed.


From Coq Require Import Arith.

Lemma mult_distr_S : forall n p : nat, n * p + p =  S n * p.
Proof.
 simpl; auto with arith.
Qed.

Lemma four_n : forall n:nat,
  n + n + n + n = 4 * n.
Proof.
  intro n. pattern n at 1.
  rewrite <- mult_1_l.
  rewrite mult_distr_S. rewrite mult_distr_S.
  now rewrite mult_distr_S.
Qed.


Require Import Arith.

Module Type SemiGroup.
  Parameter G : Type.
  Parameter mult : G -> G -> G.
  Axiom mult_assoc :
    forall x y z : G, mult x (mult y z) = mult (mult x y) z.
End SemiGroup.

Module NatMult_SemiGroup <: SemiGroup.
  Definition G := nat.
  Definition mult:= mult%nat.
  Proposition mult_assoc:
    forall x y z : G, mult x (mult y z) = mult (mult x y) z.
    apply Nat.mul_assoc.
  Qed.
  End NatMult_SemiGroup.

Module NatMax_SemiGroup <: SemiGroup.
  Definition G := nat.
  Definition mult:= max%nat.
  Proposition mult_assoc:
    forall x y z : G, mult x (mult y z) = mult (mult x y) z.
    apply Nat.max_assoc.
  Qed.
End NatMax_SemiGroup.

Module SemiGroup_Product (G0 G1:SemiGroup) <: SemiGroup.
  Definition G := prod G0.G G1.G.
  Definition mult x y :=
    match x with |(a1, a2) =>
      match y with |(b1, b2) => (G0.mult a1 b1, G1.mult a2 b2)
      end
    end.
  Proposition mult_assoc:
    forall x y z : G, mult x (mult y z) = mult (mult x y) z.
  intros x y z.
  destruct x, y, z.
  unfold mult.
  rewrite G0.mult_assoc.
  rewrite G1.mult_assoc.
  reflexivity.
  Qed.
End SemiGroup_Product.


Theorem plus_0_r : forall n:nat, n+0=n.
Proof. induction n. reflexivity. simpl. rewrite IHn. reflexivity. Qed.
Theorem plus_assoc : forall n m l:nat, (m+n)+l=m+(n+l).
Proof. induction m. reflexivity. intros l. simpl. rewrite IHm. reflexivity. Qed.
Theorem plus_suc_r : forall m n:nat, m+S n=S(m+n).
Proof. induction m. reflexivity. simpl. intros n. rewrite IHm. reflexivity. Qed.
Theorem mult_1_r : forall n:nat, n*1=n.
Proof. induction n. reflexivity. simpl. rewrite IHn. reflexivity. Qed.
Theorem plus_comm : forall n m:nat, n+m=m+n.
Proof. induction n. simpl. intros m. rewrite plus_0_r. reflexivity. simpl.
intros m. rewrite plus_suc_r. rewrite IHn. reflexivity. Qed.
Theorem mult_0_r : forall n:nat, n*0=0.
Proof. induction n. reflexivity. simpl. rewrite IHn. reflexivity. Qed.
Theorem mult_suc_r : forall n m:nat, n*(S m)=n+n*m.
Proof. induction n. reflexivity. simpl. intros m. rewrite IHn.
rewrite <- plus_assoc. assert (H1:m+n=n+m). rewrite plus_comm. reflexivity.
rewrite H1. rewrite plus_assoc. reflexivity. Qed.
Theorem mult_comm : forall m n:nat, n*m=m*n.
Proof. induction n. simpl. rewrite mult_0_r. reflexivity.
rewrite mult_suc_r. simpl. rewrite IHn. reflexivity. Qed.


Require Import Problem.

(*
  Prove task1 or task2. You can choose either one you like.
 *)

(*Lemma solution1: task1.
Proof.
  unfold task1.
  intros.
  destruct P,Q.
  (* FILL IN HERE *)
Qed.
*)

Theorem deMorgan1 (A B: Prop): ~(A\/B) -> ~A/\~B.
Proof.
  intro NAB.
  split.

  (* NAB: ~(A\/B) |- ~A *)
  - intro A1.
    apply NAB.
    left.
    exact A1.

  (* NAB ~(A\/B) |- ~B *)
  - intro B1.
    apply NAB.
    right.
    exact B1.
Qed.

Theorem deMorgan2 (A B: Prop): ~A/\~B -> ~(A\/B).
Proof.
  intros NANB AB.
  destruct NANB as [NA NB].
  destruct AB as [A1 | B1].

  (* NA:~A, NB:~B A1:A |- False *)
  - apply NA.
    exact A1.

  (* NA:~A, NB:~B B1:B |- False *)
  - apply NB.
    exact B1.
Qed.

Print deMorgan2.

Lemma solution2: task2.
Proof.
  unfold task2.
  intros.
  split.
  - apply deMorgan2.
  - apply deMorgan1.
Qed.

Theorem solution: task1 \/ task2.
Proof.
  right. apply solution2.
Qed.


Inductive bin : Type :=
  | Z : bin
  | T : bin -> bin
  | TPO: bin -> bin.

Check Z.
Check T Z.
Check TPO Z.
Check T (TPO Z).
Check TPO (T (TPO Z)).

Definition incr (n : bin) : bin :=
  match n with
  | Z => TPO Z
  | T n' => TPO n'
  | TPO n' => T (match n' with
                 | Z => TPO Z
                 | TPO n'' => T (T n'')
                 | T n'' => TPO n''
                 end)
  end.

Check incr Z.
Check incr (TPO Z).
Check incr (T (TPO Z)).

Fixpoint bin_to_nat (n: bin): nat :=
  match n with
  | Z => O
  | T n' => mult (S (S O)) (bin_to_nat n')
  | TPO n' => S (mult (S (S O)) (bin_to_nat n'))
  end.

Check bin_to_nat Z.
Check bin_to_nat (TPO Z).
Check bin_to_nat (T (TPO Z)).
Check bin_to_nat (TPO (T (T (T (TPO Z))))).

Example bin_0_equals_nat_0: bin_to_nat Z = 0.
Proof. reflexivity. Qed.
Example bin_1_equals_nat_1: bin_to_nat (TPO Z) = 1.
Proof. reflexivity. Qed.
Example bin_2_equals_nat_2: bin_to_nat (T (TPO Z)) = 2.
Proof. reflexivity. Qed.
Example bin_9_equals_nat_9:  bin_to_nat (TPO (T (T (TPO Z)))) = 9.
Proof. reflexivity. Qed.

Example test_bin_incr1: bin_to_nat (incr Z) = 1.
Proof. reflexivity. Qed.
Example test_bin_incr2: bin_to_nat (incr (TPO Z)) = 2.
Proof. reflexivity. Qed.
Example test_bin_incr6: bin_to_nat (incr (TPO (T (TPO Z)))) = 6.
Proof. reflexivity. Qed.
Example test_bin_incr9: bin_to_nat (incr (T (T (T (TPO Z))))) = 9.
Proof. reflexivity. Qed.


(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)

Require Import List.
Require Import Permutation.

Require Omega.

Set Implicit Arguments.

(* Various Permutation results *)

Infix "~p" := (@Permutation _) (at level 80).

Section perm_t.

  Variable X : Type.

  Inductive perm_t : list X -> list X -> Type :=
    | perm_t_nil   : perm_t nil nil
    | perm_t_cons  : forall x l m, perm_t l m -> perm_t (x::l) (x::m)
    | perm_t_swap  : forall x y l, perm_t (x::y::l) (y::x::l)
    | perm_t_trans : forall l m k, perm_t l m -> perm_t m k -> perm_t l k.

  Fact perm_t_refl l : perm_t l l.
  Proof.
    induction l; simpl; constructor; auto.
  Qed.

  Fact perm_t_sym l m : perm_t l m -> perm_t m l.
  Proof.
    induction 1; try constructor; auto.
    apply perm_t_trans with m; auto.
  Qed.

  Fact perm_t_app a b l m : perm_t a b -> perm_t l m -> perm_t (a++l) (b++m).
  Proof.
    intros H1 H2.
    apply perm_t_trans with (a++m).
    clear H1.
    induction a; simpl; auto; constructor; auto.
    clear H2.
    induction H1; simpl; auto.
    apply perm_t_refl.
    constructor; auto.
    constructor.
    apply perm_t_trans with (m0++m); auto.
  Qed.

  Fact perm_t_exchg a x b y c : perm_t (a++x::b++y::c) (a++y::b++x::c).
  Proof.
    apply perm_t_app.
    apply perm_t_refl.
    replace (perm_t (x :: b ++ y :: c) (y :: b ++ x :: c))
    with (perm_t ((x::b++y::nil)++c) ((y::b++x::nil)++c)).
    apply perm_t_app.
    2: apply perm_t_refl.
    2: repeat (simpl; rewrite app_ass); auto.
    clear a c.
    revert x y; induction b as [ | u b IH ]; intros x y; simpl.
    constructor.
    apply perm_t_trans with (1 := perm_t_swap _ _ _).
    apply perm_t_trans with (2 := perm_t_swap _ _ _).
    constructor; auto.
  Qed.

  Fact perm_t_middle x l m : perm_t (x::l++m) (l++x::m).
  Proof.
    induction l as [ | y l IH ]; simpl.
    apply perm_t_refl.
    apply perm_t_trans with (1 := perm_t_swap _ _ _).
    constructor; auto.
  Qed.

  Fact perm_t_Permutation l m : perm_t l m -> l ~p m.
  Proof.
    induction 1; auto; try constructor.
    apply perm_trans with m; auto.
  Qed.

End perm_t.

Section Permutation_rect.

  Variable (X : Type) (dec : forall x y : X, { x = y } + { x <> y }) (P : list X -> list X -> Type).

  Definition In_split_dec (x : X) m : In x m -> { l : _ & { r | m = l++x::r } }.
  Proof.
    induction m as [ | y m IH ].
    intros [].
    destruct (dec x y) as [ E | C ].
    subst; exists nil, m; auto.
    intros H.
    destruct IH as (l & r & ?).
    destruct H as [ ? | ]; auto.
    contradict C; auto.
    exists (y::l), r; simpl; f_equal; auto.
  Qed.

  (* Permutation and perm_t are equivalent when equality is decidable
     on the base type *)

  Theorem Permutation_perm_t (l m : list X) : l ~p m -> perm_t l m.
  Proof.
    revert m; induction l as [ | x l IHl ]; intros m H.
    apply Permutation_nil in H; subst; auto.
    constructor.
    destruct (@In_split_dec x m) as (ll & rr & E).
    apply Permutation_in with (1 := H); left; auto.
    subst.
    apply perm_t_trans with (x::ll++rr).
    constructor.
    apply IHl; auto.
    apply Permutation_cons_app_inv in H; auto.
    apply perm_t_middle.
  Qed.

  (* we derive a Type recursion principle for Permutation when
     the base type is decidable *)

  Hypothesis (HP0 : P nil nil)
             (HP1 : forall x l m, l ~p m -> P l m -> P (x::l) (x::m))
             (HP2 : forall x y l, P (x::y::l) (y::x::l))
             (HP3 : forall l m k, l ~p m -> P l m -> m ~p k -> P m k -> P l k).

  Theorem Permutation_rect l m : l ~p m -> P l m.
  Proof.
    intros H.
    apply Permutation_perm_t in H.
    induction H; auto.
    apply HP1; auto.
    apply perm_t_Permutation; auto.
    apply HP3 with m; auto;
      apply perm_t_Permutation; auto.
  Qed.

End Permutation_rect.

Section Permutation_tools.

  Variable X : Type.

  Implicit Types (l : list X).

  Theorem Permutation_In_inv l1 l2: l1 ~p l2 -> forall x, In x l1 -> exists l, exists r, l2 = l++x::r.
  Proof.
    intros H x Hx.
    apply in_split.
    apply Permutation_in with (1 := H).
    auto.
  Qed.

  Fact perm_in_head x l : In x l -> exists m, l ~p x::m.
  Proof.
    induction l as [ | y l IHl ].
    destruct 1.
    intros [ ? | H ]; subst.
    exists l; apply Permutation_refl.
    destruct (IHl H) as (m & Hm).
    exists (y::m).
    apply Permutation_trans with (2 := perm_swap _ _ _).
    constructor 2; auto.
  Qed.

  Theorem Permutation_add_one l1 l2 a r1 r2 : l1++r1 ~p l2++r2 -> l1++a::r1 ~p l2++a::r2.
  Proof.
    intros H.
    apply Permutation_trans with (2 := Permutation_middle _ _ _).
    apply Permutation_sym.
    apply Permutation_trans with (2 := Permutation_middle _ _ _).
    apply Permutation_sym.
    auto.
  Qed.

  Hint Resolve Permutation_add_one : core.

  Theorem Permutation_app_intro l1 l2 k r1 r2 : l1++r1 ~p l2++r2 -> l1++k++r1 ~p l2++k++r2.
  Proof. induction k; auto; simpl;intro; auto. Qed.

  Theorem Permutation_simpl_middle l1 l2 k r1 r2 : l1++k++r1 ~p l2++k++r2 -> l1++r1 ~p l2++r2.
  Proof.
    induction k; auto.
    intros H; simpl in H.
    apply Permutation_app_inv in H.
    auto.
  Qed.

  Hypothesis eqX_dec : forall x y : X, { x = y } + { x <> y }.

  Theorem Permutation_dec l m : { l ~p m } + { ~ (l ~p m) }.
  Proof.
    revert m; induction l as [ | x l IHl ].
    intros [ | y m ].
    left; auto.
    right; intros C; apply Permutation_nil in C; discriminate.
    intros m.
    destruct (In_dec eqX_dec x m) as [ H | H ].
    assert { m1 : _ & { m2 | m = m1++x::m2 } } as E.
      induction m as [ | y m IHm ].
      destruct H.
      destruct (eqX_dec x y) as [ E | D ].
      subst; exists nil, m; simpl; auto.
      destruct IHm as (m1 & m2 & Hm).
      destruct H; auto; contradict D; auto.
      exists (y::m1), m2; simpl; f_equal; auto.
    clear H; destruct E as (m1 & m2 & E).
    destruct (IHl (m1++m2)) as [ H | H ].
    subst; left; apply Permutation_cons_app; auto.
    subst; right; contradict H.
    apply Permutation_cons_app_inv in H; auto.
    right; contradict H.
    apply Permutation_in with (1 := H); left; auto.
  Qed.

  Fact Permutation_cons_2_inv (x y : X) l m : x::l ~p y::m -> (x = y /\ l ~p m) \/ exists k, l ~p y::k /\ m ~p x::k.
  Proof.
    intros H.
    assert (In x (y::m)) as H1.
      apply Permutation_in with (1 := H); left; auto.
    destruct H1 as [ H1 | H1 ].
    subst x; left; split; auto; revert H; apply Permutation_cons_inv.
    assert (exists k, m ~p x::k) as Hk.
      apply in_split in H1.
      destruct H1 as (m1 & m2 & H1).
      exists (m1++m2); subst.
      apply Permutation_sym, Permutation_cons_app; auto.
    clear H1.
    destruct Hk as (k & Hk).
    right; exists k; split; auto.
    apply Permutation_trans with (2 := perm_skip _ Hk) in H.
    apply Permutation_trans with (2 := perm_swap _ _ _) in H.
    revert H; apply Permutation_cons_inv.
  Qed.

End Permutation_tools.