(** * Lists: Working with Structured Data *)

Add LoadPath ".".
Require Export Induction.

Module NatList.

(* ###################################################### *)
(** * Pairs of Numbers *)

(** In an [Inductive] type definition, each constructor can take
    any number of arguments -- none (as with [true] and [O]), one (as
    with [S]), or more than one, as in this definition: *)

Inductive natprod : Type :=
  pair : nat -> nat -> natprod.

(** This declaration can be read: "There is just one way to
    construct a pair of numbers: by applying the constructor [pair] to
    two arguments of type [nat]." *)

(** We can construct an element of [natprod] like this: *)

Check (pair 3 5).

(** *** *)

(** Here are two simple function definitions for extracting the
    first and second components of a pair.  (The definitions also
    illustrate how to do pattern matching on two-argument
    constructors.) *)

Definition fst (p : natprod) : nat :=
  match p with
  | pair x y => x
  end.
Definition snd (p : natprod) : nat :=
  match p with
  | pair x y => y
  end.

Eval compute in (fst (pair 3 5)).
(* ===> 3 *)

(** *** *)

(** Since pairs are used quite a bit, it is nice to be able to
    write them with the standard mathematical notation [(x,y)] instead
    of [pair x y].  We can tell Coq to allow this with a [Notation]
    declaration. *)

Notation "( x , y )" := (pair x y).

(** The new notation can be used both in expressions and in
    pattern matches (indeed, we've seen it already in the previous
    chapter -- this notation is provided as part of the standard
    library): *)

Eval compute in (fst (3,5)).

Definition fst' (p : natprod) : nat :=
  match p with
  | (x,y) => x
  end.
Definition snd' (p : natprod) : nat :=
  match p with
  | (x,y) => y
  end.

Definition swap_pair (p : natprod) : natprod :=
  match p with
  | (x,y) => (y,x)
  end.

(** *** *)

(** Let's try and prove a few simple facts about pairs.  If we
    state the lemmas in a particular (and slightly peculiar) way, we
    can prove them with just reflexivity (and its built-in
    simplification): *)

Theorem surjective_pairing' : forall (n m : nat),
  (n,m) = (fst (n,m), snd (n,m)).
Proof.
  reflexivity.  Qed.

(** Note that [reflexivity] is not enough if we state the lemma in a
    more natural way: *)

Theorem surjective_pairing_stuck : forall (p : natprod),
  p = (fst p, snd p).
Proof.
  simpl. (* Doesn't reduce anything! *)
Abort.

(** *** *)
(** We have to expose the structure of [p] so that [simpl] can
    perform the pattern match in [fst] and [snd].  We can do this with
    [destruct].

    Notice that, unlike for [nat]s, [destruct] doesn't generate an
    extra subgoal here.  That's because [natprod]s can only be
    constructed in one way.  *)

Theorem surjective_pairing : forall (p : natprod),
  p = (fst p, snd p).
Proof.
  intros p.  destruct p as [n m].  simpl.  reflexivity.  Qed.

(** **** Exercise: 1 star (snd_fst_is_swap)  *)
Theorem snd_fst_is_swap : forall (p : natprod),
  (snd p, fst p) = swap_pair p.
Proof.
  intros p.
  destruct p as [n m].
  simpl. reflexivity.
Qed.
(** [] *)

(** **** Exercise: 1 star, optional (fst_swap_is_snd)  *)
Theorem fst_swap_is_snd : forall (p : natprod),
  fst (swap_pair p) = snd p.
Proof.
  intros p.
  rewrite <- snd_fst_is_swap.
  simpl. reflexivity.
Qed.
(** [] *)

(* ###################################################### *)
(** * Lists of Numbers *)

(** Generalizing the definition of pairs a little, we can
    describe the type of _lists_ of numbers like this: "A list is
    either the empty list or else a pair of a number and another
    list." *)

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

(** For example, here is a three-element list: *)

Definition mylist := cons 1 (cons 2 (cons 3 nil)).

(** *** *)
(** As with pairs, it is more convenient to write lists in
    familiar programming notation.  The following two declarations
    allow us to use [::] as an infix [cons] operator and square
    brackets as an "outfix" notation for constructing lists. *)

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

(** It is not necessary to fully understand these declarations,
    but in case you are interested, here is roughly what's going on.

    The [right associativity] annotation tells Coq how to parenthesize
    expressions involving several uses of [::] so that, for example,
    the next three declarations mean exactly the same thing: *)

Definition mylist1 := 1 :: (2 :: (3 :: nil)).
Definition mylist2 := 1 :: 2 :: 3 :: nil.
Definition mylist3 := [1;2;3].

(** The [at level 60] part tells Coq how to parenthesize
    expressions that involve both [::] and some other infix operator.
    For example, since we defined [+] as infix notation for the [plus]
    function at level 50,
Notation "x + y" := (plus x y)
                    (at level 50, left associativity).
   The [+] operator will bind tighter than [::], so [1 + 2 :: [3]]
   will be parsed, as we'd expect, as [(1 + 2) :: [3]] rather than [1
   + (2 :: [3])].

   (By the way, it's worth noting in passing that expressions like "[1
   + 2 :: [3]]" can be a little confusing when you read them in a .v
   file.  The inner brackets, around 3, indicate a list, but the outer
   brackets, which are invisible in the HTML rendering, are there to
   instruct the "coqdoc" tool that the bracketed part should be
   displayed as Coq code rather than running text.)

   The second and third [Notation] declarations above introduce the
   standard square-bracket notation for lists; the right-hand side of
   the third one illustrates Coq's syntax for declaring n-ary
   notations and translating them to nested sequences of binary
   constructors. *)

(** *** Repeat *)
(** A number of functions are useful for manipulating lists.
    For example, the [repeat] function takes a number [n] and a
    [count] and returns a list of length [count] where every element
    is [n]. *)

Fixpoint repeat (n count : nat) : natlist :=
  match count with
  | O => nil
  | S count' => n :: (repeat n count')
  end.

(** *** Length *)
(** The [length] function calculates the length of a list. *)

Fixpoint length (l:natlist) : nat :=
  match l with
  | nil => O
  | h :: t => S (length t)
  end.

(** *** Append *)
(** The [app] ("append") function concatenates two lists. *)

Fixpoint app (l1 l2 : natlist) : natlist :=
  match l1 with
  | nil    => l2
  | h :: t => h :: (app t l2)
  end.

(** Actually, [app] will be used a lot in some parts of what
    follows, so it is convenient to have an infix operator for it. *)

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

Example test_app1:             [1;2;3] ++ [4;5] = [1;2;3;4;5].
Proof. reflexivity.  Qed.
Example test_app2:             nil ++ [4;5] = [4;5].
Proof. reflexivity.  Qed.
Example test_app3:             [1;2;3] ++ nil = [1;2;3].
Proof. reflexivity.  Qed.

(** Here are two smaller examples of programming with lists.
    The [hd] function returns the first element (the "head") of the
    list, while [tl] returns everything but the first
    element (the "tail").
    Of course, the empty list has no first element, so we
    must pass a default value to be returned in that case.  *)

(** *** Head (with default) and Tail *)
Definition hd (default:nat) (l:natlist) : nat :=
  match l with
  | nil => default
  | h :: t => h
  end.

Definition tl (l:natlist) : natlist :=
  match l with
  | nil => nil
  | h :: t => t
  end.

Example test_hd1:             hd 0 [1;2;3] = 1.
Proof. reflexivity.  Qed.
Example test_hd2:             hd 0 [] = 0.
Proof. reflexivity.  Qed.
Example test_tl:              tl [1;2;3] = [2;3].
Proof. reflexivity.  Qed.

(** **** Exercise: 2 stars (list_funs)  *)
(** Complete the definitions of [nonzeros], [oddmembers] and
    [countoddmembers] below. Have a look at the tests to understand
    what these functions should do. *)

Fixpoint nonzeros (l:natlist) : natlist :=
  match l with
  | nil => nil
  | 0 :: t => nonzeros t
  | n :: t => n :: nonzeros t
  end.

Example test_nonzeros:            nonzeros [0;1;0;2;3;0;0] = [1;2;3].
Proof.
  simpl nonzeros. reflexivity.
Qed.

Fixpoint oddmembers (l:natlist) : natlist :=
  match l with
  | nil => nil
  | n :: t => if oddb n then n :: oddmembers t else oddmembers t
  end.

Example test_oddmembers:            oddmembers [0;1;0;2;3;0;0] = [1;3].
Proof.
  simpl. reflexivity.
Qed.

Fixpoint countoddmembers (l:natlist) : nat :=
  match l with
  | nil => 0
  | n :: t => if oddb n then 1 + countoddmembers t else countoddmembers t
  end.

Example test_countoddmembers1:    countoddmembers [1;0;3;1;4;5] = 4.
Proof.
  simpl. reflexivity.
Qed.

Example test_countoddmembers2:    countoddmembers [0;2;4] = 0.
Proof.
  simpl. reflexivity.
Qed.

Example test_countoddmembers3:    countoddmembers nil = 0.
Proof.
  simpl. reflexivity.
Qed.
(** [] *)

(** **** Exercise: 3 stars, advanced (alternate)  *)
(** Complete the definition of [alternate], which "zips up" two lists
    into one, alternating between elements taken from the first list
    and elements from the second.  See the tests below for more
    specific examples.

    Note: one natural and elegant way of writing [alternate] will fail
    to satisfy Coq's requirement that all [Fixpoint] definitions be
    "obviously terminating."  If you find yourself in this rut, look
    for a slightly more verbose solution that considers elements of
    both lists at the same time.  (One possible solution requires
    defining a new kind of pairs, but this is not the only way.)  *)

Fixpoint alternate (l1 l2 : natlist) : natlist :=
  match l1, l2 with
    | nil, l => l
    | l, nil => l
    | h1 :: t1, h2 :: t2 => h1 :: h2 :: alternate t1 t2
  end.

Example test_alternate1:        alternate [1;2;3] [4;5;6] = [1;4;2;5;3;6].
Proof.
  simpl. reflexivity.
Qed.
Example test_alternate2:        alternate [1] [4;5;6] = [1;4;5;6].
Proof.
  simpl. reflexivity.
Qed.
Example test_alternate3:        alternate [1;2;3] [4] = [1;4;2;3].
Proof.
  simpl. reflexivity.
Qed.
Example test_alternate4:        alternate [] [20;30] = [20;30].
Proof.
  simpl. reflexivity.
Qed.
(** [] *)

(* ###################################################### *)
(** ** Bags via Lists *)

(** A [bag] (or [multiset]) is like a set, but each element can appear
    multiple times instead of just once.  One reasonable
    implementation of bags is to represent a bag of numbers as a
    list. *)

Definition bag := natlist.

(** **** Exercise: 3 stars (bag_functions)  *)
(** Complete the following definitions for the functions
    [count], [sum], [add], and [member] for bags. *)

Fixpoint count (v:nat) (s:bag) : nat :=
  match s with
  | nil => 0
  | x :: t => count v t + (if beq_nat x v then 1 else 0)
  end.

(** All these proofs can be done just by [reflexivity]. *)

Example test_count1:              count 1 [1;2;3;1;4;1] = 3.
Proof.
  simpl. reflexivity.
Qed.
Example test_count2:              count 6 [1;2;3;1;4;1] = 0.
Proof.
  simpl. reflexivity.
Qed.

(** Multiset [sum] is similar to set [union]: [sum a b] contains
    all the elements of [a] and of [b].  (Mathematicians usually
    define [union] on multisets a little bit differently, which
    is why we don't use that name for this operation.)
    For [sum] we're giving you a header that does not give explicit
    names to the arguments.  Moreover, it uses the keyword
    [Definition] instead of [Fixpoint], so even if you had names for
    the arguments, you wouldn't be able to process them recursively.
    The point of stating the question this way is to encourage you to
    think about whether [sum] can be implemented in another way --
    perhaps by using functions that have already been defined.  *)

Definition sum : bag -> bag -> bag := app.

Example test_sum1:              count 1 (sum [1;2;3] [1;4;1]) = 3.
Proof.
  simpl. reflexivity.
Qed.

Definition add (v:nat) (s:bag) : bag := v :: s.

Example test_add1:                count 1 (add 1 [1;4;1]) = 3.
Proof.
  simpl. reflexivity.
Qed.
Example test_add2:                count 5 (add 1 [1;4;1]) = 0.
Proof.
  simpl. reflexivity.
Qed.

Definition member (v:nat) (s:bag) : bool := ble_nat 1 (count v s).

Example test_member1:             member 1 [1;4;1] = true.
Proof.
  reflexivity.
Qed.
Example test_member2:             member 2 [1;4;1] = false.
Proof.
  reflexivity.
Qed.

(** **** Exercise: 3 stars, optional (bag_more_functions)  *)
(** Here are some more bag functions for you to practice with. *)

Fixpoint remove_one (v:nat) (s:bag) : bag :=
  match s with
  | nil => nil
  | x :: t => if beq_nat x v then t else x :: remove_one v t
  end.

Example test_remove_one1:         count 5 (remove_one 5 [2;1;5;4;1]) = 0.
Proof.
  reflexivity.
Qed.
Example test_remove_one2:         count 5 (remove_one 5 [2;1;4;1]) = 0.
Proof.
  reflexivity.
Qed.
Example test_remove_one3:         count 4 (remove_one 5 [2;1;4;5;1;4]) = 2.
Proof.
  reflexivity.
Qed.
Example test_remove_one4:         count 5 (remove_one 5 [2;1;5;4;5;1;4]) = 1.
Proof.
  reflexivity.
Qed.

Fixpoint remove_all (v:nat) (s:bag) : bag :=
  match s with
  | nil => nil
  | x :: t => if beq_nat x v then remove_all v t else x :: remove_all v t
  end.

Example test_remove_all1:          count 5 (remove_all 5 [2;1;5;4;1]) = 0.
Proof.
  reflexivity.
Qed.

Example test_remove_all2:          count 5 (remove_all 5 [2;1;4;1]) = 0.
Proof.
  reflexivity.
Qed.

Example test_remove_all3:          count 4 (remove_all 5 [2;1;4;5;1;4]) = 2.
Proof.
  reflexivity.
Qed.

Example test_remove_all4:          count 5 (remove_all 5 [2;1;5;4;5;1;4;5;1;4]) = 0.
Proof.
  simpl. reflexivity.
Qed.

Fixpoint subset (s1:bag) (s2:bag) : bool :=
  match s1, s2 with
  | nil, _ => true
  | _, nil => false
  | x :: t, s2 => if member x s2 then subset t (remove_all x s2) else false
  end.

Example test_subset1:              subset [1;2] [2;1;4;1] = true.
Proof.
  simpl. reflexivity.
Qed.

Example test_subset2:              subset [1;2;2] [2;1;4;1] = false.
Proof.
  simpl. reflexivity.
Qed.

(** [] *)

(** **** Exercise: 3 stars (bag_theorem)  *)
(** Write down an interesting theorem [bag_theorem] about bags involving
    the functions [count] and [add], and prove it.  Note that, since this
    problem is somewhat open-ended, it's possible that you may come up
    with a theorem which is true, but whose proof requires techniques
    you haven't learned yet.  Feel free to ask for help if you get
    stuck! *)
Theorem bag_count_add :
  forall v n bag, count v bag = n -> count v (add v bag) = S n.
Proof.
  intros v n bag.
  simpl. intros H.
  rewrite H.
  assert (forall m, beq_nat m m = true) as HH.
    induction m.
      reflexivity.
      simpl. rewrite IHm. reflexivity.
  rewrite HH. apply plus_comm.
Qed.

Theorem bag_count_add2 :
  forall v v' n bag, beq_nat v' v = false -> count v bag = n -> count v (add v' bag) = n.
Proof.
  intros v v' n bag.
  simpl. intros H0 H1.
  rewrite H1.
  rewrite H0.
  rewrite plus_0_r. reflexivity.
Qed.
(** [] *)

(* ###################################################### *)
(** * Reasoning About Lists *)

(** Just as with numbers, simple facts about list-processing
    functions can sometimes be proved entirely by simplification. For
    example, the simplification performed by [reflexivity] is enough
    for this theorem... *)

Theorem nil_app : forall l:natlist,
  [] ++ l = l.
Proof. reflexivity. Qed.

(** ... because the [[]] is substituted into the match position
    in the definition of [app], allowing the match itself to be
    simplified. *)

(** Also, as with numbers, it is sometimes helpful to perform case
    analysis on the possible shapes (empty or non-empty) of an unknown
    list. *)

Theorem tl_length_pred : forall l:natlist,
  pred (length l) = length (tl l).
Proof.
  intros l. destruct l as [| n l'].
  Case "l = nil".
    reflexivity.
  Case "l = cons n l'".
    reflexivity.  Qed.

(** Here, the [nil] case works because we've chosen to define
    [tl nil = nil]. Notice that the [as] annotation on the [destruct]
    tactic here introduces two names, [n] and [l'], corresponding to
    the fact that the [cons] constructor for lists takes two
    arguments (the head and tail of the list it is constructing). *)

(** Usually, though, interesting theorems about lists require
    induction for their proofs. *)

(* ###################################################### *)
(** ** Micro-Sermon *)

(** Simply reading example proof scripts will not get you very far!
    It is very important to work through the details of each one,
    using Coq and thinking about what each step achieves.  Otherwise
    it is more or less guaranteed that the exercises will make no
    sense... *)

(* ###################################################### *)
(** ** Induction on Lists *)

(** Proofs by induction over datatypes like [natlist] are
    perhaps a little less familiar than standard natural number
    induction, but the basic idea is equally simple.  Each [Inductive]
    declaration defines a set of data values that can be built up from
    the declared constructors: a boolean can be either [true] or
    [false]; a number can be either [O] or [S] applied to a number; a
    list can be either [nil] or [cons] applied to a number and a list.

    Moreover, applications of the declared constructors to one another
    are the _only_ possible shapes that elements of an inductively
    defined set can have, and this fact directly gives rise to a way
    of reasoning about inductively defined sets: a number is either
    [O] or else it is [S] applied to some _smaller_ number; a list is
    either [nil] or else it is [cons] applied to some number and some
    _smaller_ list; etc. So, if we have in mind some proposition [P]
    that mentions a list [l] and we want to argue that [P] holds for
    _all_ lists, we can reason as follows:

      - First, show that [P] is true of [l] when [l] is [nil].

      - Then show that [P] is true of [l] when [l] is [cons n l'] for
        some number [n] and some smaller list [l'], assuming that [P]
        is true for [l'].

    Since larger lists can only be built up from smaller ones,
    eventually reaching [nil], these two things together establish the
    truth of [P] for all lists [l].  Here's a concrete example: *)

Theorem app_assoc : forall l1 l2 l3 : natlist,
  (l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3).
Proof.
  intros l1 l2 l3. induction l1 as [| n l1'].
  Case "l1 = nil".
    reflexivity.
  Case "l1 = cons n l1'".
    simpl. rewrite -> IHl1'. reflexivity.  Qed.

(** Again, this Coq proof is not especially illuminating as a
    static written document -- it is easy to see what's going on if
    you are reading the proof in an interactive Coq session and you
    can see the current goal and context at each point, but this state
    is not visible in the written-down parts of the Coq proof.  So a
    natural-language proof -- one written for human readers -- will
    need to include more explicit signposts; in particular, it will
    help the reader stay oriented if we remind them exactly what the
    induction hypothesis is in the second case.  *)

(** *** Informal version *)

(** _Theorem_: For all lists [l1], [l2], and [l3],
   [(l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3)].

   _Proof_: By induction on [l1].

   - First, suppose [l1 = []].  We must show
       ([] ++ l2) ++ l3 = [] ++ (l2 ++ l3),
     which follows directly from the definition of [++].

   - Next, suppose [l1 = n::l1'], with
       (l1' ++ l2) ++ l3 = l1' ++ (l2 ++ l3)
     (the induction hypothesis). We must show
       ((n :: l1') ++ l2) ++ l3 = (n :: l1') ++ (l2 ++ l3).
]]
     By the definition of [++], this follows from
       n :: ((l1' ++ l2) ++ l3) = n :: (l1' ++ (l2 ++ l3)),
     which is immediate from the induction hypothesis.  []
*)

(** *** Another example *)
(**
  Here is a similar example to be worked together in class: *)

Theorem app_length : forall l1 l2 : natlist,
  length (l1 ++ l2) = (length l1) + (length l2).
Proof.
  (* WORKED IN CLASS *)
  intros l1 l2. induction l1 as [| n l1'].
  Case "l1 = nil".
    reflexivity.
  Case "l1 = cons".
    simpl. rewrite -> IHl1'. reflexivity.  Qed.

(** *** Reversing a list *)
(** For a slightly more involved example of an inductive proof
    over lists, suppose we define a "cons on the right" function
    [snoc] like this... *)

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

(** ... and use it to define a list-reversing function [rev]
    like this: *)

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

Example test_rev1:            rev [1;2;3] = [3;2;1].
Proof. reflexivity.  Qed.
Example test_rev2:            rev nil = nil.
Proof. reflexivity.  Qed.

(** *** Proofs about reverse *)
(** Now let's prove some more list theorems using our newly
    defined [snoc] and [rev].  For something a little more challenging
    than the inductive proofs we've seen so far, let's prove that
    reversing a list does not change its length.  Our first attempt at
    this proof gets stuck in the successor case... *)

Theorem rev_length_firsttry : forall l : natlist,
  length (rev l) = length l.
Proof.
  intros l. induction l as [| n l'].
  Case "l = []".
    reflexivity.
  Case "l = n :: l'".
    (* This is the tricky case.  Let's begin as usual
       by simplifying. *)
    simpl.
    (* Now we seem to be stuck: the goal is an equality
       involving [snoc], but we don't have any equations
       in either the immediate context or the global
       environment that have anything to do with [snoc]!

       We can make a little progress by using the IH to
       rewrite the goal... *)
    rewrite <- IHl'.
    (* ... but now we can't go any further. *)
Abort.

(** So let's take the equation about [snoc] that would have
    enabled us to make progress and prove it as a separate lemma.
*)

Theorem length_snoc : forall n : nat, forall l : natlist,
  length (snoc l n) = S (length l).
Proof.
  intros n l. induction l as [| n' l'].
  Case "l = nil".
    reflexivity.
  Case "l = cons n' l'".
    simpl. rewrite -> IHl'. reflexivity.  Qed.

(**
    Note that we make the lemma as _general_ as possible: in particular,
    we quantify over _all_ [natlist]s, not just those that result
    from an application of [rev]. This should seem natural,
    because the truth of the goal clearly doesn't depend on
    the list having been reversed.  Moreover, it is much easier
    to prove the more general property.
*)

(** Now we can complete the original proof. *)

Theorem rev_length : forall l : natlist,
  length (rev l) = length l.
Proof.
  intros l. induction l as [| n l'].
  Case "l = nil".
    reflexivity.
  Case "l = cons".
    simpl. rewrite -> length_snoc.
    rewrite -> IHl'. reflexivity.  Qed.

(** For comparison, here are informal proofs of these two theorems:

    _Theorem_: For all numbers [n] and lists [l],
       [length (snoc l n) = S (length l)].

    _Proof_: By induction on [l].

    - First, suppose [l = []].  We must show
        length (snoc [] n) = S (length []),
      which follows directly from the definitions of
      [length] and [snoc].

    - Next, suppose [l = n'::l'], with
        length (snoc l' n) = S (length l').
      We must show
        length (snoc (n' :: l') n) = S (length (n' :: l')).
      By the definitions of [length] and [snoc], this
      follows from
        S (length (snoc l' n)) = S (S (length l')),
]]
      which is immediate from the induction hypothesis. [] *)

(** _Theorem_: For all lists [l], [length (rev l) = length l].

    _Proof_: By induction on [l].

      - First, suppose [l = []].  We must show
          length (rev []) = length [],
        which follows directly from the definitions of [length]
        and [rev].

      - Next, suppose [l = n::l'], with
          length (rev l') = length l'.
        We must show
          length (rev (n :: l')) = length (n :: l').
        By the definition of [rev], this follows from
          length (snoc (rev l') n) = S (length l')
        which, by the previous lemma, is the same as
          S (length (rev l')) = S (length l').
        This is immediate from the induction hypothesis. [] *)

(** Obviously, the style of these proofs is rather longwinded
    and pedantic.  After the first few, we might find it easier to
    follow proofs that give fewer details (since we can easily work
    them out in our own minds or on scratch paper if necessary) and
    just highlight the non-obvious steps.  In this more compressed
    style, the above proof might look more like this: *)

(** _Theorem_:
     For all lists [l], [length (rev l) = length l].

    _Proof_: First, observe that
       length (snoc l n) = S (length l)
     for any [l].  This follows by a straightforward induction on [l].
     The main property now follows by another straightforward
     induction on [l], using the observation together with the
     induction hypothesis in the case where [l = n'::l']. [] *)

(** Which style is preferable in a given situation depends on
    the sophistication of the expected audience and on how similar the
    proof at hand is to ones that the audience will already be
    familiar with.  The more pedantic style is a good default for
    present purposes. *)

(* ###################################################### *)
(** ** [SearchAbout] *)

(** We've seen that proofs can make use of other theorems we've
    already proved, using [rewrite], and later we will see other ways
    of reusing previous theorems.  But in order to refer to a theorem,
    we need to know its name, and remembering the names of all the
    theorems we might ever want to use can become quite difficult!  It
    is often hard even to remember what theorems have been proven,
    much less what they are named.

    Coq's [SearchAbout] command is quite helpful with this.  Typing
    [SearchAbout foo] will cause Coq to display a list of all theorems
    involving [foo].  For example, try uncommenting the following to
    see a list of theorems that we have proved about [rev]: *)

(*  SearchAbout rev. *)

(** Keep [SearchAbout] in mind as you do the following exercises and
    throughout the rest of the course; it can save you a lot of time! *)

(** Also, if you are using ProofGeneral, you can run [SearchAbout]
    with [C-c C-a C-a]. Pasting its response into your buffer can be
    accomplished with [C-c C-;]. *)

(* ###################################################### *)
(** ** List Exercises, Part 1 *)

(** **** Exercise: 3 stars (list_exercises)  *)
(** More practice with lists. *)

Theorem app_nil_end : forall l : natlist,
  l ++ [] = l.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem rev_involutive : forall l : natlist,
  rev (rev l) = l.
Proof.
  (* FILL IN HERE *) Admitted.

(** There is a short solution to the next exercise.  If you find
    yourself getting tangled up, step back and try to look for a
    simpler way. *)

Theorem app_assoc4 : forall l1 l2 l3 l4 : natlist,
  l1 ++ (l2 ++ (l3 ++ l4)) = ((l1 ++ l2) ++ l3) ++ l4.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem snoc_append : forall (l:natlist) (n:nat),
  snoc l n = l ++ [n].
Proof.
  (* FILL IN HERE *) Admitted.

Theorem distr_rev : forall l1 l2 : natlist,
  rev (l1 ++ l2) = (rev l2) ++ (rev l1).
Proof.
  (* FILL IN HERE *) Admitted.

(** An exercise about your implementation of [nonzeros]: *)

Lemma nonzeros_app : forall l1 l2 : natlist,
  nonzeros (l1 ++ l2) = (nonzeros l1) ++ (nonzeros l2).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars (beq_natlist)  *)
(** Fill in the definition of [beq_natlist], which compares
    lists of numbers for equality.  Prove that [beq_natlist l l]
    yields [true] for every list [l]. *)

Fixpoint beq_natlist (l1 l2 : natlist) : bool :=
  (* FILL IN HERE *) admit.

Example test_beq_natlist1 :   (beq_natlist nil nil = true).
 (* FILL IN HERE *) Admitted.
Example test_beq_natlist2 :   beq_natlist [1;2;3] [1;2;3] = true.
 (* FILL IN HERE *) Admitted.
Example test_beq_natlist3 :   beq_natlist [1;2;3] [1;2;4] = false.
 (* FILL IN HERE *) Admitted.

Theorem beq_natlist_refl : forall l:natlist,
  true = beq_natlist l l.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ###################################################### *)
(** ** List Exercises, Part 2 *)

(** **** Exercise: 2 stars (list_design)  *)
(** Design exercise:
     - Write down a non-trivial theorem [cons_snoc_app]
       involving [cons] ([::]), [snoc], and [app] ([++]).
     - Prove it. *)

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

(** **** Exercise: 3 stars, advanced (bag_proofs)  *)
(** Here are a couple of little theorems to prove about your
    definitions about bags earlier in the file. *)

Theorem count_member_nonzero : forall (s : bag),
  ble_nat 1 (count 1 (1 :: s)) = true.
Proof.
  (* FILL IN HERE *) Admitted.

(** The following lemma about [ble_nat] might help you in the next proof. *)

Theorem ble_n_Sn : forall n,
  ble_nat n (S n) = true.
Proof.
  intros n. induction n as [| n'].
  Case "0".
    simpl.  reflexivity.
  Case "S n'".
    simpl.  rewrite IHn'.  reflexivity.  Qed.

Theorem remove_decreases_count: forall (s : bag),
  ble_nat (count 0 (remove_one 0 s)) (count 0 s) = true.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars, optional (bag_count_sum)  *)
(** Write down an interesting theorem [bag_count_sum] about bags
    involving the functions [count] and [sum], and prove it.*)

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

(** **** Exercise: 4 stars, advanced (rev_injective)  *)
(** Prove that the [rev] function is injective, that is,

    forall (l1 l2 : natlist), rev l1 = rev l2 -> l1 = l2.

There is a hard way and an easy way to solve this exercise.
*)

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

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

(** One use of [natoption] is as a way of returning "error
    codes" from functions.  For example, suppose we want to write a
    function that returns the [n]th element of some list.  If we give
    it type [nat -> natlist -> nat], then we'll have to return some
    number when the list is too short! *)

Fixpoint index_bad (n:nat) (l:natlist) : nat :=
  match l with
  | nil => 42  (* arbitrary! *)
  | a :: l' => match beq_nat n O with
               | true => a
               | false => index_bad (pred n) l'
               end
  end.

(** *** *)
(** On the other hand, if we give it type [nat -> natlist ->
    natoption], then we can return [None] when the list is too short
    and [Some a] when the list has enough members and [a] appears at
    position [n]. *)

Inductive natoption : Type :=
  | Some : nat -> natoption
  | None : natoption.

Fixpoint index (n:nat) (l:natlist) : natoption :=
  match l with
  | nil => None
  | a :: l' => match beq_nat n O with
               | true => Some a
               | false => index (pred n) l'
               end
  end.

Example test_index1 :    index 0 [4;5;6;7]  = Some 4.
Proof. reflexivity.  Qed.
Example test_index2 :    index 3 [4;5;6;7]  = Some 7.
Proof. reflexivity.  Qed.
Example test_index3 :    index 10 [4;5;6;7] = None.
Proof. reflexivity.  Qed.

(** This example is also an opportunity to introduce one more
    small feature of Coq's programming language: conditional
    expressions... *)

(** *** *)

Fixpoint index' (n:nat) (l:natlist) : natoption :=
  match l with
  | nil => None
  | a :: l' => if beq_nat n O then Some a else index' (pred n) l'
  end.

(** Coq's conditionals are exactly like those found in any other
    language, with one small generalization.  Since the boolean type
    is not built in, Coq actually allows conditional expressions over
    _any_ inductively defined type with exactly two constructors.  The
    guard is considered true if it evaluates to the first constructor
    in the [Inductive] definition and false if it evaluates to the
    second. *)

(** The function below pulls the [nat] out of a [natoption], returning
    a supplied default in the [None] case. *)

Definition option_elim (d : nat) (o : natoption) : nat :=
  match o with
  | Some n' => n'
  | None => d
  end.

(** **** Exercise: 2 stars (hd_opt)  *)
(** Using the same idea, fix the [hd] function from earlier so we don't
   have to pass a default element for the [nil] case.  *)

Definition hd_opt (l : natlist) : natoption :=
  (* FILL IN HERE *) admit.

Example test_hd_opt1 : hd_opt [] = None.
 (* FILL IN HERE *) Admitted.

Example test_hd_opt2 : hd_opt [1] = Some 1.
 (* FILL IN HERE *) Admitted.

Example test_hd_opt3 : hd_opt [5;6] = Some 5.
 (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 1 star, optional (option_elim_hd)  *)
(** This exercise relates your new [hd_opt] to the old [hd]. *)

Theorem option_elim_hd : forall (l:natlist) (default:nat),
  hd default l = option_elim default (hd_opt l).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

(** As a final illustration of how fundamental data structures
    can be defined in Coq, here is the declaration of a simple
    [dictionary] data type, using numbers for both the keys and the
    values stored under these keys.  (That is, a dictionary represents
    a finite map from numbers to numbers.) *)

Module Dictionary.

Inductive dictionary : Type :=
  | empty  : dictionary
  | record : nat -> nat -> dictionary -> dictionary.

(** This declaration can be read: "There are two ways to construct a
    [dictionary]: either using the constructor [empty] to represent an
    empty dictionary, or by applying the constructor [record] to
    a key, a value, and an existing [dictionary] to construct a
    [dictionary] with an additional key to value mapping." *)

Definition insert (key value : nat) (d : dictionary) : dictionary :=
  (record key value d).

(** Here is a function [find] that searches a [dictionary] for a
    given key.  It evaluates evaluates to [None] if the key was not
    found and [Some val] if the key was mapped to [val] in the
    dictionary. If the same key is mapped to multiple values, [find]
    will return the first one it finds. *)

Fixpoint find (key : nat) (d : dictionary) : natoption :=
  match d with
  | empty         => None
  | record k v d' => if (beq_nat key k)
                       then (Some v)
                       else (find key d')
  end.

(** **** Exercise: 1 star (dictionary_invariant1)  *)
(** Complete the following proof. *)

Theorem dictionary_invariant1' : forall (d : dictionary) (k v: nat),
  (find k (insert k v d)) = Some v.
Proof.
 (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 1 star (dictionary_invariant2)  *)
(** Complete the following proof. *)

Theorem dictionary_invariant2' : forall (d : dictionary) (m n o: nat),
  beq_nat m n = false -> find m d = find m (insert n o d).
Proof.
 (* FILL IN HERE *) Admitted.
(** [] *)

End Dictionary.

End NatList.

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


Inductive bool : Type :=
| true : bool
| false : bool.

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

Definition andb (b1:bool) (b2:bool) : bool :=
  match b1 with
    | true => b2
    | false => false
  end.

Definition orb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => true
  | false => b2
  end.

Example test_orb1: (orb true false) = true.
Proof. simpl. reflexivity. Qed.
Example test_orb2: (orb false false) = false.
Proof. simpl. reflexivity. Qed.
Example test_orb3: (orb false true) = true.
Proof. simpl. reflexivity. Qed.
Example test_orb4: (orb true true) = true.
Proof. simpl. reflexivity. Qed.

Infix "&&" := andb.
Infix "||" := orb.

Example test_Orb5: false || false || true = true.
Proof. simpl. reflexivity. Qed.

Definition nandb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => match b2 with
            | true => false
            | false => true
            end

  | false => match b2 with
             | true => true
             | false => true
             end
  end.

Example test_nandb1: (nandb true false) = true.
Proof. simpl. reflexivity. Qed.
Example test_nandb2: (nandb false false) = true.
Proof. simpl. reflexivity. Qed.
Example test_nandb3: (nandb false true) = true.
Proof. simpl. reflexivity. Qed.
Example test_nandb4: (nandb true true) = false.
Proof. simpl. reflexivity. Qed.

Check negb.

Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool :=
  match b1 with
  | true => match b2 with
            | true => match b3 with
                      | true => true
                      | false => false
                      end
            | false => false
            end
  | false => false

  end.

Example test_andb31: (andb3 true true true) = true.
Proof. simpl. reflexivity. Qed.
Example test_andb32: (andb3 false true true) = false.
Proof. simpl. reflexivity. Qed.
Example test_andb33: (andb3 true false true) = false.
Proof. simpl. reflexivity. Qed.
Example test_andb34: (andb3 true true false) = false.
Proof. simpl. reflexivity. Qed.

Check test_andb34.

Module Factorial.

Fixpoint factorial (n:nat) : nat :=
  match n with
    | O => 1
    | S i => (S i) * factorial ((S i) - 1)
end.

Example test_factorial1: (factorial 3) = 6.
Proof. simpl. reflexivity. Qed.
Example test_factorial2: (factorial 5) = (mult 10 12).
Proof. simpl. reflexivity. Qed.

Notation "x + y" := (plus x y)
                      (at level 50, left associativity)
                      : nat_scope.

Check (0 + 3).

End Factorial.

Module blt_nat.

Fixpoint beq_nat (n m : nat) : bool :=
  match n with
  | O => match m with
             | O => true
             | S i' => false
              end
  | S n' => match m with
            | O => false
            | S m' => beq_nat n' m'
            end
  end.

Fixpoint leb (n m : nat) : bool :=
  match n with
  | O => true
  | S n' =>
      match m with
      | 0 => false
      | S m' => leb n' m'
      end
  end.

Definition blt_nat (n m : nat) : bool :=
  match beq_nat n m with
  | true => false
  | false => leb n m
end.

Example test_blt_nat1: (blt_nat 2 2) = false.
Proof. simpl. reflexivity. Qed.
Example test_blt_nat2: (blt_nat 2 4) = true.
Proof. simpl. reflexivity. Qed.
Example test_blt_nat3: (blt_nat 4 2) = false.
Proof. simpl. reflexivity. Qed.

End blt_nat.

Theorem plus_0_l : forall n : nat, 0 + n = n.
Proof.
  intros n. reflexivity. Qed.

Theorem plus_1_l : forall n : nat, 1 + n = S n.
Proof.
  intros n. reflexivity. Qed.

Theorem mult_0_l : forall n : nat, 0 * n = 0.
Proof.
  intros n. reflexivity. Qed.

(* Theorem plus id example : forall (n m:nat), *)
(* n = m → *)
(* n + n = m + m. *)

Theorem plus_id_example : forall n m : nat,
    n = m -> n + n = m + m.
Proof.
  intros n m.
  intros H.
  rewrite <- H.
  reflexivity.
Qed.

Theorem plus_id_exercise : forall n m o : nat,
n = m -> m = o -> n + m = m + o.
Proof.
  intros n m o.
  intros hnm hmo.
  rewrite hnm.
  rewrite <- hmo.
  reflexivity.
Qed.

(* Theorem mult 0 plus : ∀ n m : nat, *)
(* (0 + n) × m = n × m. *)
(* Proof. *)
(* intros n m. *)
(* rewrite → plus O n. *)
(* reflexivity. Qed. *)

Theorem mult_0_plus : forall n m : nat,
    (0 + n) * m = n * m.
  Proof.
    intros n m.
    rewrite plus_O_n.
    reflexivity.
  Qed.

Theorem mult_S_1 : forall n m : nat,
    m = S n ->
    m * (1 + n) = m * m.
Proof.
  intros n m.
  intros hmsn.
  rewrite plus_1_l.
  rewrite hmsn.
  reflexivity.
Qed.

Fixpoint beq_nat (n m : nat) : bool :=
  match n with
  | O => match m with
             | O => true
             | S i' => false
              end
  | S n' => match m with
            | O => false
            | S m' => beq_nat n' m'
            end
end.

Theorem beq_nat_refl : forall n : nat,
  true = beq_nat n n.
  Proof.
    intro n.
    induction n.
    reflexivity.
    simpl.
    rewrite <- IHn.
    reflexivity.
Qed.

Module caseanyl.
(* Theorem plus 1 neq 0 : ∀ n : nat, *)
(* beq nat (n + 1) 0 = false. *)
(* Proof. *)

Theorem plus_1_neq_0 : forall n : nat,
    beq_nat (n + 1) 0 = false.
Proof.
  intros n.
  destruct n as [| n'].
  - reflexivity.
  - reflexivity.
  Qed.

(* Theorem negb involutive : ∀ b : bool, *)
(* negb (negb b) = b. *)
(* Proof. *)

Theorem negb_involutive : forall b : bool,
    negb (negb b) = b.
Proof.
  intros b. destruct b.
  - reflexivity.
  - reflexivity.
Qed.

Theorem plus_1_neq_0' : forall n : nat,
    beq_nat (n + 1) 0 = false.
Proof.
  intros [|n'].
  - reflexivity.
  - reflexivity.
Qed.

(* Attempt #1 *)
Theorem andb_true_elim2 : forall b c : bool,
    andb b c = true -> c = true.
Proof.
  intros b c.
  intros hbct.
  destruct b as [|].
  - destruct c as [|].
    + reflexivity.
    + simpl andb in hbct. rewrite hbct. reflexivity.
  - destruct c as [|].
    + reflexivity.
    + simpl andb in hbct. rewrite hbct. reflexivity.
Qed.

(* Attemp #2 To Make it cleaner, not sure if it really is cleaner afterall. *)
Theorem andb_true_elim2' : forall b c : bool,
    andb b c = true -> c = true.
Proof.
  intros b c.
  intros hbct.
  destruct b as [|]. destruct c as [|].
  - reflexivity.
  - simpl andb in hbct. rewrite hbct. reflexivity.
  - destruct c as [|].
    + reflexivity.
    + simpl andb in hbct. rewrite hbct. reflexivity.
Qed.
(* Theorem zero nbeq plus 1 : ∀ n : nat, *)
(* beq nat 0 (n + 1) = false. *)

Theorem zero_nbeq_plus_1 : forall n : nat,
    beq_nat 0 (n + 1) = false.
Proof.
  intros [|n'].
  - simpl. reflexivity.
  - simpl. reflexivity.
Qed.

End caseanyl.

Theorem indentity_fn_aplied_twice :
  forall (f : bool -> bool),
  (forall (x : bool), f x = x ) ->
  forall (b : bool), f (f b) = b.
Proof.
  intros f hfx b.
  rewrite hfx. rewrite hfx.
  reflexivity.
Qed.

Theorem negation_fn_aplied_twice :
  forall (f : bool -> bool),
  (forall (x : bool), f x = negb x ) ->
  forall (b : bool), f (f b) = b.
Proof.
  intros f hnx b.
  rewrite hnx. rewrite hnx.
  destruct b as [|].
  - simpl. reflexivity.
  -  simpl. reflexivity.
Qed.

Theorem andb_eq_orb :
  forall (b c : bool),
  (andb b c = orb b c) ->
  b = c.
Proof.
  intros b c.
  destruct b as [|]. destruct c as [|].
  - simpl. reflexivity.
  - simpl. intros hft. rewrite hft. reflexivity.
  - simpl. intros hfc. rewrite hfc. reflexivity.
Qed.

(* Need to think about how to implement this properly. *)
Inductive bin : Type :=
| Zip : bin
| Dos : bin -> bin
| SDos : bin -> bin.

Fixpoint incr (n : bin) : bin :=
  match n with
  | Zip => SDos Zip
  | Dos i => SDos i
  | SDos i => Dos (incr i)
end.

Fixpoint bin_to_nat (n : bin) : nat :=
  match n with
  | Zip => 0
  | Dos i => 2 * (bin_to_nat i)
  | SDos i => 2 * (bin_to_nat i) + 1
end.

Definition test_bin_incr_1 : bin_to_nat Zip = 0.
Proof. simpl. reflexivity. Qed.

Definition test_bin_incr_2 : bin_to_nat (incr Zip) = 1.
Proof. simpl. reflexivity. Qed.

Definition test_bin_incr_3 : bin_to_nat (incr (incr Zip)) = 2.
Proof. simpl. reflexivity. Qed.

Definition test_bin_incr_4 : bin_to_nat (incr (incr Zip)) = S ( S (bin_to_nat Zip)).
Proof. simpl. reflexivity. Qed.

Definition test_bin_incr_5 : bin_to_nat (incr (incr (incr ( SDos Zip)))) = 4.
Proof. simpl. reflexivity. Qed.


Require Export DMFP.Day13_induction.

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

(** Another important logical connective is _existential
    quantification_.  To say that there is some [x] of type [T] such
    that some property [P] holds of [x], we write [exists x : T,
    P]. As with [forall], the type annotation [: T] can be omitted if
    Coq is able to infer from the context what the type of [x] should
    be.

    The notion of "existential" is a common one in mathematics, but
    you may not be familiar with its precise meaning. It might be
    easier to understand [exists] as the "dual" of [forall]. When we
    say [forall x : T, P], we mean to say that:

    - Given any possible value [v] of type [T],

    - the proposition [P] holds when we replace [x] with [v].

    So, for example, when we say [forall n : nat, n + 0 = n], we mean
    that we [0 + 0 = 0] (choosen [0] for [n]) and [1 + 0 = 1]
    (choosing [1] for [n]) and [47 + 0 = 47] (choosing [47] for [n]).
    When we say that [exists x : T, P], we mean that

    - There is at least one value [v] of type [T], such that

    - the proposition [P] holds when we replace [x] with [v].

    For example, [exists n : nat, S n = 48] means "there is (at least
    one) natural number [n] such that the successor of [n] is 48". It
    turns out that this [S n = 48] for exactly _one_ [n]: 47. But it
    need not be so: the proposition [exists l : list nat, length l =
    1] means that "there exists a list of naturals [l] such that
    [length l] is 1". There are many such lists: [ [1] ], [ [1337] ],
    and so on.

 *)

(** PROP ::= EXPR1 = EXPR2
           | forall x : TYPE, PROP
           | PROP1 -> PROP2
           | PROP1 /\ PROP2
           | PROP1 \/ PROP2
           | True
           | ~ PROP
           | False
           | PROP1 <-> PROP2
           | exists x : TYPE, PROP     <---- NEW!
 *)

(** To prove a statement of the form [exists x, P], we must show that
    [P] holds for some specific choice of value for [x], known as the
    _witness_ of the existential.  This is done in two steps: First,
    we explicitly tell Coq which witness [t] we have in mind by
    invoking the tactic [exists t].  Then we prove that [P] holds after
    all occurrences of [x] are replaced by [t]. *)

Lemma four_is_even : exists n : nat, 4 = n + n.
Proof.
  (* We want to show 4 is even, so we need to find a number [n] such
     that [n + n = 4].  If we try 2 we have [2 + 2 = 4], which seems
     to work. *)
  exists 2. reflexivity.
Qed.

(** Conversely, if we have an existential hypothesis [exists x, P] in
    the context, we can destruct it to obtain a witness [x] and a
    hypothesis stating that [P] holds of [x]. *)

Theorem exists_example_2 : forall n,
  (exists m, n = 4 + m) ->
  (exists o, n = 2 + o).
Proof.
  (* WORKED IN CLASS *)
  intros n [m Hm]. (* note implicit [destruct] here *)
  exists (2 + m).
  apply Hm.  Qed.

(** **** Exercise: 1 star, standard, especially useful (dist_not_exists)

    Prove that "[P] holds for all [x]" implies "there is no [x] for
    which [P] does not hold."  (Hint: [destruct H as [x E]] works on
    existential assumptions!)  *)

Theorem dist_not_exists : forall (X:Type) (P : X -> Prop),
  (forall x, P x) -> ~ (exists x, ~ P x).
Proof.
  intros X P H [x Hx].
  apply Hx. apply H.
Qed.
(** [] *)

(** **** Exercise: 1 star, standard, especially useful (dist_not_forall)

    Prove that "there exists an [x] for which [P] holds" implies "it
    is not the case that for all [x] [P] does not hold."  (Hint:
    [destruct H as [x E]] works on existential assumptions!)  *)
Theorem dist_not_forall : forall (X:Type) (P : X -> Prop),
    (exists x, P x) -> ~ (forall x, ~ P x).
Proof.
  unfold not.
  intros X P [x Hx].
  intros H. assert ( Hx' : P x -> False).
  -apply H.
  -apply Hx'.  apply Hx.
Qed.
(** [] *)

(** **** Exercise: 2 stars, standard, optional (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.
   (* FILL IN HERE *) Admitted.
(** [] *)

(* ################################################################# *)
(** * Propositions and Booleans *)

(** We've seen two different ways of encoding logical facts in Coq:
    with _booleans_ (of type [bool]), and with _propositions_ (of type
    [Prop]).

    For instance, to claim that a number [n] is even, we can say
    either
       - (1) that [evenb n] returns [true], or
       - (2) that there exists some [k] such that [n = double k].

    Indeed, these two notions of evenness are equivalent, as
    can easily be shown with a couple of auxiliary lemmas.

    Of course, it would be very strange if these two characterizations
    of evenness did not describe the same set of natural numbers!
    Fortunately, we can prove that they do... *)

(** We first need three helper lemmas. *)
(** **** Exercise: 2 stars, standard, optional (evenb_S)

    One inconvenient aspect of our definition of [evenb n] is the
    recursive call on [n - 2]. This makes proofs about [evenb n]
    harder when done by induction on [n], since we may need an
    induction hypothesis about [n - 2]. The following lemma gives an
    alternative characterization of [evenb (S n)] that works better
    with induction: *)

Theorem evenb_S : forall n : nat,
  evenb (S n) = negb (evenb n).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

(** **** Exercise: 3 stars, standard (evenb_double_conv) *)
Theorem evenb_double_conv : forall n,
  exists k, n = if evenb n then double k
                else S (double k).
Proof.
  intros n. induction n as [| n' Hn'].
  -exists 0.  simpl. reflexivity.
  -destruct Hn'. rewrite evenb_S. destruct evenb.
   +simpl. exists x. rewrite H. reflexivity.
   +simpl. exists (S x). simpl. rewrite H. reflexivity.
Qed.
(** [] *)

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.

(** In view of this theorem, we say that the boolean
    computation [evenb n] _reflects_ the logical proposition
    [exists k, n = double k]. *)

(** However, even when the boolean and propositional formulations of a
    claim are equivalent from a purely logical perspective, they need
    not be equivalent _operationally_.

    Equality provides an extreme example: knowing that [eqb n m =
    true] is generally of little direct help in the middle of a proof
    involving [n] and [m]; however, if we convert the statement to the
    equivalent form [n = m], we can rewrite with it. *)

(** The case of even numbers is also interesting.  Recall that,
    when proving the backwards direction of [even_bool_prop] (i.e.,
    [evenb_double], going from the propositional to the boolean
    claim), we used a simple induction on [k].  On the other hand, the
    converse (the [evenb_double_conv] exercise) required a clever
    generalization, since we can't directly prove [(exists k, n =
    double k) -> evenb n = true]. *)

(** For these examples, the propositional claims are more useful than
    their boolean counterparts, but this is not always the case.  For
    instance, we cannot test whether a general proposition is true or
    not in a function definition; as a consequence, the following code
    fragment is rejected: *)

Fail Definition is_even_prime n :=
  if n = 2 then true
  else false.

(** Coq complains that [n = 2] has type [Prop], while it expects
    an elements of [bool] (or some other inductive type with two
    elements).  The reason for this error message has to do with the
    _computational_ nature of Coq's core language, which is designed
    so that every function that it can express is computable and
    total.  One reason for this is to allow the extraction of
    executable programs from Coq developments.  As a consequence,
    [Prop] in Coq does _not_ have a universal case analysis operation
    telling whether any given proposition is true or false, since such
    an operation would allow us to write non-computable functions.

    Although general non-computable properties cannot be phrased as
    boolean computations, it is worth noting that even many
    _computable_ properties are easier to express using [Prop] than
    [bool], since recursive function definitions are subject to
    significant restrictions in Coq.  For instance, later we'll shows
    how to define the property that two lists are permutations of each
    a given string using [Prop].  Doing the same with [bool] would
    amount to the [is_permutation_of] function we wrote on day
    6... which (as we'll see) is more complicated, harder to
    understand, and harder to reason about than the [Prop] we'll
    define.

    Conversely, an important side benefit of stating facts using
    booleans is enabling some proof automation through computation
    with Coq terms, a technique known as _proof by reflection_.
    Consider the following statement: *)

Example even_1000 : exists k, 1000 = double k.

(** The most direct proof of this fact is to give the value of [k]
    explicitly. *)

Proof. exists 500. reflexivity. Qed.

(** On the other hand, the proof of the corresponding boolean
    statement is even simpler: *)

Example even_1000' : evenb 1000 = true.
Proof. reflexivity. Qed.

(** What is interesting is that, since the two notions are equivalent,
    we can use the boolean formulation to prove the other one without
    mentioning the value 500 explicitly: *)

Example even_1000'' : exists k, 1000 = double k.
Proof. apply even_bool_prop. reflexivity. Qed.

(** Although we haven't gained much in terms of proof size in
    this case, larger proofs can often be made considerably simpler by
    the use of reflection.  As an extreme example, the Coq proof of
    the famous _4-color theorem_ uses reflection to reduce the
    analysis of hundreds of different cases to a boolean computation.
    We won't cover reflection in any real detail, but it serves as a
    good example showing the complementary strengths of booleans and
    general propositions. *)

(** As we go on to prove more interesting (and challenging!) things
    about our programs, the various iff lemmas relating computation to
    logic will surely come in handy. *)

(* ================================================================= *)
(** ** Classical vs. Constructive Logic *)

(** We have seen that it is not possible to test whether or not a
    proposition [P] holds while defining a Coq function.  You may be
    surprised to learn that a similar restriction applies to _proofs_!
    In other words, the following intuitive reasoning principle is not
    derivable in Coq: *)

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

(** To understand operationally why this is the case, recall
  that, to prove a statement of the form [P \/ Q], we use the [left]
  and [right] tactics, which effectively require knowing which side
  of the disjunction holds.  But the universally quantified [P] in
  [excluded_middle] is an _arbitrary_ proposition, which we know
  nothing about.  We don't have enough information to choose which
  of [left] or [right] to apply, just as Coq doesn't have enough
  information to mechanically decide whether [P] holds or not inside
  a function. *)

(** However, if we happen to know that [P] is reflected in some
  boolean term [b], then knowing whether it holds or not is trivial:
  we just have to check the value of [b]. *)

Theorem restricted_excluded_middle : forall P b,
  (P <-> b = true) -> P \/ ~ P.
Proof.
  (* Let a proposition P and boolean b be given.
     Assume that P holds if and only if [b = true].
     We must show [P \/ ~ P].
   *)
  intros P [] H.
  (* We go by cases on [b].

     If b is true, by our assumption we know P holds, so we have [P].

     Otherwise, we likewise know by our assumption that P does not
     hold, so we have [~P].  *)
  - left. rewrite H. reflexivity.
  - right. rewrite H. intros contra. discriminate contra.
Qed.

(** In particular, the excluded middle is valid for equations [n = m],
  between natural numbers [n] and [m]. *)

Theorem restricted_excluded_middle_eq : forall (n m : nat),
    (forall n m, n = m <-> eqb n m = true) -> (* we'll prove this on day 15 *)
    n = m \/ n <> m.
Proof.
  intros n m eqb_true_iff.
  apply (restricted_excluded_middle (n = m) (eqb n m)).
  apply eqb_true_iff.
Qed.

(** It may seem strange that the general excluded middle is not
  available by default in Coq; after all, any given claim must be
  either true or false.  Nonetheless, there is an advantage in not
  assuming the excluded middle: statements in Coq can make stronger
  claims than the analogous statements in standard mathematics.
  Notably, if there is a Coq proof of [exists x, P x], it is
  possible to explicitly exhibit a value of [x] for which we can
  prove [P x] -- in other words, every proof of existence is
  necessarily _constructive_. *)

(** Logics like Coq's, which do not assume the excluded middle, are
  referred to as _constructive logics_.

  More conventional logical systems such as ZFC, in which the
  excluded middle does hold for arbitrary propositions, are referred
  to as _classical_. *)

(** The following example illustrates why assuming the excluded middle
  may lead to non-constructive proofs:

  _Claim_: There exist irrational numbers [a] and [b] such that [a ^
  b] is rational.

  _Proof_: It is not difficult to show that [sqrt 2] is irrational.
  If [sqrt 2 ^ sqrt 2] is rational, it suffices to take [a = b =
  sqrt 2] and we are done.  Otherwise, [sqrt 2 ^ sqrt 2] is
  irrational.  In this case, we can take [a = sqrt 2 ^ sqrt 2] and
  [b = sqrt 2], since [a ^ b = sqrt 2 ^ (sqrt 2 * sqrt 2) = sqrt 2 ^
  2 = 2].  []

  Do you see what happened here?  We used the excluded middle to
  consider separately the cases where [sqrt 2 ^ sqrt 2] is rational
  and where it is not, without knowing which one actually holds!
  Because of that, we wind up knowing that such [a] and [b] exist but
  we cannot determine what their actual values are (at least, using
  this line of argument).

  As useful as constructive logic is, it does have its limitations:
  There are many statements that can easily be proven in classical
  logic but that have much more complicated constructive proofs, and
  there are some that are known to have no constructive proof at all!
  Fortunately, the excluded middle is known to be compatible with
  Coq's logic, allowing us to add it safely as an axiom.  However, we
  will not need to do so in this book: the results that we cover can
  be developed entirely within constructive logic at negligible extra
  cost.

  It takes some practice to understand which proof techniques must be
  avoided in constructive reasoning, but arguments by contradiction,
  in particular, are infamous for leading to non-constructive proofs.
  Here's a typical example: suppose that we want to show that there
  exists [x] with some property [P], i.e., such that [P x].  We start
  by assuming that our conclusion is false; that is, [~ exists x, P
  x]. From this premise, it is not hard to derive [forall x, ~ P x].
  If we manage to show that this intermediate fact results in a
  contradiction, we arrive at an existence proof without ever
  exhibiting a value of [x] for which [P x] holds!

  The technical flaw here, from a constructive standpoint, is that we
  claimed to prove [exists x, P x] using a proof of [~ ~ (exists x, P
  x)].  Allowing ourselves to remove double negations from arbitrary
  statements is equivalent to assuming the excluded middle.  Thus,
  this line of reasoning cannot be encoded in Coq without assuming
  additional axioms. *)

(** **** Exercise: 2 stars, standard (forall_exists)

    In classical logic, [forall] and [exists] are _dual_: negating one
    gets you to the other. We saw some of this duality with
    [dist_not_exists] and [dist_not_forall].

    Only one of the following lemmas is provable in constructive
    logic. Which? Why isn't the other provable?  *)
Lemma not_exists__forall_not : forall {X : Type} (P : X -> Prop),
    (~ exists x, P x) -> forall x, ~ P x.
Proof.
  intros X P H x H1. destruct H.
  exists x. apply H1.
Qed.

Lemma not_forall__exists_not : forall {X : Type} (P : X -> Prop),
    (~ forall x, P x) -> exists x, ~ P x.
Proof.
  unfold not.
  intros X P H. destruct H.
  intros x.
Abort.

(** In addition to doing one of these proofs, please briefly explain
    why the other doesn't work. *)

(*The not_forall_exists_not does not work. It is because in the second one, you have to prove that P holds for all not X implies, there exists an x that does not hold for P. The issue is that exist is in the subgoal of the proof. Thus, when destruct or induction is applied on the forall statement, like in not_exists_forall_not, the exists x is destructed. And when we introduce x, we get up with property of x, which we cannot prove.   *)

(** [] *)

(* 2021-10-04 14:37 *)


From Coq Require Import Arith Lia.

(* begin snippet exp2Def *)
Fixpoint exp2 (n:nat) : nat :=
  match n with
    0 => 1
  | S i => 2 * exp2 i
  end.
(* end snippet exp2Def *)

Lemma exp2_positive : forall i, 0 < exp2 i.
Proof.
   induction i; simpl; auto with arith.
Qed.

Lemma exp2_not_zero i : exp2 i <> 0.
Proof.
  specialize (exp2_positive i); intros H H0.
   rewrite H0 in H; apply (Nat.nlt_0_r _ H).
Qed.

Lemma exp2_gt_id : forall n, n < exp2 n.
Proof.
  induction n.
  - cbn; auto with arith.
  - cbn; generalize IHn; generalize (exp2 n); intros; lia.
Qed.

Lemma exp2S : forall n, exp2 (S n) = 2 * exp2 n.
Proof.
  unfold exp2;  intros; simpl; ring.
Qed.


(* This file is extracted from the TLC library.
   http://github.com/charguer/tlc
   DO NOT EDIT. *)

(* -- DISCLAIMER: definitions in this file remain to be renamed,
      e.g. mmin and mmax. *)

(**************************************************************************
* TLC: A library for Coq                                                  *
* Minimum/Maximum w.r.t. an order relation                                *
**************************************************************************)

Set Implicit Arguments.
From SLF Require Import LibTactics LibLogic LibReflect LibOperation
  LibRelation LibOrder LibEpsilon.
Generalizable Variables A.

(* This module offers the functions [mmin] and [mmax] which produce
   the minimum and maximum elements of a non-empty, bounded set. *)

(**************************************************************************)
(* * Lower bound and minimum*)

(* [lower_bound le P x] means that [x] is a lower bound for the
   set [P] with respect to the ordering [le]. *)

Definition lower_bound A (le:binary A) (P:A->Prop) (x:A) :=
  forall y, P y -> le x y.

(* [min_element le P x] means that [x] is a minimal element of
   [P], i.e., it is both a member of [P] and a lower bound for
   [P]. *)

Definition min_element A (le:binary A) (P:A->Prop) (x:A) :=
  P x /\ lower_bound le P x.

(* [mmin le P] is a minimal element of [P] with respect to [le],
   when such an element exists. *)

Definition mmin `{Inhab A} (le:binary A) (P:A->Prop) :=
  epsilon (min_element le P).

(**************************************************************************)
(* ################################################################# *)
(* * Upper bound and maximum *)

(* [upper_bound le P x] means that [x] is a lower bound for the
   set [P] with respect to the ordering [le]. *)

Definition upper_bound A (le:binary A) (P:A->Prop) (x:A) :=
  forall y, P y -> le y x.

(* [max_element le P x] means that [x] is a maximal element of
   [P], i.e., it is both a member of [P] and a lower bound for
   [P]. *)

Definition max_element A (le:binary A) (P:A->Prop) (x:A) :=
  P x /\ upper_bound le P x.

(* [mmax le P] is a minimal element of [P] with respect to [le],
   when such an element exists. *)

Definition mmax `{Inhab A} (le:binary A) (P:A->Prop) :=
  epsilon (max_element le P).

(**************************************************************************)
(* ################################################################# *)
(* * Least upper bound and greatest lower bound *)

(* [lub le P x] means that [x] is a least upper bound
   for the set [P] with respect to the ordering [le]. *)

Definition lub A (le:binary A) (P:A->Prop) (x:A) :=
  min_element le (upper_bound le P) x.

(* [glb le P x] means that [x] is a greatest lower bound
   for the set [P] with respect to the ordering [le]. *)

Definition glb A (le:binary A) (P:A->Prop) (x:A) :=
  max_element le (lower_bound le P) x.

(**************************************************************************)
(* ################################################################# *)
(* * Connexion between lower and bounds *)

Lemma upper_bound_inverse : forall A (le:binary A),
  upper_bound le = lower_bound (inverse le).
Proof using.
  extens. intros P x. unfolds lower_bound, upper_bound. iff*.
Qed.

Lemma max_element_inverse : forall A (le:binary A) (P:A->Prop) (x:A),
  max_element le P x = min_element (inverse le) P x.
Proof using.
  extens. unfold max_element, min_element. rewrite* upper_bound_inverse.
Qed.

Lemma mmax_inverse : forall `{Inhab A} (le:binary A) (P:A->Prop),
  mmax le P = mmin (inverse le) P.
Proof using.
  intros. applys epsilon_eq. intros x. rewrite* max_element_inverse.
Qed.

(**************************************************************************)
(* ################################################################# *)
(* * Elimination roperties *)

(* [bounded_has_minimal le] means that, at type [A], it is
   the case that every non-empty set that admits a lower
   bound has a minimal element. *)

Definition bounded_has_minimal A (le:binary A) :=
  (* Recall that [ex P] means that [P] has an inhabitant; i.e.,
     it is equivalent to [exists x, P x]. *)
  forall P,
  ex P ->
  ex (lower_bound le P) ->
  ex (min_element le P).

(* If the set [P] is non-empty and admits a lower bound, and if the type
   [A] is such that every such set has a minimal element, then [P] has a
   minimal element, and this element is [mmin le P]. *)

Lemma mmin_spec : forall `{Inhab A} (le:binary A) (P:A->Prop) m,
  m = mmin le P ->
  ex P ->
  ex (lower_bound le P) ->
  bounded_has_minimal le ->
  min_element le P m.
Proof using.
  intros. subst. unfold mmin. epsilon* m.
Qed.

(**************************************************************************)
(* ################################################################# *)
(* * Application to [nat] *)

From SLF Require Import LibNat.

(* The type [nat] enjoys this property. *)

Lemma increment_lower_bound_nat : forall (P : nat->Prop) x,
  lower_bound le P x ->
  ~ P x ->
  lower_bound le P (x + 1)%nat.
Proof using.
  introv hlo ?. intros y ?.
  destruct (eq_nat_dec x y).
    { subst. tauto. }
    { forwards: hlo; eauto. nat_math. }
Qed.

Lemma bounded_has_minimal_nat :
  @bounded_has_minimal nat le.
Proof using.
  (* Assume a set [P], such that [y] is an inhabitant of [P]
     and [x] is a lower bound for [P]. *)
  intros P [ y ? ].
  (* We reason by induction on the difference [y + 1 - x].
     Reasoning with [y - x] would work too, but this choice
     is more elegant, as it makes the base case a contradiction,
     and avoids a little duplication. *)
  cut (
    forall (k x : nat), (y + 1 - x)%nat = k ->
    lower_bound le P x ->
    exists z, min_element le P z
  ). { intros ? [ x ? ]. eauto. }
  induction k; introv ? hlo.
  (* Base. *)
  (* Our hypotheses imply that [x] must be less than or equal to
     [y]. Because in this case the difference [y + 1 - x] is zero,
     this leads to a contradiction. *)
  { false. forwards: hlo; eauto. nat_math. }
  (* Step. *)
  (* Eeither [P x] holds, or it does not. If it does, then [x]
     is the desired minimal element. If it does not, this implies
     that [x + 1] is a lower bound for [P], and the induction
     hypothesis can be used. *)
  destruct (prop_inv (P x)).
    { exists x. split; eauto. }
    { eapply (IHk (x + 1)%nat). nat_math. eauto using increment_lower_bound_nat. }
Qed.

Hint Resolve bounded_has_minimal_nat : bounded_has_minimal.

(* Furthermore, at type [nat], every set admits a lower bound. *)

Lemma admits_lower_bound_nat : forall (P : nat->Prop),
  ex (lower_bound le P).
Proof using.
  exists 0%nat. unfold lower_bound. nat_math.
Qed.

Hint Resolve admits_lower_bound_nat : admits_lower_bound.

(* At type [nat], every non-empty set that admits an upper bound
   has a maximal element. *)

Lemma bounded_has_maximal_nat :
  @bounded_has_minimal nat (inverse le).
Proof using.
  (* Assume a set [P], such that [y] is an inhabitant of [P]
     and [x] is an upper bound for [P]. *)
  intros P [ y ? ] [ x h ].
  assert (y <= x).
    { forwards: h. eauto. eauto. }
  (* We apply our previous result to the image of [P] through
     the function that maps [i] to [x - i]. (We note that this
     function is its own inverse.) This yields a minimal
     element [z] of this image. Thus, [x - z] is the desired
     maximal element of [P]. *)
  assert (self_inverse: forall i, i <= x -> (x - (x - i))%nat = i).
    intros. nat_math.
  forwards [ z [ ? hz ]]: (@bounded_has_minimal_nat (fun i => P (x - i)%nat)).
    { exists (x - y)%nat. rewrite self_inverse by eauto. eauto. }
    { eauto using admits_lower_bound_nat. }
  exists (x - z)%nat.
  clear dependent y.
  split; [ assumption | ].
  intros y ?.
  assert (y <= x).
    { forwards: h. eauto. eauto. }
  forwards: hz (x - y)%nat.
    { rewrite self_inverse by eauto. eauto. }
  unfold inverse. nat_math.
Qed.

Hint Resolve bounded_has_maximal_nat : bounded_has_minimal.

Lemma mmin_spec_nat:
  forall (P:nat->Prop) m,
  m = mmin le P ->
  ex P ->
  P m /\ (forall x, P x -> m <= x).
Proof using.
  introv E Q. applys (@mmin_spec _ _ _ P m E Q).
  applys admits_lower_bound_nat.
  applys bounded_has_minimal_nat.
Qed.

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

(* [MMin P] is [mmin le P], in a context where the desired
   ordering can be inferred. *)

Definition MMin `{Inhab A} `{Le A} := mmin le.

(* [MMax P] is [mmax le P], in a context where the desired
   ordering can be inferred. *)

Definition MMax `{Inhab A} `{Le A} := mmax le.

(* 2021-08-11 15:24 *)


Require Export SFBook.

(* Prove the following basic property of doubling *)

Theorem double_Sm : forall (n m : nat),
  n = S m -> n + n = S (S (m + m)).
Proof.
  intros n m H.
  rewrite H.
  simpl.
  rewrite <- plus_n_Sm.
  reflexivity.
Qed.

(* Prove the following using destruct (either explicitly or implicitly). *)

Theorem andb_false_l : forall b, b && true = b.
Proof.
  intros []; reflexivity.
Qed.

(* Prove without destruct (either explicit or implicit). *)

Theorem andb_false_l' : forall b, b && true = b.
Proof.
  intros.
  rewrite andb_commutative.
  simpl.
  reflexivity.
Qed.

(* ******************************************************************************** *)

(* The following is the erroneous "mult3b" function from the written part. Fix it (removing
   the "Fail" modifier)! *)

Fixpoint mult3b (n : nat) : bool :=
  match n with
   | O => true
   | S (S (S n')) => mult3b n'
   | _ => false
  end.

(* Now use your function and "filter" to create a new function that takes a list of nats,
   and returns a list containing only those elements that are multiples of 3. *)

Definition extract_mult3s (l : list nat) : (list nat) :=
  filter mult3b l.

Example test_extract_mult3s1 : extract_mult3s [1;3;9;2;7;3;5;0] = [3;9;3;0].
Proof. reflexivity. Qed.

(* Next, use filter and an anonymous function to create a list that contains only those
   elements that are one smaller than a multiple of 3. *)

Definition extract_2mod3 (l : list nat) : (list nat) :=
  filter (fun n:nat => mult3b (S n)) l.

Example test_2mod3_1 : extract_2mod3 [1;3;9;2;7;3;5;0] = [2;5].
Proof. reflexivity. Qed.

(* ******************************************************************************** *)

(* Define a function pair_flatten that takes a list of pairs of some type X, and
   produces a list of X that contains each individual item (no pairs). In other words,
   if called with the (list (nat*nat)) [(1,5);(2,4);(7,9)] it should return the list
   [1;5;2;4;7;9] *)

(* FILL IN HERE *)

(* State and prove a theorem [pair_flatten_len] that for any list of pairs [l] given
   to [pair_flatten_len], the length of the produced list is twice the length of the
   original list. *)

(* FILL IN HERE *)

(* ******************************************************************************** *)

(* The following definition generalizes the definition of "oddmembers" from the book using
   the polymorphic list type. *)

Fixpoint oddmembers (l : list nat) : list nat :=
  match l with
  | nil => nil
  | h::t => match (evenb h) with
            | true => oddmembers t
            | false => h::(oddmembers t)
            end
  end.

(* Prove the following theorem - note: maybe slightly too complex for the exam, but maybe
   as a final "challenge" problem (extra credit?) *)

Theorem bigger_logic : forall (l : list nat),
  In 7 l <-> In 7 (oddmembers l).
Proof.
  (* FILL IN HERE *) Admitted.


Set Warnings "-notation-overridden,-parsing,-deprecated-hint-without-locality".
From LF Require Export exercise5.
From Coq Require Import Setoids.Setoid.

Example and_exercise :
  forall n m : nat, n + m = 0 -> n = 0 /\ m = 0.
Proof.
  intros. split.
  - destruct n.
    + reflexivity.
    + discriminate.
  - destruct m.
    + reflexivity.
    + rewrite <- plus_n_Sm in H. discriminate.
Qed.

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

(** **** Exercise: 1 star, standard, optional (proj2) *)
Lemma proj2 : forall P Q : Prop,
  P /\ Q -> Q.
Proof.
  intros P Q [_ H].
  apply H.
Qed.

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

(* Exercise: 2 stars, standard (and_assoc) *)
(* (In the following proof of associativity, notice how the
nested intros pattern 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 [HP [HQ HR]].
  split. split. apply HP. apply HQ. apply HR.
Qed.

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

Lemma or_intro_r : forall A B : Prop, B -> A \/ B.
Proof.
  intros A B HB.
  right.
  apply HB.
Qed.

Lemma mult_is_O :
  forall n m, n * m = 0 -> n = 0 \/ m = 0.
Proof.
  intros. induction n.
  - left. reflexivity.
  - destruct m.
    + right. reflexivity.
    + inversion H.
Qed.

Lemma factor_is_O:
  forall n m : nat, n = 0 \/ m = 0 -> n * m = 0.
Proof.
  (* This pattern implicitly does case analysis on
     n = 0 \/ m = 0 *)
  intros n m [Hn | Hm].
  - (* Here, n = 0 *)
    rewrite Hn. reflexivity.
  - (* Here, m = 0 *)
    rewrite Hm. rewrite <- mult_n_O.
    reflexivity.
Qed.

(* Exercise: 1 star, standard (or_commut) *)
Theorem or_commut : forall P Q : Prop,
  P \/ Q -> Q \/ P.
Proof.
  intros P Q [H1 | H2].
  - right. apply H1.
  - left. apply H2.
Qed.

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

(* Exercise: 2 stars, standard, optional (not_implies_our_not) *)
(* Show that Coq's definition of negation implies the intuitive
one mentioned above. Hint: while getting accustomed to Coq's
definition of not, you might find it helpful to unfold not near
the beginning of proofs. *)
Theorem not_implies_our_not : forall (P : Prop),
  ~ P -> (forall (Q : Prop), P -> Q).
Proof.
  unfold not. intros.
  apply ex_falso_quodlibet.
  apply H. apply H0.
Qed.

Theorem not_implies_our_not2 : forall (P : Prop),
  ~ P -> (forall (Q : Prop), P -> Q).
Proof.
  intros. destruct H. apply H0.
Qed.

(* Inequality is a frequent enough form of negated statement that there is a special notation for it, x ≠ y: *)
Notation "x <> y" := (~(x = y)).

(** **** Exercise: 2 stars, advanced (double_neg_inf) *)
(* Write an informal proof of double_neg:
Theorem: P implies ~~P, for any proposition P. *)
Theorem double_neg_inf : forall (P : Prop),
  P -> ~~ P.
Proof.
  intros. unfold not.
  intros. apply H0 in H. apply H.
Qed.

(** **** Exercise: 2 stars, standard, especially useful (contrapositive) *)
Theorem contrapositive : forall (P Q : Prop),
  (P -> Q) -> (~Q -> ~P).
Proof.
  unfold not. intros.
  apply H in H1. apply H0 in H1. apply H1.
Qed.

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

(** **** Exercise: 2 stars, standard (de_morgan_not_or) *)
(* De Morgan's Laws, named for Augustus De Morgan, describe how
negation interacts with conjunction and disjunction. The
following law says that "the negation of a disjunction is the
conjunction of the negations." There is a corresponding law
de_morgan_not_and_not that we will return to at the end of thi
 chapter. *)
Theorem de_morgan_not_or : forall (P Q : Prop),
    ~ (P \/ Q) <-> ~P /\ ~Q.
Proof.
  unfold not. intros.
  split.
  - split.
    + intros. apply H. apply or_intro_l. apply H0.
    + intros. apply H. apply or_intro_r. apply H0.
  - intros. destruct H0.
    + destruct H. apply H. apply H0.
    + destruct H. apply H1. apply H0.
Qed.

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

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

Lemma not_true_iff_false : forall b,
  b <> true <-> b = false.
Proof.
  (* WORKED IN CLASS *)
  intros b. split.
  - (* -> *) apply not_true_is_false.
  - (* <- *)
    intros H. rewrite H. intros H'. discriminate H'.
Qed.

Theorem or_distributes_over_and : forall P Q R : Prop,
  P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
Proof.
  unfold iff. intros. split.
  - intros. split.
    + destruct H.
      * apply or_intro_l. apply H.
      * apply proj1 in H. apply or_intro_r. apply H.
    + destruct H.
      * apply or_intro_l. apply H.
      * apply proj2 in H. apply or_intro_r. apply H.
  - intros [[|] [|]].
    + apply or_intro_l. apply H.
    + left. apply H.
    + left. apply H0.
    + right. split. apply H. apply H0.
Qed.

Lemma mul_eq_0 : forall (n m : nat),
  n * m = 0 <-> n = 0 \/ m = 0.
Proof.
  intros. split.
  - apply mult_is_O.
  - apply factor_is_O.
Qed.

Theorem or_assoc: forall P Q R : Prop,
  P \/ (Q \/ R) <-> (P \/ Q) \/ R.
Proof.
  intros. 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 mul_eq_0_ternary : forall n m p,
  n * m * p = 0 <-> n = 0 \/ m = 0 \/ p = 0.
Proof.
  intros.
  rewrite mul_eq_0. rewrite mul_eq_0. rewrite or_assoc.
  reflexivity.
Qed.

Definition Even x := exists n: nat, x = double n.

(** **** Exercise: 1 star, standard, especially useful (dist_not_exists) *)
(* Prove that "P holds for all x" implies "there is no x for which P does not
hold." (Hint: destruct H as [x E] works on existential assumptions!) *)
Theorem dist_not_exists : forall (X : Type) (P : X -> Prop),
  (forall x, P x) -> ~ (exists x, ~ P x).
Proof.
  unfold not. intros.
  destruct H0 as [x E]. apply E. apply H.
Qed.

(** **** Exercise: 2 stars, standard (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. destruct H. destruct H.
    + left. exists x. apply H.
    + right. exists x. apply H.
  - intros. destruct H.
    + destruct H. exists x. left. apply H.
    + destruct H. exists x. right. apply H.
Qed.

(** **** Exercise: 3 stars, standard, optional (leb_plus_exists) *)
Theorem leb_plus_exists: forall n m,
  n <=? m = true -> exists x, m = n + x.
Proof.
  intros n. induction n as [|n' H].
  - intros. exists m. reflexivity.
  - destruct m.
    + simpl. discriminate.
    + simpl. intros. apply H in H0. destruct H0.
      rewrite H0. exists x. reflexivity.
Qed.

Theorem plus_exists_leb : forall n m,
  exists x, m = n + x -> n <=? m = true.
Proof.
  intros. exists 0. rewrite add_0_r.
  intros. rewrite H. apply leb_refl.
Qed.

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

Theorem 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. apply H.
  - simpl. intros [H | H].
    + left. rewrite H. reflexivity.
    + right. apply IHl. apply H.
Qed.

(** **** Exercise: 3 stars, standard (In_map_iff) *)
Theorem 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.
  - intros H. induction l as [| x' l' IHl].
    + simpl in H. simpl. apply ex_falso_quodlibet. apply H.
    + simpl in H. destruct H.
      * exists x'. simpl. split. apply H. left. reflexivity.
      * apply IHl in H. destruct H. exists x. simpl. split.
        destruct H. apply H. right. destruct H. apply H0.
  - intros. destruct H. destruct H. rewrite <- H. apply in_map. apply H0.
Qed.

(** **** Exercise: 3 stars, standard, especially useful (All) *)
(* Recall that functions returning propositions can be seen as properties of
their arguments. For instance, if P has type nat -> Prop, then P n states that
property P holds of n. *)
Fixpoint All {T : Type} (P : T -> Prop) (l : list T) : Prop :=
  match l with
  | [] => True
  | x' :: l' => P x' /\ All P l'
  end.

Lemma ex_falso_quodlibet_ext : forall (T : Type) (P : T -> Prop),
  (forall x : T, False -> P x).
Proof.
Admitted.

Theorem All_in :
  forall T (P : T -> Prop) (l : list T),
    (forall x, In x l -> P x) <->
    All P l.
Proof.
  intros. split.
  - induction l as [| x' l' IHl].
    + simpl. reflexivity.
    + simpl. intros. split.
      * apply H. left. reflexivity.
      * apply IHl. intros. apply H. right. apply H0.
  - induction l as [| x' l' IHl].
    + simpl. intros. apply ex_falso_quodlibet. apply H0.
    + simpl. intros. destruct H0.
      * rewrite H0 in H. apply proj1 in H. apply H.
      * destruct H. apply IHl. apply H1. apply H0.
Qed.

(** **** Exercise: 2 stars, standard, optional (combine_odd_even) *)
(* Complete the definition of the combine_odd_even function below. It takes as
arguments two properties of numbers, Podd and Peven, and it should return a
property P such that P n is equivalent to Podd n when n is odd and equivalent
to Peven n otherwise. *)
Definition combine_odd_even (Podd Peven : nat -> Prop) : nat -> Prop :=
  fun n => if odd n then Podd n else Peven n.

Theorem combine_odd_even_intro :
  forall (Podd Peven : nat -> Prop) (n : nat),
    (odd n = true -> Podd n) ->
    (odd n = false -> Peven n) ->
    combine_odd_even Podd Peven n.
Proof.
  intros. unfold even in H, H0.
  unfold combine_odd_even.
  destruct n.
  - simpl. apply H0. simpl. reflexivity.
  - destruct (odd (S n)).
    + apply H. reflexivity.
    + apply H0. reflexivity.
Qed.

Theorem combine_odd_even_elim_odd :
  forall (Podd Peven : nat -> Prop) (n : nat),
    combine_odd_even Podd Peven n ->
    odd n = true ->
    Podd n.
Proof.
  intros. unfold combine_odd_even in H.
  destruct (odd n).
  - apply H.
  - discriminate H0.
Qed.

Theorem combine_odd_even_elim_even :
  forall (Podd Peven : nat -> Prop) (n : nat),
    combine_odd_even Podd Peven n ->
    odd n = false ->
    Peven n.
Proof.
  intros. unfold combine_odd_even in H.
  destruct (odd n).
  - discriminate.
  - apply H.
Qed.

Theorem add_comm3 : forall x y z,
  x + (y + z) = (z + y) + x.
Proof.
  intros.
  rewrite add_comm.
  rewrite (add_comm y z).
  reflexivity.
Qed.

Theorem in_not_nil : forall A (x : A) (l : list A),
  In x l -> l <> [].
Proof.
  intros. unfold not.
  intros. rewrite H0 in H.
  simpl in H. apply H.
Qed.

(** **** Exercise: 4 stars, standard (tr_rev_correct) *)
(* One problem with the definition of the list-reversing function rev
that we have is that it performs a call to app on each step; running
app takes time asymptotically linear in the size of the list, which
means that rev is asymptotically quadratic. We can improve this with
the following definitions: *)
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 [].

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

Compute (rev_append [1;2;3] [4;5;6]).

Lemma rev_append_rev_origin : forall X (l1 l2 : list X),
  rev_append l1 l2 = rev l1 ++ l2.
Proof.
  intros X l1. induction l1 as [| n' l' IHl]; intros.
  - reflexivity.
  - simpl. rewrite <- app_assoc. simpl. apply IHl.
Qed.

Theorem tr_rev_correct : forall X, @tr_rev X = @rev X.
Proof.
  intros.
  apply functional_extensionality.
  induction x as [| x' l' IHx].
  - unfold tr_rev. reflexivity.
  - unfold tr_rev. simpl. apply rev_append_rev_origin.
Qed.

Lemma even_double : forall k,
  even (double k) = true.
Proof.
  intros. induction k as [| k' H].
  - reflexivity.
  - simpl. rewrite H. reflexivity.
Qed.

(** **** Exercise: 3 stars, standard (even_double_conv) *)
Lemma even_double_conv : forall n, exists k,
  n = if even n then double k else S (double k).
Proof.
  intros. induction n as [| n' H].
  - simpl. exists 0. reflexivity.
  - rewrite even_S. destruct H.
    destruct (even n').
    + simpl. exists x. rewrite H. reflexivity.
    + simpl. exists (S x). rewrite double_incr. rewrite H. reflexivity.
Qed.

Theorem even_bool_prop : forall n,
  even n = true <-> Even n.
Proof.
  intros. split.
  (* Apply the theorem on n, so we obtain some k. *)
  - intros. destruct (even_double_conv n) as [k Hk].
    rewrite Hk. rewrite H. unfold Even. exists k. reflexivity.
  - unfold Even. intros. destruct H. rewrite H. apply even_double.
Qed.

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

Example not_even_1001 : ~(Even 1001).
Proof.
  rewrite <- even_bool_prop.
  unfold not.
  intros.
  discriminate.
Qed.

(** **** Exercise: 2 stars, standard (logical_connectives) *)
(* The following theorems relate the propositional connectives studied in this chapter
to the corresponding boolean operations. *)
Theorem andb_true_iff : forall b1 b2 : bool,
  andb b1 b2 = true <-> b1 = true /\ b2 = true.
Proof.
  intros. split.
  - intros. destruct b1.
    + destruct b2.
      * split. reflexivity. reflexivity.
      * split. discriminate. discriminate.
    + destruct b2.
      * split. discriminate. discriminate.
      * split. discriminate. discriminate.
  - intros [H1 H2]. rewrite H1. rewrite H2. reflexivity.
Qed.

Theorem orb_ture_iff : forall b1 b2 : bool,
  orb b1 b2 = true <-> b1 = true \/ b2 = true.
Proof.
  intros. split.
  - intros. destruct b1.
    + destruct b2.
      * left. reflexivity.
      * left. reflexivity.
    + destruct b2.
      * right. reflexivity.
      * discriminate.
  - intros [H1 | H2].
    + unfold orb. rewrite H1. reflexivity.
    + unfold orb. rewrite H2. destruct b1.
      * reflexivity.
      * reflexivity.
Qed.

(** **** Exercise: 1 star, standard (eqb_neq) *)
(* The following theorem is an alternate "negative" formulation of eqb_eq
that is more convenient in certain situations.
(We'll see examples in later chapters.) Hint: not_true_iff_false. *)
Theorem eqb_neq : forall x y : nat,
  x =? y = false <-> x <> y.
Proof.
  intros. unfold not. split.
  - intros. rewrite H0 in H. rewrite eqb_refl in H. discriminate.
  - intros. apply not_true_iff_false. unfold not. intros.
    apply eqb_eq in H0. apply H. apply H0.
Qed.

(** **** Exercise: 3 stars, standard (eqb_list) *)
(* Given a boolean operator eqb for testing equality of elements of some type A,
we can define a function eqb_list for testing equality of lists with elements in A.
Complete the definition of the eqb_list function below. To make sure that your
definition is correct, prove the lemma eqb_list_true_iff. *)
Fixpoint eqb_list {A : Type} (eqb : A -> A -> bool) (l1 l2 : list A) : bool :=
  match l1, l2 with
  | [], [] => true
  | [], _ => false
  | _, [] => false
  | (n1 :: l1'), (n2 :: l2') => andb (eqb n1 n2) (eqb_list eqb l1' l2')
  end.

Theorem 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.
  - destruct l2.
    + simpl. split. intros. reflexivity. intros. reflexivity.
    + simpl. split. intros. discriminate. intros. discriminate.
  - destruct l2.
    + simpl. split. intros. discriminate. intros. discriminate.
    + (* non-trivial. *)
      simpl. split. intros.
      * apply andb_true_iff in H0. destruct H0 as [H1 H2].
        apply H in H1. apply IHl1 in H2. rewrite H1, H2. reflexivity.
      * intros. injection H0 as H'. apply andb_true_iff. split.
        apply H. apply H'. apply IHl1. apply H0.
Qed.

(** **** Exercise: 2 stars, standard, especially useful (All_forallb) *)
(* Prove the theorem below, which relates forallb, from the exercise forall_exists_challenge
in chapter Tactics, to the All property defined above. *)
Fixpoint forallb {X : Type} (test : X -> bool) (l : list X) : bool :=
  match l with
  | [] => true
  | n :: l' => andb (test n) (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. split.
  - intros. induction l.
    + reflexivity.
    + simpl in H. apply andb_true_iff in H. destruct H as [H1 H2].
      simpl. split.
      * apply H1.
      * apply IHl in H2. apply H2.
  - intros. induction l.
    + reflexivity.
    + simpl. apply andb_true_iff. split.
      * simpl in H. destruct H as [H _]. apply H.
      * simpl in H. destruct H as [_ H]. apply IHl in H. apply H.
Qed.

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

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

Lemma helper : forall P,
  ~(P /\ ~P).
Proof.
  unfold not. intros P [H1 H2].
  apply H2. apply H1.
Qed.

(** **** Exercise: 3 stars, standard (excluded_middle_irrefutable) *)
Theorem excluded_middle_irrefutable : forall P : Prop,
  ~~(P \/ ~P).
Proof.
  intros P H.
  apply de_morgan_not_or in H. apply helper in H. apply H.
Qed.

(** **** Exercise: 3 stars, advanced (not_exists_dist) *)
(* It is a theorem of classical logic that the following two assertions are equivalent:
    ~ (∃ x, ~ P x)
    forall x, P x
The dist_not_exists theorem above proves one side of this equivalence. Interestingly, the
other direction cannot be proved in constructive logic. Your job is to show that it is implied
by the excluded middle. *)
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.
  destruct (EM (P x)) as [H1 | H2]. (* Can destruct the whole proposition. *)
  - apply H1.
  - apply ex_falso_quodlibet. apply H. exists x. apply H2.
Qed.

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

Theorem em_imples_peirce :
  excluded_middle -> peirce.
Proof.
  unfold excluded_middle, peirce, not.
  intros. destruct (H P).
  - apply H1.
  - apply H0. intros. apply H1 in H2. apply ex_falso_quodlibet. apply H2.
Qed.

Theorem peirce_imples_dne:
  peirce -> double_negation_elimination.
Proof.
  unfold peirce, double_negation_elimination, not.
  intros. apply (H P False). (* Remember to apply with arguments! *)
  intros. apply H0 in H1. apply ex_falso_quodlibet. apply H1.
Qed.

Theorem dne_implies_dm :
  double_negation_elimination -> de_morgan_not_and_not.
Proof.
  unfold double_negation_elimination, de_morgan_not_and_not, not.
  intros. apply H. intros. apply H1.
  left. apply H. intros. apply H0. split. apply H2. intros. apply H1. right. apply H3.
Qed.

Theorem dm_implies_implies_to_or :
  de_morgan_not_and_not -> implies_to_or.
Proof.
  unfold de_morgan_not_and_not, implies_to_or, not.
  intros.
  apply H. intros. destruct H1.
  apply H1. intros. apply H2. apply H0. apply H3.
Qed.

Theorem implies_to_or_implies_em :
  implies_to_or -> excluded_middle.
Proof.
  unfold implies_to_or, excluded_middle, not.
  intros.
  apply or_commut. apply H. intros. apply H0.
Qed.