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

(* REMINDER: Please do not put solutions to the exercises in
   publicly accessible places! *)

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 here: *)

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

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

Check (pair 3 5).

(** Here are two simple functions 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.

Compute (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 works because the pair notation is actually
    provided as part of the standard library): *)

Compute (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 to prove a few simple facts about pairs.

    If we state things in a particular (and slightly peculiar) way, we
    can complete proofs 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.

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

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

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

(** **** Exercise: 1 star (snd_fst_is_swap)  *)
Theorem snd_fst_is_swap : forall (p : natprod),
  (snd p, fst p) = swap_pair p.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 1 star, optional (fst_swap_is_snd)  *)
Theorem fst_swap_is_snd : forall (p : natprod),
  fst (swap_pair p) = snd p.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

(** Generalizing the definition of pairs, 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 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 understand the details of 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] function concatenates (appends) 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.

(** *** Head (with default) and Tail *)
(** 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.  *)

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.

(** *** Exercises *)
(** **** Exercise: 2 stars, recommended (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 :=
  (* FILL IN HERE *) admit.

Example test_nonzeros:
  nonzeros [0;1;0;2;3;0;0] = [1;2;3].
  (* FILL IN HERE *) Admitted.

Fixpoint oddmembers (l:natlist) : natlist :=
  (* FILL IN HERE *) admit.

Example test_oddmembers:
  oddmembers [0;1;0;2;3;0;0] = [1;3].
  (* FILL IN HERE *) Admitted.

Fixpoint countoddmembers (l:natlist) : nat :=
  (* FILL IN HERE *) admit.

Example test_countoddmembers1:
  countoddmembers [1;0;3;1;4;5] = 4.
  (* FILL IN HERE *) Admitted.

Example test_countoddmembers2:
  countoddmembers [0;2;4] = 0.
  (* FILL IN HERE *) Admitted.

Example test_countoddmembers3:
  countoddmembers nil = 0.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** 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 :=
  (* FILL IN HERE *) admit.

Example test_alternate1:
  alternate [1;2;3] [4;5;6] = [1;4;2;5;3;6].
  (* FILL IN HERE *) Admitted.

Example test_alternate2:
  alternate [1] [4;5;6] = [1;4;5;6].
  (* FILL IN HERE *) Admitted.

Example test_alternate3:
  alternate [1;2;3] [4] = [1;4;2;3].
  (* FILL IN HERE *) Admitted.

Example test_alternate4:
  alternate [] [20;30] = [20;30].
  (* FILL IN HERE *) Admitted.
(** [] *)

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

(** A [bag] (or [multiset]) is like a set, except that each element
    can appear multiple times rather than just once.  One possible
    implementation is to represent a bag of numbers as a list. *)

Definition bag := natlist.

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

Fixpoint count (v:nat) (s:bag) : nat :=
  (* FILL IN HERE *) admit.

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

Example test_count1:              count 1 [1;2;3;1;4;1] = 3.
 (* FILL IN HERE *) Admitted.
Example test_count2:              count 6 [1;2;3;1;4;1] = 0.
 (* FILL IN HERE *) Admitted.

(** 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 :=
  (* FILL IN HERE *) admit.

Example test_sum1:              count 1 (sum [1;2;3] [1;4;1]) = 3.
 (* FILL IN HERE *) Admitted.

Definition add (v:nat) (s:bag) : bag :=
  (* FILL IN HERE *) admit.

Example test_add1:                count 1 (add 1 [1;4;1]) = 3.
 (* FILL IN HERE *) Admitted.
Example test_add2:                count 5 (add 1 [1;4;1]) = 0.
 (* FILL IN HERE *) Admitted.

Definition member (v:nat) (s:bag) : bool :=
  (* FILL IN HERE *) admit.

Example test_member1:             member 1 [1;4;1] = true.
 (* FILL IN HERE *) Admitted.
Example test_member2:             member 2 [1;4;1] = false.
 (* FILL IN HERE *) Admitted.
(** [] *)

(** **** 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 :=
  (* When remove_one is applied to a bag without the number to remove,
     it should return the same bag unchanged. *)
  (* FILL IN HERE *) admit.

Example test_remove_one1:
  count 5 (remove_one 5 [2;1;5;4;1]) = 0.
  (* FILL IN HERE *) Admitted.

Example test_remove_one2:
  count 5 (remove_one 5 [2;1;4;1]) = 0.
  (* FILL IN HERE *) Admitted.

Example test_remove_one3:
  count 4 (remove_one 5 [2;1;4;5;1;4]) = 2.
  (* FILL IN HERE *) Admitted.

Example test_remove_one4:
  count 5 (remove_one 5 [2;1;5;4;5;1;4]) = 1.
  (* FILL IN HERE *) Admitted.

Fixpoint remove_all (v:nat) (s:bag) : bag :=
  (* FILL IN HERE *) admit.

Example test_remove_all1:          count 5 (remove_all 5 [2;1;5;4;1]) = 0.
 (* FILL IN HERE *) Admitted.
Example test_remove_all2:          count 5 (remove_all 5 [2;1;4;1]) = 0.
 (* FILL IN HERE *) Admitted.
Example test_remove_all3:          count 4 (remove_all 5 [2;1;4;5;1;4]) = 2.
 (* FILL IN HERE *) Admitted.
Example test_remove_all4:          count 5 (remove_all 5 [2;1;5;4;5;1;4;5;1;4]) = 0.
 (* FILL IN HERE *) Admitted.

Fixpoint subset (s1:bag) (s2:bag) : bool :=
  (* FILL IN HERE *) admit.

Example test_subset1:              subset [1;2] [2;1;4;1] = true.
 (* FILL IN HERE *) Admitted.
Example test_subset2:              subset [1;2;2] [2;1;4;1] = false.
 (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars, recommended (bag_theorem)  *)
(** Write down an interesting theorem [bag_theorem] about bags
    involving the functions [count] and [add], and prove it.  For
    this, replace the [admit] command below with the statement of your
    theorem. 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_theorem :
  (* FILL IN HERE *) admit.
(* FILL IN HERE *) Admitted.
(** [] *)

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

(** 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
    "scrutinee" 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'].
  - (* l = nil *)
    reflexivity.
  - (* 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 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 when you
    get to them.  'Nuff said. *)

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

(** Proofs by induction over datatypes like [natlist] are a
    little less familiar than standard natural number induction, but
    the idea is equally simple.  Each [Inductive] declaration defines
    a set of data values that can be built up using the declared
    constructors: a boolean can be either [true] or [false]; a number
    can be either [O] or [S] applied to another 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 arguments 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' IHl1'].
  - (* l1 = nil *)
    reflexivity.
  - (* l1 = cons n l1' *)
    simpl. rewrite -> IHl1'. reflexivity.  Qed.

(** Notice that, as when doing induction on natural numbers, the
    [as...] clause provided to the [induction] tactic gives a name to
    the induction hypothesis corresponding to the smaller list [l1']
    in the [cons] case. Once 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. *)

(** For comparison, here is an informal proof of the same theorem. *)

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

(** *** Reversing a list *)
(** For a slightly more involved example of inductive proof over
    lists, suppose we use [app] to define a list-reversing function
    [rev]: *)

Fixpoint rev (l:natlist) : natlist :=
  match l with
  | nil    => nil
  | h :: t => 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 theorems about our newly defined [rev].
    For something a bit more challenging than what we've seen, let's
    prove that reversing a list does not change its length.  Our first
    attempt 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' IHl'].
  - (* l = [] *)
    reflexivity.
  - (* 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 [++], but we don't have any useful equations
       in either the immediate context or in the global
       environment!  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 relating [++] and [length] that
    would have enabled us to make progress and prove it as a separate
    lemma.
*)

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' IHl1'].
  - (* l1 = nil *)
    reflexivity.
  - (* l1 = cons *)
    simpl. rewrite -> IHl1'. reflexivity.  Qed.

(** Note that, to make the lemma as general as possible, 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 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' IHl'].
  - (* l = nil *)
    reflexivity.
  - (* l = cons *)
    simpl. rewrite -> app_length, plus_comm.
    rewrite -> IHl'. reflexivity.  Qed.

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

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

    _Proof_: By induction on [l1].

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

    - Next, suppose [l1 = n::l1'], with
        length (l1' ++ l2) = length l1' + length l2.
      We must show
        length ((n::l1') ++ l2) = length (n::l1') + length l2).
      This follows directly from the definitions of [length] and [++]
      together with 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 ((rev l') ++ [n]) = S (length l')
        which, by the previous lemma, is the same as
          length (rev l') + length [n] = S (length l').
        This follows directly from the induction hypothesis and the
        definition of [length]. [] *)

(** 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 (which can easily work 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
    like this: *)

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

    _Proof_: First, observe that [length (l ++ [n]) = S (length l)]
     for any [l] (this follows by a straightforward induction on [l]).
     The main property again follows by 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 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 our
    present purposes. *)

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

(** We've seen that proofs can make use of other theorems we've
    already proved, e.g., using [rewrite].  But in order to refer to a
    theorem, we need to know its name!  Indeed, it is often hard even
    to remember what theorems have been proven, much less what they
    are called.

    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 book; it can save you a lot of time!

    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_r : 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 one.  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.

(** 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: 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),
  leb 1 (count 1 (1 :: s)) = true.
Proof.
  (* FILL IN HERE *) Admitted.

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

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

Theorem remove_decreases_count: forall (s : bag),
  leb (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 do this.)
*)

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

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

(** 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 choose some number to return when the list is
    too short...
    *)

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

(** This solution is not so good: If [nth_bad] returns [42], we
    can't tell whether that value actually appears on the input
    without further processing. A better alternative is to change the
    return type of [nth_bad] to include an error value as a possible
    outcome. We call this type [natoption]. *)

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

(** We can then change the above definition of [nth_bad] to
    return [None] when the list is too short and [Some a] when the
    list has enough members and [a] appears at position [n]. We call
    this new function [nth_error] to indicate that it may result in an
    error. *)

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

Example test_nth_error1 : nth_error [4;5;6;7] 0 = Some 4.
Proof. reflexivity. Qed.
Example test_nth_error2 : nth_error [4;5;6;7] 3 = Some 7.
Proof. reflexivity. Qed.
Example test_nth_error3 : nth_error [4;5;6;7] 9 = None.
Proof. reflexivity. Qed.

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

Fixpoint nth_error' (l:natlist) (n:nat) : natoption :=
  match l with
  | nil => None
  | a :: l' => if beq_nat n O then Some a
               else nth_error' l' (pred n)
  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_error)  *)
(** 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_error (l : natlist) : natoption :=
  (* FILL IN HERE *) admit.

Example test_hd_error1 : hd_error [] = None.
 (* FILL IN HERE *) Admitted.

Example test_hd_error2 : hd_error [1] = Some 1.
 (* FILL IN HERE *) Admitted.

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

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

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

End NatList.

(* ###################################################### *)
(** * Partial Maps *)

(** As a final illustration of how data structures can be defined in
    Coq, here is a simple _partial map_ data type, analogous to the
    map or dictionary data structures found in most programming
    languages. *)

(** First, we define a new inductive datatype [id] to serve as the
    "keys" of our partial maps. *)

Inductive id : Type :=
  | Id : nat -> id.

(** Internally, an [id] is just a number.  Introducing a separate type
    by wrapping each nat with the tag [Id] makes definitions more
    readable and gives us the flexibility to change representations
    later if we wish.

    We'll also need an equality test for [id]s: *)

Definition beq_id x1 x2 :=
  match x1, x2 with
  | Id n1, Id n2 => beq_nat n1 n2
  end.

(** **** Exercise: 1 star (beq_id_refl)  *)
Theorem beq_id_refl : forall x, true = beq_id x x.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** Now we define the type of partial maps: *)

Module PartialMap.
Import NatList.

Inductive partial_map : Type :=
  | empty  : partial_map
  | record : id -> nat -> partial_map -> partial_map.

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

(** The [update] function overrides the entry for a given key in a
    partial map (or adds a new entry if the given key is not already
    present). *)

Definition update (d : partial_map)
                  (key : id) (value : nat)
                  : partial_map :=
  record key value d.

(** Last, the [find] function searches a [partial_map] for a given
    key.  It returns [None] if the key was not found and [Some val] if
    the key was associated with [val]. If the same key is mapped to
    multiple values, [find] will return the first one it
    encounters. *)

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

(** *** *)

(** **** Exercise: 1 star (update_eq)  *)
Theorem update_eq :
  forall (d : partial_map) (k : id) (v: nat),
    find k (update d k v) = Some v.
Proof.
 (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 1 star (update_neq)  *)
Theorem update_neq :
  forall (d : partial_map) (m n : id) (o: nat),
    beq_id m n = false -> find m (update d n o) = find m d.
Proof.
 (* FILL IN HERE *) Admitted.
(** [] *)

End PartialMap.

(** **** Exercise: 2 stars (baz_num_elts)  *)
(** Consider the following inductive definition: *)

Inductive baz : Type :=
  | Baz1 : baz -> baz
  | Baz2 : baz -> bool -> baz.

(** How _many_ elements does the type [baz] have?

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

(** $Date: 2016-01-28 15:02:07 -0500 (Thu, 28 Jan 2016) $ *)


(* -------------------------------------- Homework 3 --------------------------------------
 * Partners: David Klock, Kartikeya Bhardwaj
 *)

Require Import Frap.

(* --- SECTION 1: An alternate defenition of trc --- *)

(* Consider the following alternative definition of trc. *)

Inductive different_trc {A} (R : A -> A -> Prop) : A -> A -> Prop :=
| DiffTrcRefl : forall x, different_trc R x x
| DiffTrcBack : forall x y z,
    different_trc R x y ->
    R y z ->
    different_trc R x z.

(* PROBLEM 1 [5 points, ~2 sentences]
 * Describe what's different between `trc` and `different_trc`.  Then explain briefly
 * and intuitively why they are equivalent.
 *
 * Hint: To have a coherent answer, you'll probably need to look at the definition of
 * `trc` again.
 *
 * Hint: The names of the constructors are useful to think about.
 *)
(* trc's TrcFront differs from different_trc's DiffTrcBack.  TrcFront states
   that if x can *step to* y, and if y can *reach* z, then x can reach z.
   DiffTrcBack flips this -- it states that if x can *reach* y, and y can
   *reach* z, then x can reach z.

   These are the same; they just reverse the order of induction.  TrcFront has
   one induct *forwards* from x, toward z.  DiffTrcBack has one induct *backwards*
   from z, toward x. *)

(* Now we have an intuitive understanding of why `trc` and `different_trc` are
 * equivalent. Let's prove it!
 *)

(* PROBLEM 2 [5 points, ~10 tactics]
 * Prove the first half of the equivalence, that `different_trc` implies `trc`.
 *
 * Hint: Proceed by induction on the evidence of `different_trc`.
 *
 * Hint: Remember the rules of thumb for working with inductive predicates.
 * In the goal, you might find `constructor` or `econstructor` useful,
 * or you can use `apply`/`eapply` with the name of the constructor.
 *
 * Hint: You might find the lemma `trc_trans` useful with `eapply`.
 *)
Lemma R_x_y_implies_trc_R_x_y :
  forall A (R : A -> A -> Prop) x y,
    R x y -> trc R x y.
Proof.
  intros.
  assert (trc R y y).
  - apply TrcRefl.
  - eapply TrcFront.
    + apply H.
    + apply TrcRefl.
Qed.

Theorem different_trc_implies_trc :
  forall A (R : A -> A -> Prop) x y,
    different_trc R x y ->
    trc R x y.
Proof.
  induct 1.
  + apply TrcRefl.
  + eapply trc_trans.
    - apply IHdifferent_trc.
    - apply R_x_y_implies_trc_R_x_y.
      assumption.
Qed.

(* PROBLEM 3 [5 points, ~20 tactics]
 * Now prove the second half of the equivalence, that `trc` implies `different_trc`.
 *
 * Hint: Proceed by induction on the evidence of `trc`.
 *
 * Hint: `trc_trans` was useful in the previous problem. You might consider proving
 * an analogous helper lemma for `different_trc`. Be *extremely* careful stating this
 * lemma deciding how to prove it, since there are lots of pitfalls.
 *
 * Hint: There's more than one way to do it, so feel free to explore approaches that
 * are not analogous to your proof of the previous problem.
 *
 * Hint: Ask for help if you're stuck!!
 *)

Theorem different_trc_trans :
  forall {A} (R : A -> A -> Prop) y z,
    different_trc R y z ->
      forall x,
        different_trc R x y ->
          different_trc R x z.
Proof.
  induct 1.
  - intros. assumption.
  - intros. eapply DiffTrcBack.
    + apply IHdifferent_trc.
      assumption.
    + assumption.
Qed.

Lemma R_x_y_implies_different_trc_R_x_y :
  forall A (R : A -> A -> Prop) x y,
    R x y -> different_trc R x y.
Proof.
  intros.
  assert (different_trc R y y).
  - apply DiffTrcRefl.
  - eapply DiffTrcBack.
    + apply DiffTrcRefl.
    + apply H.
Qed.

Theorem trc_implies_different_trc_implies :
  forall A (R : A -> A -> Prop) x y,
    trc R x y ->
    different_trc R x y.
Proof.
  induct 1.
  + apply DiffTrcRefl.
  + eapply different_trc_trans.
    - apply IHtrc.
    - apply R_x_y_implies_different_trc_R_x_y.
      assumption.
Qed.

(* --- SECTION 2: Inductive predicates for "and" and "or" --- *)

(* Very very few things are "built in" to Coq. We have already seen that numbers and booleans
 * are not built in, but defined in the standard library as inductive types. In fact, even
 * basic logical connectives such as "and" and "or" are not built in, but are also defined
 * in the standard library as inductive predicates. Let's explore these definitions a bit.
 *)

(* Here is an inductive definition of "and" (called `my_and` just so it doesn't conflict
 * with the definition of `and` from the standard library).
 *)
Inductive my_and (A B : Prop) : Prop :=
| MakeAnd : A -> B -> my_and A B.

(* And here's a simple proof about `my_and`, which says "if you give me evidence of
 * `my_and A B`, I can give you evidence of A".
 *)
Lemma my_and_project1 :
  forall A B : Prop,
    my_and A B ->
    A.
Proof.
  simplify.

  (* rule of thumb: (non-recursive) inductively defined predicate above the line, use `invert` *)
  invert H.

  (* now we have a hypothesis showing `A`! *)
  assumption.
Qed.

(* PROBLEM 4 [5 points, ~2 sentences]
 * Using your mental model for what `invert` does, explain why `invert H` adds two hypotheses,
 * one for `A` and one for `B`.
 *)
(* `invert` determines what facts are implied (in the logical sense of implication)
   by a hypothesis, and adds them as hypotheses.  In this case, my_and A B is implied
   by A and B, so `invert` deduces that they must be true as well. *)

(* PROBLEM 5 [2 points, ~4 tactics]
 * Prove the analogous property about `my_and` and its second argument.
 *
 * Hint: Similar to above. It's supposed to be easy :)
 *)
Lemma my_and_project2 :
  forall A B : Prop,
    my_and A B ->
    B.
Proof.
  simplify.
  invert H.
  assumption.
Qed.

(* PROBLEM 6 [3 points, ~6 tactics]
 * Prove that you can swap arguments to `my_and`.
 *
 * Hint: You'll need to use the rules of thumb for inductive predicates above the line
 * (like the previous problem) *and* below the line (described in the hints to
 * problem `different_trc_implies_trc`).
 *)
Lemma my_and_swap :
  forall A B : Prop,
    my_and A B ->
    my_and B A.
Proof.
  intros.
  invert H.
  constructor.
  - assumption.
  - assumption.
Qed.

(* Here's a defenition of "or". *)
Inductive my_or (A B : Prop) : Prop :=
| OrFirst : A -> my_or A B
| OrSecond : B -> my_or A B.

(* PROBLEM 7 [5 points, ~3 sentences]
 * Explain why the proof we used for `my_and_project1` doesn't work for `my_or`.
 *
 * Structure your explanation in two parts: (1) a low-level explanation of why `invert`
 * behaves differently with `my_or` compared to `my_and`; (2) a high-level explanation
 * of why the lemma statement of `my_or_project1` is just not provable.
 *
 * Hint: Start by trying to use the same proof from `my_and_project1` and see where
 * you get stuck. Then base your low-level explanation on that experience.
 *)
Lemma my_or_project1 :
  forall A B : Prop,
    my_or A B ->
    A.
Proof.
  simplify.
  invert H.
  + assumption.
  +
Abort.
(* my_or has two constructors, unlike my_and.  We know by hypothesis that my_or A B
   is true, but we don't know which constructor was used to prove it.  `invert`
   therefore requires that we prove that A follows *regardless* of which constructor
   was used.  And that cannot be proven for OrSecond.

   At a higher level, that this cannot be proven is obvious.  We are asked to prove
   that if (A || B) is true, A must be true.  Manifestly, though, (A || B) can be
   true when A is false and B is true, a counterexample. *)

(* PROBLEM 8 [2 points, ~7 tactics]
 * Prove that you can swap arguments to `my_or`.
 *
 * Hint: Use your rules of thumb.
 *)
Lemma my_or_swap :
  forall A B : Prop,
    my_or A B ->
    my_or B A.
Proof.
  intros.
  invert H.
  + apply OrSecond. assumption.
  + apply OrFirst. assumption.
Qed.

(* PROBLEM 9 [3 points, ~15 tactics]
 * Prove the following relationship between `my_and` and `my_or`.
 *
 * Hint: Use your rules of thumb.
 *)
Lemma and_or_distr :
  forall A B C : Prop,
    my_and A (my_or B C) ->
    my_or (my_and A B) (my_and A C).
Proof.
  intros.
  invert H.
  invert H1.
  - apply OrFirst. constructor.
    + assumption.
    + assumption.
  - apply OrSecond. constructor.
    + assumption.
    + assumption.
Qed.

(* --- SECTION 3: Transition systems and inductive invariants --- *)

(* In lecture 5 we looked at some transition systems that incremented numbers.
 * In the next two sections, we'll look at a transition the decrements two numbers.
 *
 * Consider the following pseudocode:
 *
 *     // initially x can be any non-negative number
 *     y = 42
 *     done = false
 *     while x > 0:
 *         x = x - 1
 *     while y > 0:
 *         y = y - 1
 *     done = true
 *     assert x == 0
 *
 * After initializing y and done, it decrements x until x is 0. Then, it decrements y
 * until it's 0. We'd like to prove that the assert at the end is always true.
 *
 * Let's encode this as a transition system. We need to define the state, initial predicate,
 * and step relation.
 *)

(* Our state will consist of the values of the three variables x, y, and done. *)
Record decr_state : Type := {
  var_x : nat;
  var_y : nat;
  var_done: bool
}.

(* Initially, x is arbitrary, y is 42, and done is false. *)
Inductive decr_init : decr_state -> Prop :=
| DecrInit :  forall nx, decr_init {| var_x := nx; var_y := 42; var_done := false |}.

(* PROBLEM 10 [3 points, ~4 LOC]
 * Give an alternate definition of decr_init using Definition instead of Inductive.
 *)
Definition decr_init_alternative (s : decr_state) : Prop :=
  exists nx,
    s = {| var_x := nx; var_y := 42; var_done := false |}.

(* PROBLEM 11 [5 points, ~10 tactics]
 * Prove your alternative definition equivalent to the original.
 *)
Lemma decr_init_alternative_ok :
  forall s,
    decr_init_alternative s <-> decr_init s.
Proof.
  intros.
  unfold decr_init_alternative.
  constructor.
  + propositional.
    invert H.
    constructor.
  + propositional.
    invert H.
    eexists.
    equality.
Qed.

(* Ok, back to encoding that program as a transition system. We're ready for the step relation.
 * There are three steps:
 *   - if x is not yet 0, we can decrement it
 *   - if x is 0, but y isn't, we can decrement y, leaving x alone
 *   - if y is 0, we set done to true
 * This is encoded with the following inductive definition.
 *)
Inductive decr_step : decr_state -> decr_state -> Prop :=
| decr_x : forall n_x n_y, decr_step {| var_x := S n_x; var_y := n_y; var_done := false |}
                                {| var_x := n_x; var_y := n_y; var_done := false|}
| decr_y : forall n_y, decr_step {| var_x := 0; var_y := S n_y; var_done := false |}
                            {| var_x := 0; var_y := n_y; var_done := false|}
| decr_var_done : forall n_x, decr_step {| var_x := n_x; var_y := 0; var_done := false |}
                                   {| var_x := n_x; var_y := 0; var_done := true |}.

(* Packaging things up into a transition system . *)
Definition decr_sys : trsys decr_state := {|
  Initial := decr_init;
  Step := decr_step
|}.

(* The safety property we want to prove is that when done is true, x is 0. *)
Definition decr_safe (s : decr_state) : Prop :=
  match s with
  | {| var_x := nx; var_y := ny; var_done := true |} => nx = 0
  | _ => True
  end.

(* PROBLEM 12 [15 points, ~30 tactics total, including 1 helper lemma]
 * Prove this transition system safe.
 *
 * Hint: First try to proceed directly by induction (using `apply invariant_induction`).
 * Think about how you get stuck in the inductive case.
 *
 * Hint: State your strengthened invariant and prove it as a helper lemma by induction.
 * Then use `invariant_weaken` to show decr_safe is also an invariant.
 *
 * Hint: As always, finding the right strengthened invariant is the hard part. It took
 * me a couple tries to get it right. Ask for help if you're stuck!
 *)
Definition decr_safe_strong (s : decr_state) : Prop :=
  match s with
  | {| var_x := nx; var_y := 0; var_done := _|} => nx = 0
  | {| var_x := nx; var_y := S _; var_done := true|} => False
  | _ => True
  end.

Theorem decr_ok_strong :
  invariantFor decr_sys decr_safe_strong.
Proof.
  apply invariant_induction.
  + intros. invert H. unfold decr_safe_strong. trivial.
  + intros. invert H0.
    - unfold decr_safe_strong. cases n_y.
      * invert H.
      * trivial.
    - unfold decr_safe_strong. cases n_y.
      * equality.
      * trivial.
    - unfold decr_safe_strong. invert H. trivial.
Qed.

Theorem decr_ok :
  invariantFor decr_sys decr_safe.
Proof.
  apply invariant_weaken with (invariant1 := decr_safe_strong).
  + apply decr_ok_strong.
  + intros.
    unfold decr_safe.
    unfold decr_safe_strong in H.
    cases s.
    cases var_done0.
    - cases var_y0.
      * assumption.
      * equality.
    - trivial.
Qed.

(* --- SECTION 4: Abstraction and model checking --- *)

(* Let' prove this invariant a different way, by using abstraction and model checking
 * to avoid having to come up with the strengthening ourselves.
 *
 * Notice that the system only really distinguishes zero and nonzero numbers. We can
 * use that to build a boolean abstraction of x and y, that just remembers whether they
 * are 0 or not.
 *
 * Here's the definition of an abstract transition system.
 *)

Record decr_bool_state : Type := {
  var_x_bool : bool;
  var_y_bool : bool;
  var_done_bool : bool
}.

(* There are now five steps, since when decrementing a variable, we distinguish between
 * whether the new value is zero or nonzero, so we get two steps for each decrement step
 * in the original system.
 *)
Inductive decr_bool_step : decr_bool_state -> decr_bool_state -> Prop :=
| decr_bool_x_more : forall b_y, decr_bool_step
                              {| var_x_bool := false; var_y_bool := b_y; var_done_bool := false |}
                              {| var_x_bool := false; var_y_bool := b_y; var_done_bool := false|}
| decr_bool_x_done : forall b_y, decr_bool_step
                              {| var_x_bool := false; var_y_bool := b_y; var_done_bool := false |}
                              {| var_x_bool := true; var_y_bool := b_y; var_done_bool := false|}
| decr_bool_y_more : decr_bool_step
                       {| var_x_bool := true; var_y_bool := false; var_done_bool := false |}
                       {| var_x_bool := true; var_y_bool := false; var_done_bool := false|}
| decr_bool_y_done : decr_bool_step
                       {| var_x_bool := true; var_y_bool := false; var_done_bool := false |}
                       {| var_x_bool := true; var_y_bool := true; var_done_bool := false|}
| decr_bool_done : forall b_x, decr_bool_step
                            {| var_x_bool := b_x; var_y_bool := true; var_done_bool := false |}
                            {| var_x_bool := b_x; var_y_bool := true; var_done_bool := true |}.

Inductive decr_bool_init : decr_bool_state -> Prop :=
| DecrBoolInit :  forall bx, decr_bool_init {| var_x_bool := bx; var_y_bool := false; var_done_bool := false |}.

Definition decr_bool_sys := {|
  Initial := decr_bool_init;
  Step := decr_bool_step
|}.

(* Our next task is to prove that this actually *is* an abstraction of the original.
 * For that, we'll use a simulation argument, so we need to define a simulation relation.
 *
 * The core of this abstraction is that the boolean version of x captures whether x is 0.
 * We formalize this as follows.
 *)
Inductive decr_R_var : nat -> bool -> Prop :=
| decr_R_var_O : decr_R_var O true
| decr_R_var_S : forall n, decr_R_var (S n) false.

(* PROBLEM 13 [3 points, ~6 tactics]
 * Prove the following lemma about decr_R_var, which says that for any natural number n,
 * n is abstracted by the boolean `Nat.eqb n 0`. (Nat.eqb is a function that compares
 * two natural numbers for equality, returning a boolean.)
 *
 * Hint: Proceed by *case analysis* on whether `n` is zero or not.
 *)
Lemma decr_R_var_eqb :
  forall n,
    decr_R_var n (Nat.eqb n 0).
Proof.
  intros.
  cases n.
  - simplify. constructor.
  - simplify. constructor.
Qed.

(* A state of the original system is related to an abstract state if x and y are related
 * by decr_R_var and the value of done is identical.
 *)
Inductive decr_R : decr_state -> decr_bool_state -> Prop :=
| Decr_R : forall n_x n_y b_x b_y done,
    decr_R_var n_x b_x ->
    decr_R_var n_y b_y ->
    decr_R {| var_x := n_x; var_y := n_y; var_done := done |}
           {| var_x_bool := b_x; var_y_bool := b_y; var_done_bool := done |}.

(* PROBLEM 14 [7 points, ~65 tactics]
 * Prove that decr_R is a simulation relation for these two systems.
 *)
Lemma decr_sim :
  simulates decr_R decr_sys decr_bool_sys.
Proof.
  constructor.
  - intros.
    cases st1.
    cases var_x0.
    + eexists.
      constructor.
      * constructor.
        -- constructor.
        -- invert H. constructor.
      * assert (var_done0 = false).
        -- invert H. equality.
        -- rewrite H0. constructor.
    + eexists.
      constructor.
      * constructor.
        -- constructor.
        -- invert H. constructor.
      * assert (var_done0 = false).
        -- invert H. equality.
        -- rewrite H0. constructor.
- intros.
    cases st1.
    cases var_x0; cases var_y0; cases var_done0.
    + invert H0.
    + eexists.
      propositional; invert H0; invert H; invert H4; invert H5; constructor; constructor.
    + invert H0.
    + cases var_y0; eexists;
      propositional; invert H0; invert H; invert H4; invert H5; constructor; constructor.
    + invert H0.
    + cases var_x0; simplify; propositional; invert H0; eexists;
      propositional; invert H; invert H4; invert H5; constructor; constructor.
    + invert H0.
    + cases var_x0; cases var_y0; eexists;
      propositional; invert H; invert H5; invert H6; invert H0; constructor; constructor.
Qed.

(* Ok, the tedious part is over. Now we can prove the original system safe
 * using model checking on the abstract system. But first, we need to express
 * the initial states of the abstract system as a finite set.
 *)
Lemma decr_bool_sys_init_set :
  decr_bool_init = { {| var_x_bool := true; var_y_bool := false; var_done_bool := false |},
                     {| var_x_bool := false; var_y_bool := false; var_done_bool := false |}
                   }.
Proof.
  apply sets_equal; simplify.
  propositional; subst.
  - invert H. destruct bx; equality.
  - constructor.
  - constructor.
Qed.

(* This line registers the lemma so that the model checker knows about it. *)
Hint Rewrite decr_bool_sys_init_set.

(* PROBLEM 15 [3 points, ~20 additional tactics]
 * Prove the system safe again, this time using model checking and abstraction.
 *)
Theorem decr_ok_via_simulation :
  invariantFor decr_sys decr_safe.
Proof.
  eapply invariant_weaken with (invariant1 := invariantViaSimulation decr_R _).
  - apply invariant_simulates with (sys2 := decr_bool_sys).
    + apply decr_sim.
    + model_check_infer.
  - intros.
    invert H. invert H1.
    + invert H0. constructor.
    + invert H0.
      invert H1; invert H2; invert H; invert H0;
      try cases done; try constructor; invert H; invert H0.
Qed.

(* --- SECTION 5: Operational semantics for expressions --- *)

(* To practice with operational semantics, let's explore using them to define the meaning
 * of arithmetic expressions, instead of using an interpreters.
 *)

(* Here's a copy of our old friend again. *)
Inductive arith : Set :=
| Const (n : nat)
| Var (x : var)
| Plus (e1 e2 : arith)
| Minus (e1 e2 : arith)
| Times (e1 e2 : arith).

Definition valuation := fmap var nat.

(* And here's the interpreter again. *)
Fixpoint interp (e : arith) (v : valuation) : nat :=
  match e with
  | Const n => n
  | Var x =>
    match v $? x with
    | None => 0
    | Some n => n
    end
  | Plus e1 e2 => interp e1 v + interp e2 v
  | Minus e1 e2 => interp e1 v - interp e2 v
  | Times e1 e2 => interp e1 v * interp e2 v
  end.

(* First, let's see how give meaning to arithmetic expressions via a big-step operational semantics. *)

(* PROBLEM 16 [3 points, ~20 LOC]
 * Complete the definition of arith_eval. The final definition will need one constructor
 * for every constructor of `arith`. We have filled in the first one for you.
 *
 * Hint: Notice how similar the case we did for you is to the corresponding case in `interp`.
 * They should all be that similar.
 *
 * Hint: It is hard to know if you got this definition right except by trying to prove the
 * problems before.
 *)
Inductive arith_eval : valuation -> arith -> nat -> Prop := (* this semantics relates a valuation and an expression to its value (a nat) *)
| ArithEvalConst : forall v n, arith_eval v (Const n) n  (* think of this as: "in any valuation, Const n evaluates to n" *)
| ArithEvalVar : forall v x, arith_eval v (Var x) (interp (Var x) v)
| ArithEvalPlus :
  forall v e1 e2 n1 n2,
    arith_eval v e1 n1 -> arith_eval v e2 n2 -> arith_eval v (Plus e1 e2) (n1 + n2)
| ArithEvalMinus :
  forall v e1 e2 n1 n2,
    arith_eval v e1 n1 -> arith_eval v e2 n2 -> arith_eval v (Minus e1 e2) (n1 - n2)
| ArithEvalTimes :
  forall v e1 e2 n1 n2,
    arith_eval v e1 n1 -> arith_eval v e2 n2 -> arith_eval v (Times e1 e2) (n1 * n2)
.
(* TODO: Is this right? *)

(* Now we have two different semantics for arithmetic expressions: `interp` and `arith_eval`.
 * Let's prove that these two semantics agree.
 *)

(* PROBLEM 17 [2 points, ~25 tactics, or many fewer using semicolons]
 * Prove the first half of the equivalence, that `interp` implies `arith_eval`.
 *
 * Hint: Proceed by induction on e.
 *)
Lemma interp_eval :
  forall v e n,
    interp e v = n ->
    arith_eval v e n.
Proof.
  induct e; intros; simplify; invert H.
  + constructor.
  + cases (v $? x).
    - assert (n = interp (Var x) v).
      * simplify. rewrite Heq. equality.
      * rewrite H. constructor.
    - assert (0 = interp (Var x) v).
      * simplify. rewrite Heq. equality.
      * rewrite H. constructor.
  + econstructor.
    - apply IHe1. equality.
    - apply IHe2. equality.
  + econstructor.
    - apply IHe1. equality.
    - apply IHe2. equality.
  + econstructor.
    - apply IHe1. equality.
    - apply IHe2. equality.
Qed.

(* PROBLEM 18 [3 points, ~10 tactics, or many fewer using semicolons]
 * Prove the second half of the equivalence, that `arith_eval` implies `interp`.
 *
 * Hint: Proceed by induction on e.
 *)
Lemma eval_interp :
  forall v e n,
    arith_eval v e n ->
    interp e v = n.
Proof.
  induct e; intros; simplify; invert H.
  + equality.
  + simplify. equality.
  + f_equal.
    - apply IHe1 in H3. assumption.
    - apply IHe2 in H5. assumption.
  + f_equal.
    - apply IHe1 in H3. assumption.
    - apply IHe2 in H5. assumption.
  + f_equal.
    - apply IHe1 in H3. assumption.
    - apply IHe2 in H5. assumption.
Qed.

(* We can also give a small-step operational semantics to arithmetic expressions. *)
(* PROBLEM 19 [5 points, ~30 LOC]
 * Fill in the definition of `arith_step`. In this semantics, an expression is "done"
 * running when it is a `Const`.
 *
 * Hint: You'll need a constructor saying how to finish evaluating a Var.
 *
 * Hint: You'll need two more constructors for Plus, one for "making progress on the left"
 * and one for "making progress on the right". These should be vaguely similar to `StepSeq1`
 * in OperationalSemantics.v.
 *
 * Hint: Minus and Times are analogous to Plus.
 *
 * Hint: You don't need a constructor corresponding to Const (for the same reason we don't
 * have a constructor corresponding to Skip in OperationalSemantics.v).
 *
 * Hint: It is hard to know if you got this definition right except by trying to prove the
 * problems before.
 *)
Inductive arith_step : valuation -> arith -> arith -> Prop := (* this semantics relates a valuation and an expression to a "next" expression *)

| ArithStepPlus : forall v n1 n2,
    arith_step v (Plus (Const n1) (Const n2)) (Const (n1 + n2))
| ArithStepPlusLeft : forall v e1 e2 e1',
    arith_step v e1 e1' -> arith_step v (Plus e1 e2) (Plus e1' e2)
| ArithStepPlusRight : forall v n1 e2 e2',
    arith_step v e2 e2' -> arith_step v (Plus (Const n1) e2) (Plus (Const n1) e2')
| ArithStepMinus : forall v n1 n2,
    arith_step v (Minus (Const n1) (Const n2)) (Const (n1 - n2))
| ArithStepMinusLeft : forall v e1 e2 e1',
    arith_step v e1 e1' -> arith_step v (Minus e1 e2) (Minus e1' e2)
| ArithStepMinusRight : forall v n1 e2 e2',
    arith_step v e2 e2' -> arith_step v (Minus (Const n1) e2) (Minus (Const n1) e2')
| ArithStepTimes : forall v n1 n2,
    arith_step v (Times (Const n1) (Const n2)) (Const (n1 * n2))
| ArithStepTimesLeft : forall v e1 e2 e1',
    arith_step v e1 e1' -> arith_step v (Times e1 e2) (Times e1' e2)
| ArithStepTimesRight : forall v n1 e2 e2',
    arith_step v e2 e2' -> arith_step v (Times (Const n1) e2) (Times (Const n1) e2')
| ArithStepVar : forall v x,
    arith_step v (Var x) (Const (interp (Var x) v))
.
(* TODO: Is this right? *)

(* Let's prove the small step semantics equivalent to the big step. *)

(* PROBLEM 20 [8 points, ~90 tactics total, including 6 helper lemmas]
 * Prove the first half of the equivalence, that the big step implies the
 * (transitive-reflexive closure of) the small step.
 *)
Lemma arith_eval_step :
  forall v e n,
    arith_eval v e n ->
    (arith_step v)^* e (Const n).
Proof.
  induct 1.
  - constructor.
  - econstructor.
    + econstructor.
    + econstructor.
  - econstructor.
    + admit.
    + econstructor.
  - econstructor.
    + admit.
    + econstructor.
  - econstructor.
    + admit.
    + econstructor.
Admitted. (* Change to Qed when done *)

(* PROBLEM 21 [8 points, ~65 tactics total, including 2 helper lemmas]
 * Prove the second half of the equivalence, that the (transitive-reflexive closure of)
 * the small step implies the big step.
 *)
Lemma arith_step_eval :
  forall v e n,
    trc (arith_step v) e (Const n) ->
    arith_eval v e n.
Proof.
  induct 1.
  - econstructor.
  - invert H. invert H0.
      + econstructor.
      + invert H.
      + invert H0. invert H1. invert H. invert H2. econstructor. invert H.
Admitted. (* Change to Qed when done *)


From LF Require Export Basics.

Theorem add_0_l_firsttry: forall n:nat,
  0 + n = n.
Proof. simpl. reflexivity. Qed.
(** it can be done simply with reflexivity.**)

Theorem add_0_r_firsttry: forall n:nat,
  n + 0 = n.
Proof.
  intros n.
  destruct n as [|n'] eqn:E.
  - simpl. reflexivity.
  - simpl. Abort.
(** If we try to use reflexivity
above, we get Unable to unify "S n" with "S (n + 0)"
because S n is a inductive type, we would need to
destruct it again. **)

(** Given a proposition P, we need to:
  1 - show that P(O) holds;
  2 - show that, for any n', if P(n') holds, then so does P(S n');
  conclude that P(n) holds for all n.
**)

Theorem add_0_r : forall n: nat, n + 0 = n.
Proof.
  intros n. induction n as [| n' IHn']. (*n: the arbitrary natural number, IHn': the inductive hypothesis.*)
  - reflexivity.
  - simpl.
    rewrite IHn'. reflexivity. Qed.

(**
  the inductive tactics here replaces n' + 0 = n' by S n' + 0 = S n',
  what is: we are effectively applying the second criteria we defined
  from the principle of Induction.
**)

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

(** Exercise 1 - basic induction, 2 stars **)
Theorem mul_0_r: forall n: nat, n * 0 = 0.
Proof.
  intros n. induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite IHn'. reflexivity. Qed.

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

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

Theorem add_assoc : forall n m p: nat,
  n + (m + p) = (n + m) + p.
Proof.
  intros n m p.
  induction n as [| n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite IHn'. reflexivity.
  Qed.

(** Exercise 2 - double plus, 2 stars**)

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

(** Use induction to prove this fact **)
Lemma double_plus: forall n, double n = n + n.
Proof.
  induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite IHn'. rewrite plus_n_Sm. reflexivity.
  Qed.

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

(** Optional exercise - using induction to prove a lemma about even function **)
Theorem even_S : forall n : nat,
  even (S n) = negb (even n).
Proof.
  induction n as [| n' IHn'].
  - reflexivity.
  - rewrite IHn'.
    rewrite negb_involutive.
    simpl. reflexivity.
Qed.

(** Differences destruct and induction **)

(**

  TL;DR Their main difference is the subgoal hypothesis.

  The destruct tactic gives us a subgoal for each constructor of
  an inductive type. It means that we have to prove that a proposition
  holds for both O or S n' for a nat type, for example.
  This creates as many goals as there are constructors in type T.

  On the other hand, induction generates subgoals as many as
  there are constructors, and adds the inductive hypotheses in
  the contexts.

**)

(* ################################################################# *)
(** * Proofs Within Proofs *)
(** Assert is a way to create a quick proof
  about some statement, that is used in the goal
  we are trying to prove.

  Assert generates:
  1 - A subgoal where we must prove the asserted fact
  2 - A second subgoal where we can use the asserted
  fact to make progress on whatever we were trying to
  prove in the first place.
**)

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

Theorem plus_rearrange_firsttry : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  (* We just need to swap (n + m) for (m + n)... seems
     like add_comm should do the trick! *)
  rewrite add_comm.
  (* Doesn't work... Coq rewrites the wrong plus! :-( *)
Abort.

(** To use [add_comm] at the point where we need it, we can introduce
    a local lemma stating that [n + m = m + n] (for the _particular_ [m]
    and [n] that we are talking about here), prove this lemma using
    [add_comm], and then use it to do the desired rewrite. *)

Theorem plus_rearrange : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  assert (H: n + m = m + n).
  { rewrite add_comm. reflexivity. }
  rewrite H. reflexivity.  Qed.

(* ################################################################# *)
(** * Formal vs. Informal Proof *)

(* TODO *)

(* ################################################################# *)
(** * More Exercises *)

(** In the theorem below, assert helps us
  to change the order of elements; after
  the two rewrites, we get n + m + p = m + n + p
  what is, we only need to change the positions
  of m and n, so assert does it for us here.
  Basically we use the same hypothesis defined
  previously, but we are kind of telling
  Coq how to replace stuff properly.**)

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

(** Commutativity of multiplication **)

(**
  Before proving the commutativity of multiplication, we have
  to prove that the multiplication distributes over addition.
**)

Theorem mul_dist: forall n m: nat,
  n * (S m) = n + n * m.
  intros n m.
  induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite IHn'.
    rewrite add_shuffle3.
    reflexivity.
  Qed.

Theorem mul_comm: forall n m: nat,
  m * n = n * m.
Proof.
  intros m n.
  induction n as [| n' IHn'].
  - simpl. rewrite mul_0_r. reflexivity.
  - simpl.
    rewrite IHn'.
    rewrite mul_dist.
    reflexivity.
    Qed.

(**
  The goal for the exercises below is to
  think about the necessity for the use of
  simplification and rewriting, case analysis
  (destruct) or if it also requires induction.

  My hypothesis: when the case is covered in the
  definition, it can be checked with simpl, which
  does an "unfolding".
 **)

Check leb.

(** Requires induction bc is an arbitrary number **)
Theorem leb_refl: forall n: nat,
  (n <=? n) = true.
Proof.
  induction n as [| n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite IHn'. reflexivity.
  Qed.

(** simpl, because this case is defined
   **)

Theorem zero_neqb_S : forall n:nat,
  0 =? (S n) = false.
Proof. (*simp: same as unfold eqb here*)
  simpl. reflexivity.
Qed.

(** case analysis bc the match takes
  the first argument first **)
Theorem andb_false_r : forall b : bool,
  andb b false = false.
Proof.
  destruct b.
  - reflexivity.
  - reflexivity.
  Qed.

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

(* simpl, because this case is already defined in eqb *)
Theorem S_neqb_0 : forall n:nat,
  (S n) =? 0 = false.
Proof.
  simpl. reflexivity. Qed.

(**
  Needs induction, to create a hypothesis that
  holds for both 0 and S n.
**)

Theorem mult_1_l : forall n:nat, 1 * n = n.
Proof.
  induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite add_comm. reflexivity.
Qed.

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

(* Rewrite with mult_dist after induction on n *)

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

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

(** [] *)

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

(**
  We can specify a particular subterm to
  perform the rewrite using replace (t) with (u).

  Previously, we have defined that n + m = m + n
  with the use of the keyword "assert". Assert
  generates a hypothesis and a subgoal to prove
  that hypothesis.

  By using replace, we edit the goal directly and
  have to prove that this rewriting is possible
  as a subgoal.
**)

Theorem add_shuffle3': forall n m p: nat,
  n + (m + p) = m + (n + p).
Proof.
  intros n m p.
  rewrite add_assoc.
  rewrite add_assoc.
  replace (n + m) with (m + n).
  - reflexivity.
  - rewrite add_comm. reflexivity.
  Qed.

(** **** Exercise: 3 stars, standard, especially useful (binary_commute) **)
(* TODO *)


(*
  Team Members:
	Chenglong Wang
	Dalton Black
*)

(* Homework 01 (90 total points) *)

(*
  In this homework, you'll do some programming in Coq and do some simple proofs.

  Each problem should be independent of the others, but subproblems
   may depend on each other.

  Later problems aren't necessarily harder than earlier ones, so if you get
   stuck on a problem, move on and come back to it later.

  You'll know most of what you need for this homework after the first lecture,
   and everything by the second. Get started early so you have time to ask questions!

  For all proofs, please use bullets ( -, +, * ) as shown in class. For this homework,
   we won't take points off for proof style, but we may start doing so in future.

*)

(* Multiplication of natural numbers, used in problem 1 *)
Fixpoint mult m n :=
  match m with
    | 0 => 0
    | S m' => plus n (mult m' n)
  end.

(* [PROBLEM 1 (5 points)]: Prove that multiplication by 1 is the identity.
   Hint: this should be similar to add_O from Lecture 1 *)

Lemma mult_1 :
  forall m,
    mult m 1 = m.
Proof.
  (* about 7 tactics *)
  intros m.
  induction m.
  - simpl. reflexivity.
  - simpl.
    rewrite IHm.
    reflexivity.
Qed.
(* Change "Admitted" to "Qed" when the proof is completed. *)
(* END PROBLEM 1 *)

(* Decide if two nats are equal *)
Fixpoint nat_eq (m n: nat) : bool :=
  match m, n with
    | O, O => true
    | S mp, S np => nat_eq mp np
    | _, _ => false
  end.

(* [PROBLEM 2 (10 points)]:
    a (5 points). Correct the definition of nat_le, which returns
      true when m is less than or equal to n and false otherwise.
      Hint: this definition should be similar to nat_eq
    b (5 points). Complete the proof of nat_eq_nat_le, which states
      that if m = n, then m <= n.
      Hint: as is often the case, you may want to induct before intro-ing.
*)

Fixpoint nat_le (m n : nat) : bool :=
  (* fix this definition *)
  match m, n with
    | O, _ => true
    | S mp, S np => nat_le mp np
    | _, _ => false
  end.

(* Use these to test your function *)
Eval cbv in (nat_le 5 5). (* true *)
Eval cbv in (nat_le 3 5). (* true *)
Eval cbv in (nat_le 5 3). (* false *)

Theorem nat_eq_nat_le :
  forall m n,
    nat_eq m n = true ->
    nat_le m n = true.
Proof.
  (* about 10 tactics *)
  induction m.
  intros.
  - simpl. reflexivity.
  - intros.
    rewrite <- H.
    simpl.
    destruct n.
    + reflexivity.
    + simpl in H.
      rewrite IHm.
      * rewrite H. reflexivity.
      * rewrite H. reflexivity.
Qed.

Theorem nat_eq_nat_le_secondtry :
  forall m n,
    nat_eq m n = true ->
    nat_le m n = true.
Proof.
  induction m.
  - intros. simpl. reflexivity.
  - intros. simpl.
    destruct n.
    + inversion H.
    + simpl in H.
      apply IHm.
      apply H.
Qed.

(* END PROBLEM 2 *)

(* The following definitions are used in Problems 3-4 *)

(* "Counting" numbers *)

Inductive counting : Set :=
| one : counting
| next : counting -> counting.

(* integers *)
Inductive int : Set :=
| zero : int
| pos : counting -> int
| neg : counting -> int.

(* [PROBLEM 3 (8 points)]: Here are two other possible definitions of the integers:

Inductive int1 :=
| O : int1
| pred : int1 -> int1
| succ : int1 -> int1.

Inductive int2 :=
| pos : nat -> int2
| neg : nat -> int2.

Fixpoint pos_int (int : int1, intb : int 1) :=
  match int with
  | O -> false
  | pred n1, succ n2 ->

pred (succ (pred (succ O)))

What is a potenial problem with these definitions? Explain briefly in a comment.

My opinion: 1) Given an integer, we cannot get its sign from it without using another type. (first one)
            2) Comparing the equivalence/greater/less relations of two integer is not possible  (first one)
            3) pos O and neg O, equivlence is not defined. (second one)
*)

(* END PROBLEM 3 *)

(* Predecessor of an integer. Used in Problem 4. *)
Definition pred (x : int) : int :=
  match x with
    | zero => neg one
    | pos n => match n with
                | one => zero
                | next n' => pos n'
              end
    | neg n => neg (next n)
  end.

(* [Problem 4 (12 points)]:
   a (6 points). Correct the definition of succ, below.
      succ should return the successor of its argument,
       i.e., the next larger integer.
   b (6 points). Complete the proofs of pred_succ and succ_pred.
      Hint: induction is not necessary.
 *)

Definition succ (x : int) : int :=
  match x with
    | zero => pos one
    | pos n => pos (next n)
    | neg n =>
        match n with
          | one => zero
          | next n2 => neg n2
        end
    end.

Lemma pred_succ :
  forall x, pred (succ x) = x.
Proof.
  (* about 12 tactics *)
  intros x.
  destruct x.
  - simpl. reflexivity.
  - simpl. reflexivity.
  - destruct c.
    + simpl. reflexivity.
    + simpl. reflexivity.
Qed.

Lemma succ_pred :
  forall x, succ (pred x) = x.
Proof.
  (* about 12 tactics *)
  intros x.
  destruct x.
  - simpl. reflexivity.
  - simpl.
    destruct c.
    + simpl. reflexivity.
    + simpl. reflexivity.
  - simpl. reflexivity.
Qed.
(* END PROBLEM 4 *)

(* Binary trees of nats. Used in the remaining problems. *)
Inductive nat_tree : Set :=
| Leaf : nat_tree
| Branch : nat -> nat_tree -> nat_tree -> nat_tree.

(* size returns the number of nats in a tree. *)
Fixpoint size (nt: nat_tree) : nat :=
  match nt with
    | Leaf => 0
    | Branch n ntl ntr => S (plus (size ntl) (size ntr))
  end.

(* [PROBLEM 5 (5 points)]: Define sum to add up all the nats in a nat_tree. *)

Fixpoint sum (nt: nat_tree) : nat :=
  match nt with
  | Leaf => 0
  | Branch n ntl ntr => plus n (plus (sum ntl) (sum ntr))
  end.

(* END PROBLEM 5 *)

(* [PROBLEM 6 (5 points)]: Define prod to multiply all the nats in a nat_tree.
     Hint: prod should call mult, defined above. *)

Fixpoint prod (nt: nat_tree) : nat :=
  match nt with
  | Leaf => 0
  | Branch n ntl ntr => mult n (mult (prod ntl) (prod ntr))
  end.

(* END PROBLEM 6 *)

(* fold over nat_trees *)
Fixpoint fold {T: Type} (base: T) (f: T -> nat -> T) (nt: nat_tree) : T :=
  match nt with
    | Leaf => base
    | Branch n l r => f (fold (fold base f l) f r) n
  end.

(* [PROBLEM 7 (3 points)]: Define sum' to add up all the nats in a nat_tree.
For full credit, do not use recursion (keep the Definition, don't change to Fixpoint).
*)

Check (fold 0).

Definition sum' (nt: nat_tree):=
  fold 0 plus nt.

Eval cbv in (sum' (Branch 1 (Branch 3 Leaf (Branch 9 Leaf Leaf)) Leaf)).

(* END PROBLEM 7 *)

(* [PROBLEM 8 (3 points)]: Define prod' to multiply up all the nats in a nat_tree.
For full credit, do not use recursion (keep the Definition, don't change to Fixpoint).
 *)

Definition prod' (nt: nat_tree):= fold 1 mult nt.

Eval cbv in (prod' (Branch 1 (Branch 3 Leaf (Branch 9 Leaf Leaf)) Leaf)).

(* END PROBLEM 8 *)

(* [PROBLEM 9 (5 points)]: Define increment_all to add one to all the nats in a nat_tree.
*)

Fixpoint increment_all (nt: nat_tree) : nat_tree :=
  match nt with
  | Leaf => Leaf
  | Branch n l r => Branch (plus 1 n) (increment_all l) (increment_all r)
  end.

Eval cbv in (increment_all (Branch 1 (Branch 3 Leaf (Branch 9 Leaf Leaf)) Leaf)).

(* END PROBLEM 9 *)

(* [PROBLEM 10 (5 points)]: Define double to multiply all the nats in a nat_tree by 2.
*)

Fixpoint double (nt: nat_tree) : nat_tree :=
  match nt with
  | Leaf => Leaf
  | Branch n l r => Branch (mult n 2) (double l) (double r)
  end.

Eval cbv in (double (Branch 1 (Branch 3 Leaf (Branch 9 Leaf Leaf)) Leaf)).

(* END PROBLEM 10 *)

(* [PROBLEM 11 (12 points)]:
   a (6 points). Define map to apply a function of type nat -> nat
     to every nat in a nat_tree.
     The resulting tree should have exactly the same structure as the initial tree.
   b (6 points). Complete the proof of size_map, which proves that map preserves the
     size of a tree.
 *)

Fixpoint map (f: nat -> nat) (nt: nat_tree) : nat_tree :=
   match nt with
    | Leaf => Leaf
    | Branch n l r => Branch (f n) (map f l) (map f r)
   end.

Theorem size_map : forall f t, size (map f t) = size t.
Proof.
  (* about 7 tactics *)
  induction t.
  - simpl. reflexivity.
  - simpl.
    rewrite IHt1.
    rewrite IHt2.
    reflexivity.
Qed.

(* END PROBLEM 11 *)

(* [PROBLEM 12 (12 points)]:
   a (6 points). Define mirror to flip all the branches in the tree:
               5              5
              / \            / \
             3   4     =>   4   3
            / \                / \
           1   6              6   1
      (leaves are not displayed above)
   b (6 points). Complete the proof of size_mirror, which proves that mirror preserves the
     size of a tree.
*)

Lemma add_O :
  forall n,
    n + O = n.
Proof.
  intro n.
  induction n.
  - simpl. reflexivity.
  - simpl.
    rewrite IHn. (** find the left-hand side of IHn in the goal
                    and replace it by the right-hand side *)
    reflexivity.
Qed.

Theorem S_n_m :
  forall n m,
    S (n + m) = n + S m.
Proof.
  induction n.
  - intros. reflexivity.
  - intros. simpl. rewrite IHn. reflexivity.
Qed.

Theorem add_comm :
  forall m n,
    m + n = n + m.
Proof.
  induction m.
  - intros. simpl. rewrite add_O. reflexivity.
  - intros. simpl. rewrite IHm.
    rewrite S_n_m. reflexivity.
Qed.

Fixpoint mirror (nt: nat_tree) : nat_tree :=
  (* fill in your definition of mirror here *)
  match nt with
    | Leaf => Leaf
    | Branch n l r => Branch n (mirror r) (mirror l)
   end.

Theorem size_mirror : forall t, size (mirror t) = size t.
Proof.
  (* about 8 tactics *)
  induction t.
  - simpl. reflexivity.
  - simpl.
    rewrite IHt1.
    rewrite IHt2.
    rewrite add_comm.
    reflexivity.
Qed.

Eval cbv in (mirror (Branch 1 (Branch 3 Leaf (Branch 9 Leaf Leaf)) Leaf)).

(* END PROBLEM 12 *)

(* [PROBLEM 13 (10 points)]:
Consider this alternate definition of fold:
*)
Fixpoint fold' {T: Type} (base: T) (f: T -> nat -> T) (nt: nat_tree) : T :=
  match nt with
    | Leaf => base
    | Branch n l r => fold' (f (fold' base f l) n) f r
  end.
(*
In a short English paragraph, describe how fold and fold' differ.
*)

(* WRITE HERE *)

(*Answer: The difference between these two functions is that the fold function would firstly
compute the value of the left tree, then compute the value of the right tree based
on the result of left tree, then finally add the value of the current node to the
computation result after finished computing the right sub tree. However, the fold'
function would 1) visit the left tree, 2) compute the value of the current node to
the result and then 3) compute the value of the right tree based on the result.

In another word, fold visits the tree in post-order (after the the visit of both
left and right sub tree) while fold' visits the tree in in-order (visit the left
sub-tree, then the current node, and finally the rightsub-tree).

These functions can produce different results if f is not commutative.
 *)

(* END PROBLEM 13 *)

(*
OPTIONAL Bonus:

What should be true about a particular f for the following to hold:

  forall b nt, fold b f nt = fold' b f nt

  (* TODO write here *)
  The condition is that: forall x:T y:nat z:nat f (f x y) z = f (f x z) y.

Optional Bonus 2: Formalize this property in Coq, and prove that
  forall f b nt, <property> f -> fold b f nt = fold' b f nt.
*)

(* Lemma f_fold': forall f nt, (forall y z (x:bool), f (f x y) z = f (f x z) y)
  -> forall  u v, f (fold' u f nt) v = fold' (f u v) f nt.
Proof.
  induction nt.
  - simpl. reflexivity.
  - simpl.
    intros.
    rewrite <- IHnt1.
    rewrite H.
    rewrite -> IHnt2.
    reflexivity.
    * apply H.
    * apply H.
Qed.
*)
Lemma f_fold: forall f nt, (forall y z (x:bool),
  f (f x y) z = f (f x z) y) ->
      forall  u v, f (fold u f nt) v = fold (f u v) f nt.
Proof.
  induction nt.
  - simpl. reflexivity.
  - simpl.
    intros.
    rewrite <- IHnt1.
    rewrite H.
    rewrite -> IHnt2.
    reflexivity.
    * apply H.
    * apply H.
Qed.

Lemma zach: forall f nt b, (forall y z (x:bool), f (f x y) z = f (f x z) y)
  -> fold b f nt = fold' b f nt.
Proof.
  induction nt.
  - simpl. reflexivity.
  - simpl.
    intros.
    rewrite <- IHnt1.
    + destruct nt1.
      *  simpl. rewrite f_fold.
         intros. rewrite <- IHnt2.
          reflexivity. apply H. apply H.
      * simpl. rewrite f_fold.
        rewrite <- IHnt2.
        reflexivity. apply H. apply H.
    + apply H.
Qed.


Require Import Arith.
Require Import List.
Require Extraction.

Print nat.

Definition plus2 n := n+2.

Fixpoint factorial n :=
  match n with
    0 => 1
  | S m => n*fact m
end.

Eval compute in factorial 3.

Print list.

Check @nil nat.

Check @nil.

Check nil.

Check @cons.

Check cons 3 nil.

Check @cons nat 3 nil.

Fixpoint map (A B: Type)(f: A-> B) l :=
  match l with
    nil => nil
  | x::xs => (f x) ::  map A B f xs
end.

Check map.

Fixpoint mapi {A B: Type}(f: A-> B) l :=
  match l with
    nil => nil
  | x::xs => (f x) ::  mapi f xs
end.

Check mapi.

(* Types are first-class values *)

Fixpoint AddernatType (n:nat) :=
match n with
  0 => nat
| (S k) => nat -> AddernatType k
end.

Check AddernatType.

Fixpoint addernat (numargs : nat) (acc: nat): AddernatType numargs :=
match numargs with
  0 => acc
| (S k) => fun next => addernat k (next + acc)
end.

Eval compute in (addernat 3 0 1 2 3).

(* Propositions and proofs are first-class values *)

Fixpoint len {A: Type} (l: list A) :=
  match l with
    nil => 0
  | x::xs => 1 + len xs
end.

Check len.

Lemma lenEqZero: forall A (l:list A), length l = 0 -> l = nil.
Proof.
intros.
destruct l.
* trivial.
* simpl in H.
  congruence.
Qed.

Print lenEqZero.

Print le.
Print "<=".
Print "<".
Print ">".

Lemma lenGeZero: forall A (l:list A), 0 <= length l.
Proof.
intros.
induction l.
- simpl. trivial.
- simpl. constructor. trivial.
Qed.

Check lenGeZero.
Print lenGeZero.

(* forall A (l:list A), 0 <= length l is a dependent type...*)

Inductive vector {T:Type} : nat -> Type :=
  | Vnil : vector 0
  | Vcons : forall n, T -> vector n -> vector (S n).

Check @Vcons.

Definition vhead {T:Type}{n:nat}(v:vector (S n)):T :=
match v with
  Vcons n h t => h
end.

Extraction vector.
Extraction vhead.

(* congruence - decision procedure for ground equlities
                with uninterpreted symbols *)

Lemma T (A:Type) (f:A -> A) (g: A -> A -> A) a b:
a=(f a) -> (g b (f a))=(f (f a)) -> (g a b = f (g b a)) -> g a b = a.
Proof.
intros.
congruence.
Qed.