(** * Prop: Propositions and Evidence *)

Require Export Logic.

(* ####################################################### *)
(** * From Boolean Functions to Propositions *)

(** In chapter [Basics] we defined a _function_ [evenb] that tests a
    number for evenness, yielding [true] if so.  We can use this
    function to define the _proposition_ that some number [n] is
    even: *)

Definition even (n:nat) : Prop :=
  evenb n = true.

(** That is, we can define "[n] is even" to mean "the function [evenb]
    returns [true] when applied to [n]."

    Note that here we have given a name
    to a proposition using a [Definition], just as we have
    given names to expressions of other sorts. This isn't a fundamentally
    new kind of proposition;  it is still just an equality. *)

(** Another alternative is to define the concept of evenness
    directly.  Instead of going via the [evenb] function ("a number is
    even if a certain computation yields [true]"), we can say what the
    concept of evenness means by giving two different ways of
    presenting _evidence_ that a number is even. *)

(** * Inductively Defined Propositions *)

Inductive ev : nat -> Prop :=
  | ev_0 : ev O
  | ev_SS : forall n:nat, ev n -> ev (S (S n)).

(** This definition says that there are two ways to give
    evidence that a number [m] is even.  First, [0] is even, and
    [ev_0] is evidence for this.  Second, if [m = S (S n)] for some
    [n] and we can give evidence [e] that [n] is even, then [m] is
    also even, and [ev_SS n e] is the evidence. *)

(** **** Exercise: 1 star (double_even) *)

Theorem double_even : forall n,
  ev (double n).
Proof.
  intros n. induction n as [|n'].
  - apply ev_0.
  - simpl. apply ev_SS. apply IHn'.
Qed.
(** [] *)

(** *** Discussion: Computational vs. Inductive Definitions *)

(** We have seen that the proposition "[n] is even" can be
    phrased in two different ways -- indirectly, via a boolean testing
    function [evenb], or directly, by inductively describing what
    constitutes evidence for evenness.  These two ways of defining
    evenness are about equally easy to state and work with.  Which we
    choose is basically a question of taste.

    However, for many other properties of interest, the direct
    inductive definition is preferable, since writing a testing
    function may be awkward or even impossible.

    One such property is [beautiful].  This is a perfectly sensible
    definition of a set of numbers, but we cannot translate its
    definition directly into a Coq Fixpoint (or into a recursive
    function in any other common programming language).  We might be
    able to find a clever way of testing this property using a
    [Fixpoint] (indeed, it is not too hard to find one in this case),
    but in general this could require arbitrarily deep thinking.  In
    fact, if the property we are interested in is uncomputable, then
    we cannot define it as a [Fixpoint] no matter how hard we try,
    because Coq requires that all [Fixpoint]s correspond to
    terminating computations.

    On the other hand, writing an inductive definition of what it
    means to give evidence for the property [beautiful] is
    straightforward. *)

(** **** Exercise: 1 star (ev__even) *)
(** Here is a proof that the inductive definition of evenness implies
    the computational one. *)

Theorem ev__even : forall n,
  ev n -> even n.
Proof.
  intros n E. induction E as [| n' E'].
  Case "E = ev_0".
    unfold even. reflexivity.
  Case "E = ev_SS n' E'".
    unfold even. apply IHE'.
Qed.

(** Could this proof also be carried out by induction on [n] instead
    of [E]?  If not, why not? *)

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

(** The induction principle for inductively defined propositions does
    not follow quite the same form as that of inductively defined
    sets.  For now, you can take the intuitive view that induction on
    evidence [ev n] is similar to induction on [n], but restricts our
    attention to only those numbers for which evidence [ev n] could be
    generated.  We'll look at the induction principle of [ev] in more
    depth below, to explain what's really going on. *)

(** **** Exercise: 1 star (l_fails) *)
(** The following proof attempt will not succeed.
     Theorem l : forall n,
       ev n.
     Proof.
       intros n. induction n.
         Case "O". simpl. apply ev_0.
         Case "S".
           ...
   Intuitively, we expect the proof to fail because not every
   number is even. However, what exactly causes the proof to fail?

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

(** **** Exercise: 2 stars (ev_sum) *)
(** Here's another exercise requiring induction. *)

Theorem ev_sum : forall n m,
   ev n -> ev m -> ev (n+m).
Proof.
  intros. induction H as [|n' E'].
  - apply H0.
  - simpl. apply ev_SS. apply IHE'.
Qed.
(** [] *)

(* ##################################################### *)
(** ** Example *)

(**  As a running example, let's
    define a simple property of natural numbers -- we'll call it
    "[beautiful]." *)

(** Informally, a number is [beautiful] if it is [0], [3], [5], or the
    sum of two [beautiful] numbers.

    More pedantically, we can define [beautiful] numbers by giving four
    rules:

       - Rule [b_0]: The number [0] is [beautiful].
       - Rule [b_3]: The number [3] is [beautiful].
       - Rule [b_5]: The number [5] is [beautiful].
       - Rule [b_sum]: If [n] and [m] are both [beautiful], then so is
         their sum. *)
(** ** Inference Rules *)
(** We will see many definitions like this one during the rest
    of the course, and for purposes of informal discussions, it is
    helpful to have a lightweight notation that makes them easy to
    read and write.  _Inference rules_ are one such notation: *)
(**
                              -----------                               (b_0)
                              beautiful 0

                              ------------                              (b_3)
                              beautiful 3

                              ------------                              (b_5)
                              beautiful 5

                       beautiful n     beautiful m
                       ---------------------------                      (b_sum)
                              beautiful (n+m)
*)

(** *** *)
(** Each of the textual rules above is reformatted here as an
    inference rule; the intended reading is that, if the _premises_
    above the line all hold, then the _conclusion_ below the line
    follows.  For example, the rule [b_sum] says that, if [n] and [m]
    are both [beautiful] numbers, then it follows that [n+m] is
    [beautiful] too.  If a rule has no premises above the line, then
    its conclusion holds unconditionally.

    These rules _define_ the property [beautiful].  That is, if we
    want to convince someone that some particular number is [beautiful],
    our argument must be based on these rules.  For a simple example,
    suppose we claim that the number [5] is [beautiful].  To support
    this claim, we just need to point out that rule [b_5] says so.
    Or, if we want to claim that [8] is [beautiful], we can support our
    claim by first observing that [3] and [5] are both [beautiful] (by
    rules [b_3] and [b_5]) and then pointing out that their sum, [8],
    is therefore [beautiful] by rule [b_sum].  This argument can be
    expressed graphically with the following _proof tree_: *)
(**
         ----------- (b_3)   ----------- (b_5)
         beautiful 3         beautiful 5
         ------------------------------- (b_sum)
                   beautiful 8
*)
(** *** *)
(**
    Of course, there are other ways of using these rules to argue that
    [8] is [beautiful], for instance:
         ----------- (b_5)   ----------- (b_3)
         beautiful 5         beautiful 3
         ------------------------------- (b_sum)
                   beautiful 8
*)

(** **** Exercise: 1 star (varieties_of_beauty) *)
(** How many different ways are there to show that [8] is [beautiful]? *)

(* infinitely many *)
(** [] *)

(** *** *)
(** In Coq, we can express the definition of [beautiful] as
    follows: *)

Inductive beautiful : nat -> Prop :=
  b_0   : beautiful 0
| b_3   : beautiful 3
| b_5   : beautiful 5
| b_sum : forall n m, beautiful n -> beautiful m -> beautiful (n+m).

(** The first line declares that [beautiful] is a proposition -- or,
    more formally, a family of propositions "indexed by" natural
    numbers.  (That is, for each number [n], the claim that "[n] is
    [beautiful]" is a proposition.)  Such a family of propositions is
    often called a _property_ of numbers.  Each of the remaining lines
    embodies one of the rules for [beautiful] numbers.
*)
(** *** *)
(**
    The rules introduced this way have the same status as proven
    theorems; that is, they are true axiomatically.
    So we can use Coq's [apply] tactic with the rule names to prove
    that particular numbers are [beautiful].  *)

Theorem three_is_beautiful: beautiful 3.
Proof.
   (* This simply follows from the rule [b_3]. *)
   apply b_3.
Qed.

Theorem eight_is_beautiful: beautiful 8.
Proof.
   (* First we use the rule [b_sum], telling Coq how to
      instantiate [n] and [m]. *)
   apply b_sum with (n:=3) (m:=5).
   (* To solve the subgoals generated by [b_sum], we must provide
      evidence of [beautiful 3] and [beautiful 5]. Fortunately we
      have rules for both. *)
   apply b_3.
   apply b_5.
Qed.

(** *** *)
(** As you would expect, we can also prove theorems that have
hypotheses about [beautiful]. *)

Theorem beautiful_plus_eight: forall n, beautiful n -> beautiful (8+n).
Proof.
  intros n B.
  apply b_sum with (n:=8) (m:=n).
  apply eight_is_beautiful.
  apply B.
Qed.

(** **** Exercise: 2 stars (b_times2) *)
Theorem b_times2: forall n, beautiful n -> beautiful (2*n).
Proof.
  intros. apply b_sum. apply H. rewrite plus_0_r. apply H.
Qed.
(** [] *)

(** **** Exercise: 3 stars (b_timesm) *)
Theorem b_timesm: forall n m, beautiful n -> beautiful (m*n).
Proof.
  intros. induction m as [|m'].
  - simpl. apply b_0.
  - simpl. apply b_sum. apply H. apply IHm'.
Qed.
(** [] *)

(* ####################################################### *)
(** ** Induction Over Evidence *)

(** Besides _constructing_ evidence that numbers are beautiful, we can
    also _reason about_ such evidence. *)

(** The fact that we introduced [beautiful] with an [Inductive]
    declaration tells Coq not only that the constructors [b_0], [b_3],
    [b_5] and [b_sum] are ways to build evidence, but also that these
    four constructors are the _only_ ways to build evidence that
    numbers are beautiful. *)

(** In other words, if someone gives us evidence [E] for the assertion
    [beautiful n], then we know that [E] must have one of four shapes:

      - [E] is [b_0] (and [n] is [O]),
      - [E] is [b_3] (and [n] is [3]),
      - [E] is [b_5] (and [n] is [5]), or
      - [E] is [b_sum n1 n2 E1 E2] (and [n] is [n1+n2], where [E1] is
        evidence that [n1] is beautiful and [E2] is evidence that [n2]
        is beautiful). *)

(** *** *)
(** This permits us to _analyze_ any hypothesis of the form [beautiful
    n] to see how it was constructed, using the tactics we already
    know.  In particular, we can use the [induction] tactic that we
    have already seen for reasoning about inductively defined _data_
    to reason about inductively defined _evidence_.

    To illustrate this, let's define another property of numbers: *)

Inductive gorgeous : nat -> Prop :=
  g_0 : gorgeous 0
| g_plus3 : forall n, gorgeous n -> gorgeous (3+n)
| g_plus5 : forall n, gorgeous n -> gorgeous (5+n).

(** **** Exercise: 1 star (gorgeous_tree) *)
(** Write out the definition of [gorgeous] numbers using inference rule
    notation.

(* FILL IN HERE *)
[]
*)

(** **** Exercise: 1 star (gorgeous_plus13) *)
Theorem gorgeous_plus13: forall n,
  gorgeous n -> gorgeous (13+n).
Proof.
  intros. apply g_plus5. apply g_plus5. apply g_plus3. apply H.
Qed.
(** [] *)

(** *** *)
(** It seems intuitively obvious that, although [gorgeous] and
    [beautiful] are presented using slightly different rules, they are
    actually the same property in the sense that they are true of the
    same numbers.  Indeed, we can prove this. *)

Theorem gorgeous__beautiful : forall n,
  gorgeous n -> beautiful n.
Proof.
   intros n H.
   induction H as [|n'|n'].
   Case "g_0".
       apply b_0.
   Case "g_plus3".
       apply b_sum. apply b_3.
       apply IHgorgeous.
   Case "g_plus5".
       apply b_sum. apply b_5. apply IHgorgeous.
Qed.

(** Notice that the argument proceeds by induction on the _evidence_ [H]! *)

(** Let's see what happens if we try to prove this by induction on [n]
   instead of induction on the evidence [H]. *)

Theorem gorgeous__beautiful_FAILED : forall n,
  gorgeous n -> beautiful n.
Proof.
   intros. induction n as [| n'].
   Case "n = 0". apply b_0.
   Case "n = S n'". (* We are stuck! *)
Abort.

(** The problem here is that doing induction on [n] doesn't yield a
    useful induction hypothesis. Knowing how the property we are
    interested in behaves on the predecessor of [n] doesn't help us
    prove that it holds for [n]. Instead, we would like to be able to
    have induction hypotheses that mention other numbers, such as [n -
    3] and [n - 5]. This is given precisely by the shape of the
    constructors for [gorgeous]. *)

(** **** Exercise: 2 stars (gorgeous_sum) *)
Theorem gorgeous_sum : forall n m,
  gorgeous n -> gorgeous m -> gorgeous (n + m).
Proof.
  intros. induction H as [|n g|n g].
  - apply H0.
  - simpl. apply g_plus3. apply IHg.
  - simpl. apply g_plus5. apply IHg.
Qed.
(** [] *)

(** **** Exercise: 3 stars, advanced (beautiful__gorgeous) *)
Theorem beautiful__gorgeous : forall n, beautiful n -> gorgeous n.
Proof.
  intros. induction H as [| | | m k a ga b gb].
  - apply g_0.
  - apply g_plus3. apply g_0.
  - apply g_plus5. apply g_0.
  - apply gorgeous_sum. apply ga. apply gb.
Qed.
(** [] *)

(** **** Exercise: 3 stars, optional (g_times2) *)
(** Prove the [g_times2] theorem below without using [gorgeous__beautiful].
    You might find the following helper lemma useful. *)

Lemma helper_g_times2 : forall x y z, x + (z + y)= z + x + y.
Proof.
  intros. rewrite plus_assoc. replace (x + z) with (z + x) by apply plus_comm.
  reflexivity.
Qed.

Theorem g_times2: forall n, gorgeous n -> gorgeous (2*n).
Proof.
   intros n H. simpl.
   induction H.
   - apply g_0.
   - simpl. apply g_plus3. rewrite <- plus_n_Sm.
     rewrite <- plus_n_Sm. rewrite <- plus_n_Sm. apply g_plus3. apply IHgorgeous.
   - rewrite plus_0_r. rewrite helper_g_times2. simpl. apply g_plus5. apply g_plus5.
     rewrite <- plus_0_r. rewrite <- plus_assoc. apply IHgorgeous.
Qed.
(** [] *)

(* ####################################################### *)
(** ** [Inversion] on Evidence *)

(** Another situation where we want to analyze evidence for evenness
    is when proving that, if [n] is even, then [pred (pred n)] is
    too.  In this case, we don't need to do an inductive proof.  The
    right tactic turns out to be [inversion].  *)

Theorem ev_minus2: forall n,
  ev n -> ev (pred (pred n)).
Proof.
  intros n E.
  inversion E as [| n' E'].
  Case "E = ev_0". simpl. apply ev_0.
  Case "E = ev_SS n' E'". simpl. apply E'.  Qed.

(** **** Exercise: 1 star, optional (ev_minus2_n) *)
(** What happens if we try to use [destruct] on [n] instead of [inversion] on [E]? *)

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

(** *** *)
(** Another example, in which [inversion] helps narrow down to
the relevant cases. *)

Theorem SSev__even : forall n,
  ev (S (S n)) -> ev n.
Proof.
  intros n E.
  inversion E as [| n' E'] .
  apply E'. Qed.

(** ** [inversion] revisited *)

(** These uses of [inversion] may seem a bit mysterious at first.
    Until now, we've only used [inversion] on equality
    propositions, to utilize injectivity of constructors or to
    discriminate between different constructors.  But we see here
    that [inversion] can also be applied to analyzing evidence
    for inductively defined propositions.

    (You might also expect that [destruct] would be a more suitable
    tactic to use here. Indeed, it is possible to use [destruct], but
    it often throws away useful information, and the [eqn:] qualifier
    doesn't help much in this case.)

    Here's how [inversion] works in general.  Suppose the name
    [I] refers to an assumption [P] in the current context, where
    [P] has been defined by an [Inductive] declaration.  Then,
    for each of the constructors of [P], [inversion I] generates
    a subgoal in which [I] has been replaced by the exact,
    specific conditions under which this constructor could have
    been used to prove [P].  Some of these subgoals will be
    self-contradictory; [inversion] throws these away.  The ones
    that are left represent the cases that must be proved to
    establish the original goal.

    In this particular case, the [inversion] analyzed the construction
    [ev (S (S n))], determined that this could only have been
    constructed using [ev_SS], and generated a new subgoal with the
    arguments of that constructor as new hypotheses.  (It also
    produced an auxiliary equality, which happens to be useless here.)
    We'll begin exploring this more general behavior of inversion in
    what follows. *)

(** **** Exercise: 1 star (inversion_practice) *)
Theorem SSSSev__even : forall n,
  ev (S (S (S (S n)))) -> ev n.
Proof.
  intros. inversion H. inversion H1. apply H3.
Qed.

(** The [inversion] tactic can also be used to derive goals by showing
    the absurdity of a hypothesis. *)

Theorem even5_nonsense :
  ev 5 -> 2 + 2 = 9.
Proof.
  intros. inversion H. inversion H1. inversion H3.
Qed.
(** [] *)

(** **** Exercise: 3 stars, advanced (ev_ev__ev) *)
(** Finding the appropriate thing to do induction on is a
    bit tricky here: *)

Theorem ev_ev__ev : forall n m,
  ev (n+m) -> ev n -> ev m.
Proof.
  intros n m H Q.
  induction Q.
  - apply H.
  - simpl in H. inversion H. apply IHQ. apply H1.
Qed.

(** [] *)

(** **** Exercise: 3 stars, optional (ev_plus_plus) *)
(** Here's an exercise that just requires applying existing lemmas.  No
    induction or even case analysis is needed, but some of the rewriting
    may be tedious. *)

Theorem ev_plus_plus : forall n m p,
  ev (n+m) -> ev (n+p) -> ev (m+p).
Proof.
  intros n m p H. apply ev_ev__ev. rewrite <- plus_assoc.
  rewrite (plus_comm p (m + p)). rewrite <- plus_assoc.
  rewrite plus_assoc. apply ev_sum. assumption. rewrite <- double_plus.
  apply double_even.
Qed.
(** [] *)

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

(** **** Exercise: 4 stars (palindromes) *)
(** A palindrome is a sequence that reads the same backwards as
    forwards.

    - Define an inductive proposition [pal] on [list X] that
      captures what it means to be a palindrome. (Hint: You'll need
      three cases.  Your definition should be based on the structure
      of the list; just having a single constructor
    c : forall l, l = rev l -> pal l
      may seem obvious, but will not work very well.)

    - Prove that
       forall l, pal (l ++ rev l).
    - Prove that
       forall l, pal l -> l = rev l.
 *)
Inductive pal {A:Type} : list A -> Prop :=
| nil_pal : pal nil
| one_pal x : pal [x]
| add_pal x xs : pal xs -> pal (x :: snoc xs x).

Theorem pal_l_rev_l : forall (A:Type) (l:list A), pal (l ++ rev l).
Proof.
  intros. induction l as [|h t].
  - apply nil_pal.
  - simpl. rewrite <- snoc_with_append. apply add_pal. apply IHt.
Qed.

Theorem snoc_rev : forall (A:Type) (l:list A) (x:A), snoc (rev l) x = rev (x :: l).
Proof. reflexivity. Qed.

Theorem pal_rev : forall (A:Type) (l:list A), pal l -> l = rev l.
Proof.
  intros A l H. induction H.
  - reflexivity.
  - reflexivity.
  - simpl. rewrite rev_snoc. rewrite <- IHpal. reflexivity.
Qed.

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

(** **** Exercise: 5 stars, optional (palindrome_converse) *)
(** Using your definition of [pal] from the previous exercise, prove
    that
     forall l, l = rev l -> pal l.
 *)

Theorem rev_inj : forall (A:Type) (l:list A) (l2:list A), rev l = rev l2 -> l = l2.
Proof.
  intros. rewrite <- rev_involutive. rewrite <- H. rewrite rev_involutive. reflexivity.
Qed.

Theorem nil_app_r : forall (A:Type) (l:list A), l ++ [] = l.
Proof.
  intros. induction l.
  - reflexivity.
  - simpl. apply f_equal. apply IHl.
Qed.

Theorem rev_distrib_app:
  forall (A:Type) (xs:list A) (ys:list A), rev (xs ++ ys) = rev ys ++ rev xs.
Proof.
  intros. induction xs as [|x xt].
  - simpl. rewrite nil_app_r. reflexivity.
  - simpl. rewrite IHxt. rewrite snoc_with_append. reflexivity.
Qed.

(*Theorem cons_app_snoc :
  forall (A:Type) (a b:A) (xs ys:list A),
    a :: snoc xs b = ys ++ ys*)

Theorem pal_twice : forall (A:Type) (l:list A), pal (l ++ l) -> pal l.
Proof.
Abort.

Theorem rev_pal_gen : forall (A:Type) (l:list A) (l':list A), l = rev l' -> l = l' -> pal l.
Proof.
  intros A l. destruct l as [|h t].
  - intros. apply nil_pal.
  - intros. induction l' as [|e m] eqn:rx.
    + intros. inversion H0.
Abort.

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

(** **** Exercise: 4 stars, advanced (subsequence) *)
(** A list is a _subsequence_ of another list if all of the elements
    in the first list occur in the same order in the second list,
    possibly with some extra elements in between. For example,
    [1,2,3]
    is a subsequence of each of the lists
    [1,2,3]
    [1,1,1,2,2,3]
    [1,2,7,3]
    [5,6,1,9,9,2,7,3,8]
    but it is _not_ a subsequence of any of the lists
    [1,2]
    [1,3]
    [5,6,2,1,7,3,8]

    - Define an inductive proposition [subseq] on [list nat] that
      captures what it means to be a subsequence. (Hint: You'll need
      three cases.)

    - Prove that subsequence is reflexive, that is, any list is a
      subsequence of itself.

    - Prove that for any lists [l1], [l2], and [l3], if [l1] is a
      subsequence of [l2], then [l1] is also a subsequence of [l2 ++
      l3].

    - (Optional, harder) Prove that subsequence is transitive -- that
      is, if [l1] is a subsequence of [l2] and [l2] is a subsequence
      of [l3], then [l1] is a subsequence of [l3].  Hint: choose your
      induction carefully!
*)

Inductive subseq {X:Type} : list X -> list X -> Prop :=
| sub_nil  : subseq [] []
| sub_skip : forall (x:X) (xs ys:list X), subseq xs ys -> subseq xs (x :: ys)
| sub_elem : forall (x:X) (xs ys:list X), subseq xs ys -> subseq (x :: xs) (x :: ys).

Theorem subseq_refl : forall (X:Type) (xs:list X), subseq xs xs.
Proof.
  intros. induction xs as [|h t].
  - apply sub_nil.
  - apply sub_elem. apply IHt.
Qed.

Theorem subseq_nil_all : forall (X:Type) (xs:list X), subseq [] xs.
Proof.
  intros. induction xs as [|h t].
  - apply sub_nil.
  - apply sub_skip. apply IHt.
Qed.

Theorem subseq_app:
  forall (X:Type) (xs ys zs : list X), subseq xs ys -> subseq xs (ys ++ zs).
Proof.
  intros. induction H.
  + apply subseq_nil_all.
  + simpl. apply sub_skip. apply IHsubseq.
  + simpl. apply sub_elem. apply IHsubseq.
Qed.

Theorem subseq_intro_app_left:
  forall (X:Type) (xs ys zs : list X),
    subseq (xs ++ ys) zs -> subseq xs zs.
Proof.
  intros X xs. induction xs as [|h t].
  - intros ys zs H. apply subseq_nil_all.
  - intros ys zs. generalize dependent ys. induction zs as [|i s].
    + intros ys H. inversion H.
    + intros xs H. inversion H as [|x' xs' ys' seq|x' xs' ys' seq].
      * apply sub_skip. apply IHs with xs. apply seq.
      * apply sub_elem. apply IHt with xs. apply seq.
Qed.

Theorem subseq_intro_app_right:
  forall (X:Type) (xs ys zs : list X),
    subseq (xs ++ ys) zs -> subseq ys zs.
Proof.
  intros X xs. induction xs as [|h t].
  - intros ys zs H. apply H.
  - intros ys zs. generalize dependent ys. induction zs as [|i s].
    + intros ys H. inversion H.
    + intros ys H. inversion H as [|x' xs' ys' seq|x' xs' ys' seq].
      * apply sub_skip. apply IHs. apply seq.
      * apply IHt. apply sub_skip. apply seq.
Qed.

Theorem subseq_trans:
  forall (X:Type) (xs ys zs : list X), subseq xs ys -> subseq ys zs -> subseq xs zs.
Proof.
  intros X xs ys zs H. generalize dependent zs. induction H.
  - intros. apply H.
  - intros. apply IHsubseq. replace (x :: ys) with ([x] ++ ys) in H0.
    apply subseq_intro_app_right in H0. apply H0. reflexivity.
  - intros. induction zs as [|h t].
    + inversion H0.
    + inversion H0.
      * apply sub_skip. apply IHt. apply H3.
      * apply sub_elem. apply IHsubseq. apply H2.
Qed.

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

(** **** Exercise: 2 stars, optional (R_provability) *)
(** Suppose we give Coq the following definition:
    Inductive R : nat -> list nat -> Prop :=
      | c1 : R 0 []
      | c2 : forall n l, R n l -> R (S n) (n :: l)
      | c3 : forall n l, R (S n) l -> R n l.
    Which of the following propositions are provable?

    - [R 2 [1,0]]
    - [R 1 [1,2,1,0]]
    - [R 6 [3,2,1,0]]
*)

(** [] *)

(* ####################################################### *)
(** * Relations *)

(** A proposition parameterized by a number (such as [ev] or
    [beautiful]) can be thought of as a _property_ -- i.e., it defines
    a subset of [nat], namely those numbers for which the proposition
    is provable.  In the same way, a two-argument proposition can be
    thought of as a _relation_ -- i.e., it defines a set of pairs for
    which the proposition is provable. *)

Module LeModule.

(** One useful example is the "less than or equal to"
    relation on numbers. *)

(** The following definition should be fairly intuitive.  It
    says that there are two ways to give evidence that one number is
    less than or equal to another: either observe that they are the
    same number, or give evidence that the first is less than or equal
    to the predecessor of the second. *)

Inductive le : nat -> nat -> Prop :=
  | le_n : forall n, le n n
  | le_S : forall n m, (le n m) -> (le n (S m)).

Notation "m <= n" := (le m n).

(** Proofs of facts about [<=] using the constructors [le_n] and
    [le_S] follow the same patterns as proofs about properties, like
    [ev] in chapter [Prop].  We can [apply] the constructors to prove [<=]
    goals (e.g., to show that [3<=3] or [3<=6]), and we can use
    tactics like [inversion] to extract information from [<=]
    hypotheses in the context (e.g., to prove that [(2 <= 1) -> 2+2=5].) *)

(** *** *)
(** Here are some sanity checks on the definition.  (Notice that,
    although these are the same kind of simple "unit tests" as we gave
    for the testing functions we wrote in the first few lectures, we
    must construct their proofs explicitly -- [simpl] and
    [reflexivity] don't do the job, because the proofs aren't just a
    matter of simplifying computations.) *)

Theorem test_le1 :
  3 <= 3.
Proof.
  (* WORKED IN CLASS *)
  apply le_n.  Qed.

Theorem test_le2 :
  3 <= 6.
Proof.
  (* WORKED IN CLASS *)
  apply le_S. apply le_S. apply le_S. apply le_n.  Qed.

Theorem test_le3 :
  (2 <= 1) -> 2 + 2 = 5.
Proof.
  (* WORKED IN CLASS *)
  intros H. inversion H. inversion H2.  Qed.

(** *** *)
(** The "strictly less than" relation [n < m] can now be defined
    in terms of [le]. *)

End LeModule.

Definition lt (n m:nat) := le (S n) m.

Notation "m < n" := (lt m n).

(** Here are a few more simple relations on numbers: *)

Inductive square_of : nat -> nat -> Prop :=
  sq : forall n:nat, square_of n (n * n).

Inductive next_nat (n:nat) : nat -> Prop :=
  | nn : next_nat n (S n).

Inductive next_even (n:nat) : nat -> Prop :=
  | ne_1 : ev (S n) -> next_even n (S n)
  | ne_2 : ev (S (S n)) -> next_even n (S (S n)).

(** **** Exercise: 2 stars (total_relation) *)
(** Define an inductive binary relation [total_relation] that holds
    between every pair of natural numbers. *)

Inductive total_relation : nat -> nat -> Prop :=
  | total_relation_1 : forall (n m : nat), total_relation n m.
(** [] *)

(** **** Exercise: 2 stars (empty_relation) *)
(** Define an inductive binary relation [empty_relation] (on numbers)
    that never holds. *)

Inductive empty_relation : nat -> nat -> Prop := .
(** [] *)

(** **** Exercise: 2 stars, optional (le_exercises) *)
(** Here are a number of facts about the [<=] and [<] relations that
    we are going to need later in the course.  The proofs make good
    practice exercises. *)

Lemma le_trans : forall m n o, m <= n -> n <= o -> m <= o.
Proof.
  intros m n o Hmn Hno. induction Hno.
  - apply Hmn.
  - apply le_S. apply IHHno.
Qed.

Theorem O_le_n : forall n,
  0 <= n.
Proof.
  intros. induction n. apply le_n.  apply le_S. apply IHn.
Qed.

Theorem n_le_m__Sn_le_Sm : forall n m,
  n <= m -> S n <= S m.
Proof.
  intros. induction H.
  - apply le_n.
  - apply le_S. apply IHle.
Qed.

Theorem Sn_le_Sm__n_le_m : forall n m,
  S n <= S m -> n <= m.
Proof.
  intros. generalize dependent n. induction m as [|m'].
  - intros. inversion H. apply le_n. inversion H1.
  - intros. inversion H. apply le_n. apply le_S. apply IHm'. apply H1.
Qed.

Theorem le_plus_l : forall a b,
  a <= a + b.
Proof.
  intros. induction a as [|a'].
  - intros. simpl. apply O_le_n.
  - intros. simpl. apply n_le_m__Sn_le_Sm. apply IHa'.
Qed.

Theorem plus_lt : forall n1 n2 m,
  n1 + n2 < m ->
  n1 < m /\ n2 < m.
Proof.
 unfold lt.
 induction n1 as [|a].
 - intros. simpl in H. destruct m. inversion H. split.
   + apply n_le_m__Sn_le_Sm. apply O_le_n.
   + apply H.
 - intros. simpl in H. destruct m. inversion H. destruct IHa with n2 m.
   + apply Sn_le_Sm__n_le_m.  apply H.
   + split.
     * apply n_le_m__Sn_le_Sm. apply H0.
     * apply le_S. apply H1.
Qed.

Theorem lt_S : forall n m,
  n < m ->
  n < S m.
Proof.
  intros. unfold lt.
  induction H.
  - apply le_S. apply le_n.
  - apply le_S. apply IHle.
Qed.

Theorem ble_nat_true : forall n m,
  ble_nat n m = true -> n <= m.
Proof.
  induction n as [|n'].
  - intros. apply O_le_n.
  - intros. destruct m as [|m'].
    + inversion H.
    + apply n_le_m__Sn_le_Sm. apply IHn'. apply H.
Qed.

Theorem le_ble_nat : forall n m,
  n <= m ->
  ble_nat n m = true.
Proof.
  induction n as [|n'].
  - intros. reflexivity.
  - intros. destruct m as [|m'].
    + inversion H.
    + simpl. apply IHn'. apply Sn_le_Sm__n_le_m. apply H.
Qed.

Theorem ble_nat_true_trans : forall n m o,
  ble_nat n m = true -> ble_nat m o = true -> ble_nat n o = true.
Proof.
  intros n m o H Q. apply le_ble_nat. apply le_trans with m.
  + apply ble_nat_true. apply H.
  + apply ble_nat_true. apply Q.
Qed.

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

(** **** Exercise: 3 stars (R_provability2) *)
Module R.
(** We can define three-place relations, four-place relations,
    etc., in just the same way as binary relations.  For example,
    consider the following three-place relation on numbers: *)

Inductive R : nat -> nat -> nat -> Prop :=
   | c1 : R 0 0 0
   | c2 : forall m n o, R m n o -> R (S m) n (S o)
   | c3 : forall m n o, R m n o -> R m (S n) (S o)
   | c4 : forall m n o, R (S m) (S n) (S (S o)) -> R m n o
   | c5 : forall m n o, R m n o -> R n m o.

(** - Which of the following propositions are provable?
      - [R 1 1 2]
      - [R 2 2 6]

    - If we dropped constructor [c5] from the definition of [R],
      would the set of provable propositions change?  Briefly (1
      sentence) explain your answer.

    - If we dropped constructor [c4] from the definition of [R],
      would the set of provable propositions change?  Briefly (1
      sentence) explain your answer.

(* FILL IN HERE *)
[]
*)

(** **** Exercise: 3 stars, optional (R_fact) *)
(** Relation [R] actually encodes a familiar function.  State and prove two
    theorems that formally connects the relation and the function.
    That is, if [R m n o] is true, what can we say about [m],
    [n], and [o], and vice versa?
*)

Theorem r_plus_eq : forall m n o : nat, R m n o -> m + n = o.
Proof.
  intros. induction H.
  - reflexivity.
  - simpl. apply f_equal. apply IHR.
  - rewrite plus_comm. simpl. apply f_equal. rewrite plus_comm. apply IHR.
  - simpl in IHR. rewrite <- plus_n_Sm in IHR. injection IHR. intro X. apply X.
  - rewrite plus_comm. apply IHR.
Qed.

Theorem plus_eq_r : forall m n o : nat, m + n = o -> R m n o.
  intro m. induction m as [|m'].
  - intro n. induction n as [|n'].
    + intros. rewrite <- H. apply c1.
    + intros. rewrite <- H. apply c3. apply IHn'. reflexivity.
  - intros. rewrite <- H. simpl. apply c2. apply IHm'. reflexivity.
Qed.
(** [] *)

End R.

(* ##################################################### *)
(** * Programming with Propositions Revisited *)

(** As we have seen, a _proposition_ is a statement expressing a factual claim,
    like "two plus two equals four."  In Coq, propositions are written
    as expressions of type [Prop]. . *)

Check (2 + 2 = 4).
(* ===> 2 + 2 = 4 : Prop *)

Check (ble_nat 3 2 = false).
(* ===> ble_nat 3 2 = false : Prop *)

Check (beautiful 8).
(* ===> beautiful 8 : Prop *)

(** *** *)
(** Both provable and unprovable claims are perfectly good
    propositions.  Simply _being_ a proposition is one thing; being
    _provable_ is something else! *)

Check (2 + 2 = 5).
(* ===> 2 + 2 = 5 : Prop *)

Check (beautiful 4).
(* ===> beautiful 4 : Prop *)

(** Both [2 + 2 = 4] and [2 + 2 = 5] are legal expressions
    of type [Prop]. *)

(** *** *)
(** We've mainly seen one place that propositions can appear in Coq: in
    [Theorem] (and [Lemma] and [Example]) declarations. *)

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

(** But they can be used in many other ways.  For example, we have also seen that
    we can give a name to a proposition using a [Definition], just as we have
    given names to expressions of other sorts. *)

Definition plus_fact : Prop  :=  2 + 2 = 4.
Check plus_fact.
(* ===> plus_fact : Prop *)

(** We can later use this name in any situation where a proposition is
    expected -- for example, as the claim in a [Theorem] declaration. *)

Theorem plus_fact_is_true :
  plus_fact.
Proof. reflexivity.  Qed.

(** *** *)
(** We've seen several ways of constructing propositions.

       - We can define a new proposition primitively using [Inductive].

       - Given two expressions [e1] and [e2] of the same type, we can
         form the proposition [e1 = e2], which states that their
         values are equal.

       - We can combine propositions using implication and
         quantification. *)
(** *** *)
(** We have also seen _parameterized propositions_, such as [even] and
    [beautiful]. *)

Check (even 4).
(* ===> even 4 : Prop *)
Check (even 3).
(* ===> even 3 : Prop *)
Check even.
(* ===> even : nat -> Prop *)

(** *** *)
(** The type of [even], i.e., [nat->Prop], can be pronounced in
    three equivalent ways: (1) "[even] is a _function_ from numbers to
    propositions," (2) "[even] is a _family_ of propositions, indexed
    by a number [n]," or (3) "[even] is a _property_ of numbers."  *)

(** Propositions -- including parameterized propositions -- are
    first-class citizens in Coq.  For example, we can define functions
    from numbers to propositions... *)

Definition between (n m o: nat) : Prop :=
  andb (ble_nat n o) (ble_nat o m) = true.

(** ... and then partially apply them: *)

Definition teen : nat->Prop := between 13 19.

(** We can even pass propositions -- including parameterized
    propositions -- as arguments to functions: *)

Definition true_for_zero (P:nat->Prop) : Prop :=
  P 0.

(** *** *)
(** Here are two more examples of passing parameterized propositions
    as arguments to a function.

    The first function, [true_for_all_numbers], takes a proposition
    [P] as argument and builds the proposition that [P] is true for
    all natural numbers. *)

Definition true_for_all_numbers (P:nat->Prop) : Prop :=
  forall n, P n.

(** The second, [preserved_by_S], takes [P] and builds the proposition
    that, if [P] is true for some natural number [n'], then it is also
    true by the successor of [n'] -- i.e. that [P] is _preserved by
    successor_: *)

Definition preserved_by_S (P:nat->Prop) : Prop :=
  forall n', P n' -> P (S n').

(** *** *)
(** Finally, we can put these ingredients together to define
a proposition stating that induction is valid for natural numbers: *)

Definition natural_number_induction_valid : Prop :=
  forall (P:nat->Prop),
    true_for_zero P ->
    preserved_by_S P ->
    true_for_all_numbers P.

(** **** Exercise: 3 stars (combine_odd_even) *)
(** Complete the definition of the [combine_odd_even] function
    below. It takes as arguments two properties of numbers [Podd] and
    [Peven]. As its result, it should return a new 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) (n:nat) : Prop :=
  if evenb n then Peven n else Podd n.

(** To test your definition, see whether you can prove the following
    facts: *)

Theorem combine_odd_even_intro :
  forall (Podd Peven : nat -> Prop) (n : nat),
    (oddb n = true -> Podd n) ->
    (oddb n = false -> Peven n) ->
    combine_odd_even Podd Peven n.
Proof.
  intros. unfold combine_odd_even. destruct (evenb n) eqn:E.
  - apply H0. unfold oddb. rewrite E. reflexivity.
  - apply H. unfold oddb. rewrite E. reflexivity.
Qed.

Theorem combine_odd_even_elim_odd :
  forall (Podd Peven : nat -> Prop) (n : nat),
    combine_odd_even Podd Peven n ->
    oddb n = true ->
    Podd n.
Proof.
  intros. unfold combine_odd_even in H.
  replace (evenb n) with (negb (negb (evenb n))) in H. unfold oddb in H0.
  rewrite H0 in H. simpl in H. apply H. apply negb_involutive.
Qed.

Theorem combine_odd_even_elim_even :
  forall (Podd Peven : nat -> Prop) (n : nat),
    combine_odd_even Podd Peven n ->
    oddb n = false ->
    Peven n.
Proof.
  intros. unfold combine_odd_even in H. unfold oddb in H0.
  rewrite <- negb_involutive with (evenb n) in H. rewrite H0 in H.
  simpl in H. apply H.
Qed.

(** [] *)

(* ##################################################### *)
(** One more quick digression, for adventurous souls: if we can define
    parameterized propositions using [Definition], then can we also
    define them using [Fixpoint]?  Of course we can!  However, this
    kind of "recursive parameterization" doesn't correspond to
    anything very familiar from everyday mathematics.  The following
    exercise gives a slightly contrived example. *)

(** **** Exercise: 4 stars, optional (true_upto_n__true_everywhere) *)
(** Define a recursive function
    [true_upto_n__true_everywhere] that makes
    [true_upto_n_example] work. *)

Fixpoint true_upto_n__true_everywhere (n:nat) (f:nat -> Prop) : Prop :=
  match n with
    | 0    => forall n : nat, f n
    | S n' => f n -> true_upto_n__true_everywhere n' f
  end.

Example true_upto_n_example :
    (true_upto_n__true_everywhere 3 (fun n => even n))
  = (even 3 -> even 2 -> even 1 -> forall m : nat, even m).
Proof. reflexivity.  Qed.

(** [] *)

(* $Date: 2014-06-05 07:22:21 -0400 (Thu, 05 Jun 2014) $ *)


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

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

Fixpoint append(m n :natlist) : natlist :=
match m with
|[] => n
|a :: b => a::(append b n)
end.

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

Fixpoint snoc(m:natlist)(n:nat) :natlist:=
match m with
|[] => [n]
|a::b => a:: (snoc b n)
end.

Fixpoint reverse(n:natlist) : natlist :=
match n with
|[] => []
|a::b => snoc(reverse b) a
end.

Theorem appendEmptyList : forall list : natlist, list ++ [] = list.
Proof.
  intros.
    induction list as [| x xs].
    simpl.
    reflexivity.
    simpl.
    rewrite -> IHxs.
    reflexivity.
Qed.

Theorem rev_snoc : forall l :natlist, forall n:nat, reverse(snoc l n) = n :: reverse l.
Proof.
intros.
induction l.
simpl.
simpl. reflexivity.
simpl. rewrite -> IHl.
simpl. reflexivity.
Qed.

Theorem reverseInvolutive : forall list : natlist, reverse(reverse list) = list.
Proof.
intros.
induction list as [| x xs].
simpl. reflexivity.
simpl. rewrite -> rev_snoc.
rewrite IHxs.
reflexivity.
Qed.


Require Import Arith.
Require Import Recdef.

Definition nat_leb := leb.

Require Import Bool.

Inductive nat_list : Set :=
    nil : nat_list
  | cons : nat -> nat_list -> nat_list.

Inductive is_sorted : nat_list -> Prop :=
    s_nil       : is_sorted nil
  | s_singleton : forall x, is_sorted (cons x nil)
  | s_cons      : forall x y ys, x <= y -> is_sorted (cons y ys) -> is_sorted (cons x (cons y ys)).

Lemma test_is_sorted : is_sorted (cons 1 (cons 2 nil)).
Proof.
  apply s_cons.
  auto.
  apply s_singleton.
Qed.

Fixpoint less_than_list (x : nat) (xs : nat_list) : bool :=
  match xs with
  | nil       => true
  | cons y ys => andb (nat_leb x y) (less_than_list x ys)
  end.

Fixpoint append (xs : nat_list) (ys : nat_list) : nat_list :=
  match xs with
  | nil       => ys
  | cons z zs => cons z (append zs ys)
  end.

Fixpoint noccs (x : nat) (xs : nat_list) : nat :=
  match xs with
  | nil       => 0
  | cons y ys => noccs x ys + if beq_nat x y then 1 else 0
  end.

Definition perm (xs : nat_list) (ys : nat_list) :=
  forall x, noccs x xs = noccs x ys.

Fixpoint nat_list_min (xs : nat_list) : nat :=
  match xs with
  | nil        => 0
  | cons y ys  =>
    (match ys with
    | nil      => y
    | cons _ _ => min y (nat_list_min ys)
    end)
  end.

Lemma noccs_gt_0_cons :
  forall x y xs,
    noccs y (cons x xs) > 0 -> (y = x \/ noccs y xs > 0).
Proof.
  unfold noccs; fold noccs.
  intros x y xs H.
  case_eq (beq_nat y x).
    (* true *)
    intro. left.
    apply beq_nat_true; assumption.
    (* false *)
    intro. right.
    replace (beq_nat y x) with false in H.
    replace (noccs y xs + 0) with (noccs y xs) in H.
    assumption.
    apply plus_n_O.
Qed.

Lemma nat_list_min_is_min :
  forall (xs : nat_list) (x : nat),
    noccs x xs > 0 -> nat_list_min xs <= x.
Proof.
  intros xs x noccs_gt_0.
  induction xs.
    (* nil *)
    apply le_Sn_0 in noccs_gt_0.
    contradiction.
    (* cons *)
    unfold nat_list_min; fold nat_list_min.
    apply noccs_gt_0_cons in noccs_gt_0.
    case noccs_gt_0.
      (* x = n *)
      intro.
      replace n with x.
      induction xs.
        apply le_refl.
        apply Min.le_min_l.
      (* noccs x xs > 0 *)
      intro.
      apply le_trans with (nat_list_min xs).
      induction xs.
        apply le_Sn_0 in H; contradiction.
      apply Min.le_min_r.
      apply IHxs.
      assumption.
Qed.

Fixpoint nat_list_remove1 (x : nat) (xs : nat_list) : nat_list :=
  match xs with
  | nil       => nil
  | cons y ys =>
    if beq_nat x y
     then ys
     else cons y (nat_list_remove1 x ys)
  end.

Fixpoint nat_list_len (xs : nat_list) :=
  match xs with
  | nil       => 0
  | cons _ ys => 1 + nat_list_len ys
  end.

Lemma leqmin_imp_eqmin :
  forall n m, n <= min n m -> n = min n m.
Proof.
  intros n m.
  intro.
  symmetry.
  apply min_l.
  apply Min.min_glb_r with n.
  assumption.
Qed.

Lemma remove_different_cons :
  forall x y xs,
  y <> x -> nat_list_remove1 y (cons x xs) = cons x (nat_list_remove1 y xs).
Proof.
  intros.
  simpl.
  replace (beq_nat y x) with false.
  reflexivity.
  symmetry.
  apply beq_nat_false_iff.
  assumption.
Qed.

Lemma list_length_after_removal :
  forall xs, xs <> nil ->
  nat_list_len (nat_list_remove1 (nat_list_min xs) xs)
  < nat_list_len xs.
Proof.
  induction xs.
    (* nil *)
    intro H; elim H; reflexivity.
    (* cons *)
    intro.
    unfold nat_list_min; fold nat_list_min.
    case_eq xs.
      (* nil *)
      simpl.
      rewrite <- beq_nat_refl.
      simpl.
      intro.
      apply lt_0_Sn.
      (* cons *)
      intros y ys shape_xs.
      assert ({n <= nat_list_min (cons y ys)} +
              {n > nat_list_min (cons y ys)})
             as n_options.
      apply le_gt_dec.
      case n_options.
        (* case n is min *)
        intro.
        replace (min n (nat_list_min (cons y ys))) with n.
        simpl.
        rewrite <- beq_nat_refl.
        simpl.
        apply lt_n_S.
        apply lt_n_Sn.
        symmetry.
        apply min_l.
        assumption.
        (* case (nat_list_min (cons n0 xs)) is min *)
        intro.
        replace (min n (nat_list_min (cons y ys))) with (nat_list_min (cons y ys)).
          replace (cons y ys) with xs.
          rewrite remove_different_cons.
            apply lt_n_S.
            fold nat_list_len.
            apply IHxs.
            replace xs with (cons y ys).
            discriminate.
            replace xs with (cons y ys).
            apply NPeano.Nat.lt_neq.
            assumption.
          (* proof that (min n (nat_list_min (cons y ys))) = (nat_list_min (cons y ys)) *)
          symmetry.
          apply min_r.
          apply lt_le_weak in g.
          assumption.
Qed.

Function selection_sort (xs : nat_list)
    { measure nat_list_len xs } : nat_list :=
  match xs with
  | nil       => nil
  | cons y ys =>
      let m := nat_list_min (cons y ys) in
        cons m (selection_sort (nat_list_remove1 m (cons y ys)))
  end.
  intros.
  apply list_length_after_removal.
  discriminate.
Defined.

Eval compute in (selection_sort (cons 2 (cons 3 (cons 1 nil)))).

Definition is_permutation xs ys := forall x, noccs x xs = noccs x ys.

Lemma eq_neq_dec : forall x y : nat, {x <> y} + {x = y}.
Proof.
  intros x y.
  assert ({x < y} + {x = y} + {x > y}) as xy_options.
  apply lt_eq_lt_dec.
  case xy_options. intro xy_options2; case xy_options2.
  (* x < y *)
  left.
  apply NPeano.Nat.lt_neq.
  assumption.
  (* x = y *)
  right.
  assumption.
  (* x > y *)
  left.
  apply not_eq_sym.
  apply NPeano.Nat.lt_neq.
  assumption.
Qed.

Lemma noccs_remove_present :
  forall x xs,
    noccs x xs > 0 ->
    noccs x xs = noccs x (nat_list_remove1 x xs) + 1.
Proof.
  induction xs.
  (* nil *)
  intro. compute in H. apply le_Sn_0 in H; contradiction.
  (* cons *)
  intro.
  assert ({x <> n} + {x = n}) as x_options.
  apply eq_neq_dec.
  case x_options.
  (* x <> n *)
    intro.
    unfold nat_list_remove1; fold nat_list_remove1.
    assert (beq_nat x n = false).
      apply beq_nat_false_iff.
      assumption.
    replace (beq_nat x n) with false.
    unfold noccs; fold noccs.
    replace (beq_nat x n) with false.
    rewrite plus_0_r.
    rewrite plus_0_r.
    apply IHxs.
    unfold noccs in H; fold noccs in H.
    replace (beq_nat x n) with false in H.
    rewrite plus_0_r in H.
    assumption.
  (* x = n *)
    intro.
    unfold nat_list_remove1; fold nat_list_remove1.
    assert (beq_nat x n = true).
      apply beq_nat_true_iff.
      assumption.
    replace (beq_nat x n) with true.
    unfold noccs; fold noccs.
    replace (beq_nat x n) with true.
    reflexivity.
Qed.

Lemma plus_compat :
  forall x y z, x = y -> x + z = y + z.
Proof.
  induction z.
  (* base *)
  intro.
  rewrite plus_0_r.
  rewrite plus_0_r.
  assumption.
  (* ind *)
  intro.
  rewrite <- plus_n_Sm.
  rewrite <- plus_n_Sm.
  apply eq_S.
  apply IHz.
  assumption.
Qed.

Lemma noccs_remove_not_present :
  forall x y xs,
    x <> y ->
    noccs y xs > 0 ->
    noccs x xs = noccs x (nat_list_remove1 y xs).
Proof.
  intros x y xs H0 H1.
  induction xs.
  (* nil *)
  compute in H1. apply le_Sn_0 in H1; contradiction.
  (* cons *)
  unfold nat_list_remove1; fold nat_list_remove1.
  assert ({y <> n} + {y = n}) as y_options.
  apply eq_neq_dec.
  case y_options.
  (* y <> n *)
  intro.
  assert (beq_nat y n = false).
    apply beq_nat_false_iff.
    assumption.
  replace (beq_nat y n) with false.
  unfold noccs; fold noccs.
  apply plus_compat.
  apply IHxs.
  unfold noccs in H1; fold noccs in H1.
  replace (beq_nat y n) with false in H1.
  rewrite plus_0_r in H1.
  assumption.
  (* y = n *)
  intro.
  assert (beq_nat y n = true).
    apply beq_nat_true_iff.
    assumption.
  replace (beq_nat y n) with true.
  unfold noccs; fold noccs.
  assert (beq_nat x n = false).
    apply beq_nat_false_iff.
    replace n with y.
    assumption.
  replace (beq_nat x n) with false.
  rewrite plus_0_r.
  reflexivity.
Qed.

Lemma min_neq_l : forall x y, min x y <> x -> y <= x.
Proof.
  intros x y.
  intro.
  assert ({min x y = x} + {min x y = y}) as min_options.
    apply Min.min_case.
    left. reflexivity.
    right. reflexivity.
  case min_options.
  (* min x y = x *)
    intro. elim H; assumption.
  (* min x y = y *)
    intro.
    apply Min.min_glb_l with y.
    replace (min x y) with y.
    apply le_refl.
Qed.

Lemma min_of_cons :
  forall x xs,
  nat_list_min (cons x xs) <> x ->
  nat_list_min (cons x xs) = nat_list_min xs.
Proof.
  intro.
  unfold nat_list_min; fold nat_list_min.
  intro xs.
  case xs.
  (* nil *)
  intro H; elim H; reflexivity.
  (* cons *)
  intros y ys.
  intro.
  apply min_r.
  apply min_neq_l.
  assumption.
Qed.

Lemma min_in_list :
  forall xs,
    xs <> nil -> noccs (nat_list_min xs) xs > 0.
Proof.
  induction xs.
  (* nil *)
  intro H. elim H. reflexivity.
  (* cons *)
  case_eq xs.
    (* nil *)
    intros.
    unfold nat_list_min; fold nat_list_min.
    simpl.
    assert (beq_nat n n = true).
      apply beq_nat_true_iff.
      reflexivity.
    replace (beq_nat n n) with true.
    apply lt_0_Sn.
    (* cons *)
    intros y ys.
    intros.
    assert ({n <> nat_list_min (cons n (cons y ys))} +
            {n = nat_list_min (cons n (cons y ys))})
        as n_options.
      apply eq_neq_dec.
    case n_options.
    (* n <> nat_list_min ... *)
    intro.
    replace (cons y ys) with xs.
    unfold noccs; fold noccs.
    assert (beq_nat (nat_list_min (cons n xs)) n = false).
      apply beq_nat_false_iff.
      apply not_eq_sym.
      replace xs with (cons y ys).
      assumption.
    replace (beq_nat (nat_list_min (cons n xs)) n) with false.
    rewrite plus_0_r.
    replace xs with (cons y ys).
    replace xs with (cons y ys) in IHxs.
    rewrite min_of_cons.
      apply IHxs.
      discriminate.
      apply not_eq_sym.
      assumption.
    (* n = nat_list_min ... *)
      intro n_shape.
      rewrite <- n_shape.
      unfold noccs; fold noccs.
      assert (beq_nat n n = true).
        apply beq_nat_true_iff.
        reflexivity.
      replace (beq_nat n n) with true.
        rewrite plus_comm.
        simpl.
        apply lt_0_Sn.
 Qed.

Lemma remove_min_perm :
  forall xs,
    xs <> nil ->
    is_permutation xs (cons (nat_list_min xs) (nat_list_remove1 (nat_list_min xs) xs)).
Proof.
  intro xs.
  case_eq xs.
  (* nil *)
  intro xs_shape. intro H; elim H; reflexivity.
  (* cons *)
  intros y ys xs_shape.
  intro.
  replace (cons y ys) with xs.
  unfold is_permutation.
  intro x.
  assert ({x <> nat_list_min xs} +
          {x = nat_list_min xs})
      as x_options.
    apply eq_neq_dec.
  case x_options.
  (* x <> nat_list_min xs *)
    intro.
    unfold noccs; fold noccs.
    assert (beq_nat x (nat_list_min xs) = false).
      apply beq_nat_false_iff.
      assumption.
    replace (beq_nat x (nat_list_min xs)) with false.
    rewrite plus_0_r.
    apply noccs_remove_not_present.
    assumption.
    apply min_in_list.
    rewrite xs_shape.
    discriminate.
  (* x = nat_list_min xs *)
    intro.
    unfold noccs; fold noccs.
    assert (beq_nat x (nat_list_min xs) = true).
      apply beq_nat_true_iff.
      assumption.
    replace (beq_nat x (nat_list_min xs)) with true.
    replace x with (nat_list_min xs).
    apply noccs_remove_present.
    apply min_in_list.
    rewrite xs_shape.
    discriminate.
Qed.

Lemma cons_is_not_perm_nil :
  forall x xs,
  ~is_permutation (cons x xs) nil.
Proof.
  intros x xs.
  unfold is_permutation.
  intro H.
  specialize H with x.
  unfold noccs in H; fold noccs in H.
  assert (beq_nat x x = true).
    apply beq_nat_true_iff.
    reflexivity.
  replace (beq_nat x x) with true in H.
  rewrite plus_comm in H.
  simpl in H.
  apply eq_sym in H.
  apply O_S in H.
  contradiction.
Qed.

Lemma permutation_cons :
  forall x xs ys,
  is_permutation xs ys ->
  is_permutation (cons x xs) (cons x ys).
Proof.
  intros x xs ys.
  unfold is_permutation.
  intro H.
  intro y.
  unfold noccs; fold noccs.
  apply plus_compat.
  specialize H with y.
  assumption.
Qed.

Lemma permutation_equiv :
  forall x xs ys zs,
  is_permutation xs ys ->
  is_permutation (cons x xs) zs ->
  is_permutation (cons x ys) zs.
Proof.
  intros x xs ys zs perm_xs_ys perm_xxs_zs.
  unfold is_permutation.
  intro y.
  assert (is_permutation (cons x xs) (cons x ys)) as perm_xxs_xys.
    apply permutation_cons.
    assumption.
  unfold is_permutation in perm_xxs_xys.
  specialize perm_xxs_xys with y.
  transitivity (noccs y (cons x xs)).
  symmetry.
  assumption.
  unfold is_permutation in perm_xxs_zs.
  specialize perm_xxs_zs with y.
  assumption.
Qed.

Lemma permutation_symm :
  forall xs ys,
    is_permutation xs ys -> is_permutation ys xs.
Proof.
  intros xs ys H.
  unfold is_permutation.
  intro x.
  unfold is_permutation in H.
  specialize H with x.
  symmetry.
  assumption.
Qed.

Lemma selection_sort_is_permutation :
  forall xs, is_permutation (selection_sort xs) xs.
Proof.
  intro.
  functional induction selection_sort xs.
  (* nil *)
  compute.
  reflexivity.
  (* cons *)
  apply permutation_equiv
   with (xs := (nat_list_remove1 (nat_list_min (cons y ys)) (cons y ys))).
  apply permutation_symm.
  apply IHn.
  apply permutation_symm.
  apply remove_min_perm.
  discriminate.
Qed.

Lemma selection_sort_cons :
  forall xs,
    ~(xs = nil) ->
    selection_sort xs =
    cons (nat_list_min xs)
         (selection_sort (nat_list_remove1 (nat_list_min xs) xs)).
 Proof.
   intro xs.
   functional induction selection_sort xs.
   (* nil *)
   intro H; elim H; reflexivity.
   (* cons *)
   intro xs_shape.
   reflexivity.
Qed.

Lemma nat_list_remove_not_nil :
  forall x y xs,
    xs <> nil ->
    nat_list_remove1 y (cons x xs) <> nil.
 Proof.
   intros x y xs xs_not_nil.
   unfold nat_list_remove1.
   assert ({x <> y} + {x = y}) as xy_options.
     apply eq_neq_dec.
   case xy_options.
   (* x <> y *)
     intro.
     assert (beq_nat y x = false).
       apply beq_nat_false_iff.
       apply not_eq_sym.
       assumption.
     replace (beq_nat y x) with false.
     discriminate.
   (* x = y *)
     intro.
     assert (beq_nat y x = true).
       apply beq_nat_true_iff.
       symmetry.
       assumption.
     replace (beq_nat y x) with true.
     assumption.
Qed.

Lemma noccs_in_remove :
  forall x y xs,
    noccs y (nat_list_remove1 x xs) > 0 ->
    noccs y xs > 0.
Proof.
  intros x y xs.
  induction xs.
  (* nil *)
  intro H.
  simpl in H.
  apply lt_irrefl in H.
  contradiction.
  (* cons *)
  intro H.
  assert ({x <> n} + {x = n}) as x_options.
    apply eq_neq_dec.
  case x_options.
  (* x <> n *)
    intro.
    unfold nat_list_remove1 in H; fold nat_list_remove1 in H.
    assert (beq_nat x n = false).
      apply beq_nat_false_iff.
      assumption.
     replace (beq_nat x n) with false in H.
     unfold noccs; fold noccs.
     unfold noccs in H; fold noccs in H.
     (* case y *)
     assert ({y <> n} + {y = n}) as y_options.
       apply eq_neq_dec.
       case y_options.
       (* y <> n *)
       intro.
       assert (beq_nat y n = false). apply beq_nat_false_iff. assumption.
       replace (beq_nat y n) with false in H.
       replace (beq_nat y n) with false.
       rewrite plus_0_r in H.
       rewrite plus_0_r.
       apply IHxs.
       assumption.
       (* y = n *)
       intro.
       assert (beq_nat y n = true). apply beq_nat_true_iff. assumption.
       replace (beq_nat y n) with true.
       rewrite plus_comm.
       simpl.
       apply lt_0_Sn.
  (* x = n *)
    intro.
    unfold nat_list_remove1 in H; fold nat_list_remove1 in H.
    assert (beq_nat x n = true). apply beq_nat_true_iff. assumption.
    replace (beq_nat x n) with true in H.
    unfold noccs; fold noccs.
    apply lt_plus_trans.
    assumption.
Qed.

Lemma selection_sort_sorts :
  forall xs, is_sorted (selection_sort xs).
Proof.
  intro.
  functional induction selection_sort xs.
  (* nil *)
  apply s_nil.
  (* cons *)
  case_eq ys.
  (* cons / nil *)
    intro ys_shape.
    unfold nat_list_min.
    unfold nat_list_remove1.
    assert (beq_nat y y = true).
      apply beq_nat_true_iff.
      reflexivity.
    replace (beq_nat y y) with true.
    apply s_singleton.
  (* cons / cons *)
    intros z zs ys_shape.
    replace (cons z zs) with ys.
    rewrite selection_sort_cons.
    apply s_cons.
      (* [1] first element is lesser than the second *)
      assert (noccs
                (nat_list_min (nat_list_remove1 (nat_list_min (cons y ys)) (cons y ys)))
                (nat_list_remove1 (nat_list_min (cons y ys)) (cons y ys))
                > 0) as noccs_min2_in_list1.
        apply min_in_list.
        apply nat_list_remove_not_nil.
        rewrite ys_shape.
        discriminate.
      apply nat_list_min_is_min.
      apply noccs_in_remove with (x := (nat_list_min (cons y ys))).
      assumption.
      (* [2] remainder of the list is sorted *)
      rewrite selection_sort_cons in IHn.
      assumption.
      (* trivial conditions of non-emptiness *)
      apply nat_list_remove_not_nil.
      rewrite ys_shape; discriminate.
      apply nat_list_remove_not_nil.
      rewrite ys_shape; discriminate.
Qed.


(* ************************************************* *)
(* introduction and examples                         *)
(* ************************************************* *)

(* example of a polymorphic function: identity *)

(* first the identity on natural numbers *)
Definition natid : nat -> nat :=
  fun n : nat => n.
Check (natid O).
Eval compute in (natid O).

(* then the identity on booleans *)
Definition boolid: bool -> bool :=
  fun b : bool => b.
Check (boolid true).
Eval compute in (boolid true).

(* now the polymorphic identity *)
Definition polyid : forall A : Set, A -> A :=
  fun (A : Set) => fun (a : A) => a.
Check polyid.

Check (polyid nat).
Check (polyid nat O).
Eval compute in (polyid nat O).
Check (polyid _ O).

Check (polyid bool).
Check (polyid bool true).
Eval compute in (polyid bool true).
Check (polyid _ true).

(* the following does not work:
Check (polyid _).
because Coq cannot infer what should be on the place of _ *)

(* notation *)
Notation id := (polyid _).
Check (id O).
Eval compute in (id O).
Check (id true).
Eval compute in (id true).

(* example of a polymorphic inductive definition: polylists *)

(* first the lists of natural numbers *)
Inductive natlist : Set :=
  natnil : natlist
| natcons : nat -> natlist -> natlist.

(* the list 2;1;0 *)
Check (natcons 2 (natcons 1 (natcons 0 natnil))).

(* then the lists of booleans *)
Inductive boollist : Set :=
  boolnil : boollist
| boolcons : bool -> boollist -> boollist.

(* now the polymorphic lists *)
Inductive polylist (X : Set) : Set :=
    polynil  : polylist X
  | polycons : X -> polylist X -> polylist X.

Check polylist.
Check (polylist nat).
Check (polylist bool).

Check polynil.
Check (polynil nat).
Check (polynil bool).
Check polycons.
Check (polycons nat).
Check (polycons bool).

(* again the list 2;1;0 *)
Check (polycons nat 2 (polycons nat 1 (polycons nat 0 (polynil nat)))).

(* we introduce some handy notation *)
Notation ni := (polynil _).
Notation co := (polycons _).
(* and write the list 2;1;0 again *)
Check (co 2 (co 1 (co 0 ni))).
Check (co true (co false ni)).

(* induction principle for polymorphic lists;
   more about this later *)
Check polylist_ind.

(* length of lists of natural numbers *)
Fixpoint natlength (l:natlist) {struct l} : nat :=
  match l with
    natnil => O
  | natcons h t => S (natlength t)
  end.

Eval compute in (natlength (natcons 2 (natcons 1 (natcons 0 natnil)))).

(* length of polymorphic lists *)
Fixpoint polylength (A:Set)(l:(polylist A)){struct l} : nat :=
  match l with
    polynil => O
  | polycons h t => S (polylength A t)
  end.

(* NB: in the recursive definition,
   polynil and polycons do _not_ get an argument A left of =>;
   they do get such arguments right of => *)

Eval compute in (polylength nat (polycons nat 2 (polycons nat 1 (polycons nat 0 (polynil nat))))).
Eval compute in (polylength nat (co 2 (co 1 (co 0 ni)))).

Eval compute in (polylength bool (polycons bool true (polycons bool false (polynil bool)))).
Eval compute in (polylength bool (co true (co false ni))).

(* remark1 about Coq notation:
   In the definition of polylist
   we use a parameter declaration (X:Set).
   Alternatively, we could define a type Set -> Type
   as follows: *)
Inductive polylistb : Set -> Type :=
  polynilb : forall X:Set, polylistb X
| polyconsb: forall X:Set, X -> polylistb X -> polylistb X.

(* but then we get a quite strange induction predicate *)
Check polylistb_ind.

(* so we usually take the first definition *)

(* ************************************************* *)
(*        start of the  exercises                    *)
(* ************************************************* *)

(*        exercises about polymorphic lists          *)
(*        see pw04 for similar exercises on natlists *)

(* exercise 1 *)
(* give the definition of polyappend for polymorphic lists *)
(* test it using Eval compute on an example *)

Fixpoint polyappend (X:Set) (k l : polylist X) {struct k} : (polylist X) :=
  match k with
  | polynil => l
  | polycons h t => polycons X h (polyappend X t l)
  end
  .

Eval compute in polyappend nat (co 1 (co 2 ni)) (co 42 (co 43 ni))
  .

(* prove the following lemma, to be used later*)
Lemma append_nil :
  forall X:Set, forall l: polylist X,
  polyappend X l (polynil X) = l.
Proof.
intros X l. induction l.
simpl. reflexivity.
simpl. rewrite -> IHl. reflexivity.
Qed.

(* exercise 3 *)
(* prove the following lemma, to be used later *)
Lemma append_assoc : forall X, forall k l m,
  (polyappend X (polyappend X k l) m) = (polyappend X k (polyappend X l m)).
Proof.
intros X k l m.

(* k = nil *)
induction k as [| kh kt].
simpl. reflexivity.

(* k = cons h t *)
simpl. induction l as [| lh lt].

(* l = nil *)
simpl. rewrite append_nil. reflexivity.

(* l = cons lh lt *)
simpl. rewrite IHkt. induction m as [| mh mt].

(* m = nil *)
simpl. reflexivity.

(* m = cons mh mt *)
simpl. reflexivity.
Qed.

(* exercise 4 *)
(* prove the following lemma *)
Lemma length_append :
 forall X:Set, forall k l : (polylist X),
  polylength X (polyappend X k l) = plus (polylength X k) (polylength X l).
Proof.
intros X k l.
induction k as [| kh kt].

(* k = nil *)
simpl. reflexivity.

(* k = cons kh kt *)
simpl. rewrite IHkt. reflexivity.
Qed.

(* exercise 5 *)
(* give the definition of polyreverse for polymorphic lists *)
(* test it using Eval compute on an example *)

Fixpoint polyreverse (X:Set) (l : polylist X) {struct l} :(polylist X) :=
  match l with
  | ni => ni
  | co h t => polyappend X (polyreverse X t) (co h ni)
  end
  .

Eval compute in (polyreverse nat (co 1 (co 2 (co 3 ni)))).

(* exercise 6 *)
(* prove the following lemma *)
Lemma reverse_append :
  forall X:Set, forall k l: (polylist X),
  polyreverse X (polyappend X k l) =
  polyappend X (polyreverse X l) (polyreverse X k).
Proof.
intros X.
induction k as [| kh kt].

(* k = nil *)
simpl. induction l as [| lh lt].

(* l = nil *)
simpl. reflexivity.

(* l = co lh lt *)
simpl. rewrite append_nil. reflexivity.

(* k = co kh kt *)
simpl. induction l as [| lh lt].

(* l = nil *)
simpl. rewrite IHkt. simpl. reflexivity.

(* l = co lh lt *)
simpl. rewrite IHkt. simpl. rewrite append_assoc.
reflexivity.
Qed.

(* exercise 7 *)
(* prove the following lemma *)
(* this does not correspond to a lemma in pw04 *)
Lemma rev_cons_app :
  forall X:Set, forall k l : (polylist X), forall x:X,
  polyappend X (polyreverse X (polycons X x k)) l =
  polyappend X (polyreverse X k) (polycons X x l).
Proof.
intro X.
induction k as [| kh kt]. induction l.

(* k = nil, l = nil *)
simpl. reflexivity.

(* k = nil, l = h t *)
simpl. reflexivity.

induction l as [| lh lt].

(* k = co kh kt, l = nil *)
intro x. simpl. rewrite append_nil. reflexivity.

(* k = co kh kt, l = co lh lt *)
intro x. simpl. rewrite <- IHkt. rewrite append_nil.
rewrite append_assoc.

simpl. reflexivity.
Qed.

(*        exercises about polymorphic pairs         *)

(* definition of pairs of natural numbers *)
Inductive natprod : Set :=
| natpair : nat -> nat -> natprod.

Check natpair.
Check natpair 1.
Check (natpair 1 2).

Check natprod_ind.

(* we define the first and second projection *)

Definition natprodfirst (p : natprod) : nat :=
match p with
| natpair x y => x
end.
Eval compute in (natprodfirst (natpair 1 2)).

Definition natprodsecond (p : natprod) : nat :=
match p with
| natpair x y => y
end.
Eval compute in (natprodsecond (natpair 1 2)).

(* exercise 8 *)
(* give a definition prod of polymorphic pairs
   where the first element comes from a set X
   and the second element comes from a set Y    *)

Inductive prod (X Y :Set) : Set :=
  | pair : forall (x : X) (y : Y), prod X Y.

(* exercise 9 *)
(* give definitions of the first and second projection *)

Definition fst (X Y : Set) (p: prod X Y) : X :=
  match p with
  | pair x y => x
  end.

Definition snd (X Y : Set) (p : prod X Y) : Y :=
  match p with
  | pair x y => y
  end.

(*        exercises about polymorphic trees       *)

(* definition of natbintrees
   with labels on the nodes  *)
Inductive natbintree : Set :=
    natleaf : natbintree
  | natnode : nat -> natbintree -> natbintree -> natbintree.

Check natleaf.
Check (natnode 1 natleaf natleaf).
Check (natnode 2 (natnode 1 natleaf natleaf) (natnode 3 natleaf natleaf)).

(* the last is the tree
               2
              / \
             1   3
*)

(* exercise 10 *)
(* give the definition polybintree with constructors polyleaf and polynode
   of polymorphic binary trees
   with labels on the nodes
   you may introduce handy notation *)

Inductive polybintree (X : Set) : Set :=
  | leaf : polybintree X
  | node : forall x:X, polybintree X -> polybintree X -> polybintree X
  .

(* exercise 11 *)
(* complete the definition of polyflatten
   polyflatten puts the labels of a polybintree from left to right in a polylist *)

Fixpoint polyflatten (X:Set) (t:polybintree X) {struct t} : (polylist X) :=
match t with
| leaf => polynil X
| node x l r => polyappend X (polyappend X (polyflatten X l) (co x ni)) (polyflatten X r)
end
.

(* perform some tests using the trees above *)

Definition tree123 := (node nat 2 (node nat 1 (leaf nat) (leaf nat)) (node nat 3 (leaf nat) (leaf nat))).
Eval compute in polyflatten nat tree123.

(*
vim: filetype=coq
*)


Require Export D.

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

Inductive or (P Q:Prop): Prop :=
|left : P -> or P Q
|right : Q -> or P Q
.

Theorem proj1 : forall (P Q:Prop),
  P/\Q -> P.
Proof.
  intros. destruct H. assumption. Qed.

Theorem or_commut : forall (P Q:Prop),
  P \/ Q -> Q \/ P.
Proof.
  intros. destruct H. right. assumption. left. assumption. Qed.


(* begin hide *)
Set Implicit Arguments.
Require Import Cpdt.CpdtTactics.
Require Export Coq.Strings.String.
Require Import Bool.
(* end hide *)

(*
03. From Coinductive.

1. (a) Define a co-inductive type of infinite trees carrying data of a fixed parameter type.
Each node should contain a data value and two child trees.
 *)

Section tree.

  Variable A : Type.
  CoInductive tree : Type :=
  | Node : tree -> A -> tree -> tree.

(*
(b) Define a function everywhere for building a tree with the same data value at every
node. *)

CoFixpoint everywhere (v : A) : tree := Node (everywhere v) v (everywhere v).

End tree.

(*
(c) Define a function map for building an output tree out of two input trees by travers-
ing them in parallel and applying a two-argument function to their corresponding
data values.
 *)

Section map.
  Variables A B C : Type.
  Variable f : A -> B -> C.
  CoFixpoint map (t1 : tree A) (t2 : tree B) : tree C :=
    match (t1, t2) with
    | ((Node t1' a t1''), (Node t2' b t2'')) => Node (map t1' t2') (f a b) (map t1'' t2'')
    end.
End map.

(* (d) Define a tree falses where every node has the value false. *)

Definition falses := everywhere false.

(* (e) Define a tree true_false where the root node has value true, its children have value
false, all nodes at the next have the value true, and so on, alternating boolean
values from level to level. *)

CoFixpoint true_false : tree bool := Node false_true true false_true
with false_true : tree bool := Node true_false false true_false.

(* (f ) Prove that true_false is equal to the result of mapping the boolean "or" function
orb over true_false and falses. You can make orb available with Require Import
Bool.. You may find the lemma orb_false_r from the same module helpful. Your
proof here should not be about the standard equality =, but rather about some
new equality relation that you define. *)

CoInductive trees_eq : tree bool -> tree bool -> Prop :=
| Trees_eq : forall t1' t1'' t2' t2'' x y,
    eq x y ->
    trees_eq t1' t2' ->
    trees_eq t1'' t2'' ->
    trees_eq (Node t1' x t1'') (Node t2' y t2'').

Definition frob (t : tree bool) : tree bool :=
  match t with
  | Node t1 x t2 => Node t1 x t2
  end.

Theorem frob_eq : forall t : tree bool, t = frob t.
destruct t. simpl. reflexivity. Qed.
    (* Frob didn't help below abowe. So we try to create co_induction principle according to book
Lemma F_case : trees_eq true_false ( map orb true_false falses ).
  cofix trees_eq.
  rewrite (frob_eq true_false) at 1.
  rewrite (frob_eq (map orb true_false falses)).
  simpl.
  constructor.
  - reflexivity.
  - cofix trees_eq'.
    rewrite (frob_eq false_true) at 1.
    rewrite (frob_eq (((cofix map (t1 t2 : tree bool) : tree bool :=
        match t1 with
        | Node t1' a t1'' =>
            match t2 with
            | Node t2' b t2'' => Node (map t1' t2') (a || b) (map t1'' t2'')
            end
        end) false_true
       ((cofix everywhere (v : bool) : tree bool := Node (everywhere v) v (everywhere v)) false)))).
    simpl.
    constructor.
    + reflexivity.
    + assumption.
    + assumption.
  - cofix trees_eq'.
    rewrite (frob_eq false_true) at 1.
    rewrite (frob_eq (((cofix map (t1 t2 : tree bool) : tree bool :=
        match t1 with
        | Node t1' a t1'' =>
            match t2 with
            | Node t2' b t2'' => Node (map t1' t2') (a || b) (map t1'' t2'')
            end
        end) false_true
       ((cofix everywhere (v : bool) : tree bool := Node (everywhere v) v (everywhere v)) false)))).
    simpl.
    constructor.
    + reflexivity.
    + assumption.
    + assumption.
Qed.     *)

    (* Frob didn't help abowe. So we try to create co_induction principle according to book *)

Definition mdl A (t : tree A) : A :=
  match t with
  | Node _ x _ => x
  end.

Definition left_tree A (t : tree A) : tree A :=
  match t with
  | Node lt _ _ => lt
  end.

Definition right_tree A (t : tree A) : tree A :=
  match t with
  | Node _ _ rt => rt
  end.

Section tree_eq_coind.
  Variable R : tree bool -> tree bool -> Prop.
  Hypothesis Node_case_mdl : forall t1 t2, R t1 t2 -> mdl t1 = mdl t2.
  Hypothesis Node_case_left_tree : forall t1 t2, R t1 t2 -> R (left_tree t1) (left_tree t2).
  Hypothesis Node_case_right_tree : forall t1 t2, R t1 t2 -> R (right_tree t1) (right_tree t2).

  Theorem tree_eq_coind : forall t1 t2, R t1 t2 -> trees_eq t1 t2.
    cofix tree_eq_coind; destruct t1; destruct t2; intro.
    generalize (Node_case_mdl H). intro Heq; simpl in Heq; rewrite Heq.
    constructor; auto.
    apply Node_case_left_tree in H. simpl in H.
    apply tree_eq_coind in H. auto.
    apply Node_case_right_tree in H.
    apply tree_eq_coind in H. auto.
  Qed.
End tree_eq_coind.

Print tree_eq_coind.

(* final lemma : exercise (f) *)
Lemma F_case : trees_eq true_false ( map orb true_false falses ).
  apply (tree_eq_coind (fun t1 t2 => (t1 = true_false /\
                                      t2 = (map orb true_false falses)) \/
(t1 = false_true /\ t2 = (map orb false_true falses))
        )); crush.
Qed.

  (* Helping
Print orb_false_r.

orb_false_r =
fun b : bool => if b as b0 return (b0 || false = b0) then eq_refl else eq_refl
     : forall b : bool, b || false = b

Arguments orb_false_r _%bool_scope

*)


Require Import nat.

Definition square (n:nat) : nat := n * n.

Lemma square_mult : forall (n m:nat),
    square (n * m) = square n * square m.
Proof.
    intros n m. unfold square.
    assert ((n * m) * (n * m) = ((n * m) * n) * m) as H1.
        { rewrite <- mult_assoc. reflexivity. }
    assert (((n * m) * n) * m = (n * (m * n)) * m) as H2.
        { rewrite (mult_assoc n m n). reflexivity. }
    assert ((n * (m * n)) * m = n * (n * m) * m) as H3.
        { rewrite (mult_comm m n). reflexivity. }
    assert (n * (n * m) * m = ((n * n) * m) * m) as H4.
        { rewrite <- (mult_assoc n n m). reflexivity. }
    assert (((n * n) * m) * m = (n * n) * (m * m)) as H5.
        { rewrite (mult_assoc (n * n) m m).  reflexivity. }
    rewrite H1, H2, H3, H4, H5. reflexivity.
Qed.


Require Import Bool Arith List CpdtTactics.
Set Implicit Arguments.
Set Asymmetric Patterns.

Inductive binop : Set :=
| Plus
| Times.

Inductive exp : Set :=
| Const : nat -> exp
| Binop : binop -> exp -> exp -> exp.

Check mult.

Definition binopDenote (b : binop) : nat -> nat -> nat :=
  match b with
  | Plus => plus
  | Times => mult
  end.

(* syntactic sugar *)

Definition binopDenoteReal : binop -> nat -> nat -> nat :=
  fun (b : binop) => match b with
                  | Plus => plus
                  | Times => mult
                  end.

(* CIC enjoys properties like strong normalization and relative consistency *)

(* every Coq source file is a series of vernacular commands, where many command forms take arguments that are Gallina or Ltac programs. *)

Fixpoint expDenote (e : exp) : nat :=
  match e with
  | Const n => n
  | Binop b e1 e2 => (binopDenote b) (expDenote e1) (expDenote e2)
  end.

(* Unlike with ML, which hardcodes an eager reduction strategy,
   or Haskell, which hardcodes a lazy strategy,
   in Coq we are free to choose between these and many other orders of evaluation,
   because all Coq programs terminate. *)

Eval simpl in expDenote (Const 42).
Eval simpl in expDenote (Binop Plus (Const 2) (Const 2)).
Eval simpl in expDenote (Binop Times (Binop Plus (Const 2) (Const 2)) (Const 7)).

Inductive instr : Set :=
| iConst : nat -> instr
| iBinop : binop -> instr.

Definition prog := list instr.
Definition stack := list nat.

Definition instrDenote (i : instr) (s : stack) : option stack :=
  match i with
  | iConst n => Some (n :: s)
  | iBinop b => match s with
               | arg1 :: arg2 :: s' => Some ((binopDenote b) arg1 arg2 :: s')
               | _ => None
               end
  end.

Fixpoint progDenote (p : prog) (s : stack) : option stack :=
  match p with
  | nil => Some s
  | i :: p' =>
    match instrDenote i s with
    | None => None
    | Some s' => progDenote p' s'
    end
  end.

Fixpoint compile (e : exp) : prog :=
  match e with
  | Const n => iConst n :: nil
  | Binop b e1 e2 => compile e2 ++ compile e1 ++ iBinop b :: nil
  end.

Eval simpl in compile (Const 42).
Eval simpl in compile (Binop Plus (Const 2) (Const 2)).
Eval simpl in compile (Binop Times (Binop Plus (Const 2) (Const 2)) (Const 7)).

Lemma compile_correct' : forall e p s,
    progDenote (compile e ++ p) s = progDenote p (expDenote e :: s).
Proof.
  induction e.
  - intros. unfold expDenote.
    unfold progDenote at 1. simpl. fold progDenote.
    reflexivity.
  (* Hypos are based on term e1 e2 *)
  - intros.
    unfold compile. fold compile.
    unfold expDenote. fold expDenote.
    rewrite app_assoc_reverse.
    rewrite IHe2.
    rewrite app_assoc_reverse.
    rewrite IHe1.
    simpl. reflexivity.
Qed.

Lemma compile_correct'' : forall e s p,
    progDenote (compile e ++ p) s = progDenote p (expDenote e :: s).
  induction e; crush.
Qed.

Theorem compile_correct : forall e,
    progDenote (compile e) nil = Some (expDenote e :: nil).
Proof.
  intro e.
  rewrite (app_nil_end (compile e)).
  apply compile_correct'.
Qed.

(* Coq uses case-sensitive variable names *)

Inductive type : Set :=
| Nat
| Bool.

(* We define tbinop as an indexed type family.
   Indexed inductive types are at the heart of Coq’s expressive power;
   almost everything else of interest is defined in terms of them *)
Inductive tbinop : type -> type -> type -> Set :=
| TPlus : tbinop Nat Nat Nat
| TTimes : tbinop Nat Nat Nat
| TEq : forall t, tbinop t t Bool
| TLt : tbinop Nat Nat Bool.

(* ML and Haskell have indexed algebraic datatypes.
   For instance, their list types are indexed by the type of data that the list carries.
   However, compared to Coq, ML and Haskell 98 place two important restrictions on datatype definitions. *)

Inductive texp : type -> Set :=
| TNConst : nat -> texp Nat
| TBConst : bool -> texp Bool
| TBinop : forall t1 t2 t, tbinop t1 t2 t -> texp t1 -> texp t2 -> texp t.

Definition typeDenote (t : type) : Set :=
  match t with
  | Nat => nat
  | Bool => bool
  end.

Definition tbinopDenote arg1 arg2 res (b : tbinop arg1 arg2 res) : typeDenote arg1 -> typeDenote arg2 -> typeDenote res :=
  match b with
  | TPlus => plus
  | TTimes => mult
  | TEq Nat => beq_nat
  | TEq Bool => eqb
  | TLt => leb
  end.

Fixpoint texpDenote t (e : texp t) : typeDenote t :=
  match e with
  | TNConst n => n
  | TBConst b => b
  | TBinop _ _ _ b e1 e2 => (tbinopDenote b) (texpDenote e1) (texpDenote e2)
  end.

Eval simpl in texpDenote (TNConst 42).
Eval simpl in texpDenote (TBinop TTimes (TBinop TPlus (TNConst 2) (TNConst 2)) (TNConst 7)).

(* I bet first examples are very confused to me ! *)


Require Import Coq.Arith.Wf_nat.
Require Import Coq.Logic.Classical_Prop.
Section MINIMAL_EXISTENCE.

Variable P : nat -> Prop.

Lemma P_upto_n_dec:
  forall n, (exists m, m < n /\ P m) \/ (forall m, m < n -> ~ P m).
Proof.
  intros.
  destruct (classic(exists m, m < n /\ P m)).
  tauto.
  firstorder.
Qed.

Lemma minimal_exists_aux:
  forall n, P n -> exists m, P m /\ forall p, p < m -> ~ P p.
Proof.
  intro n.
  induction n as [n IH] using lt_wf_ind.
  destruct (P_upto_n_dec n) as [[m [A B]] | C].
  apply IH in A.
  intro.
  assumption.
  assumption.
  intro.
  exists n.
  tauto.
Qed.

Lemma minimal_exists:
  (exists n, P n) -> exists m, P m /\ forall p, p < m -> ~ P p.
Proof.
  intros.
  destruct H as [n].
  apply minimal_exists_aux in H.
  assumption.
Qed.

End MINIMAL_EXISTENCE.


From Coq Require Export String.
From LF Require Export Basics.

Theorem plus_n_O_firsttry : forall n:nat,
  n = n + 0.

Proof.
  intros n.
  simpl. (* Does nothing! *)
Abort.

Theorem plus_n_O_secondtry : forall n:nat,
  n = n + 0.
Proof.
  intros n. destruct n as [| n'] eqn:E.
  - (* n = 0 *)
    reflexivity. (* 虽然目前还没啥问题... *)
  - (* n = S n' *)
    simpl. (* ...不过我们又卡在这儿了 *)
Abort.

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

Theorem minus_diag : forall n,
  minus n n = 0.
Proof.
  (* 课上已完成 *)
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *)
    simpl. reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity.
Qed.
(*my proof*)
Theorem mult_0_r : forall n:nat,
  n * 0 = 0.
Proof.
  intros n. induction n as [| n' IHn'].
  -(* n = 0 *)
    simpl. reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity.
Qed.
(*my proof*)
Theorem plus_n_Sm : forall n m : nat,
  S (n + m) = n + (S m).
Proof.
  intros n m. induction n as [| n' IHn'].
  -(* n = 0 *)
    destruct m as [| m'] eqn:E.
    +(* m = 0 *)
      simpl. reflexivity.
    +(* m = S m' *)
      simpl. reflexivity.
  - (* n = S n' *)
    destruct m as [| m'] eqn:E.
    +(* m = 0 *)
      simpl. rewrite -> IHn'. reflexivity.
    +(* m = S m' *)
      simpl. rewrite -> IHn'. reflexivity.
Qed.
(*my proof*)
Theorem plus_comm : forall n m : nat,
  n + m = m + n.
Proof.
  intros n m. induction n as [| n' IHn'].
  -(* n = 0 *)
    induction m as [| m' IHm'].
    +(* m = 0 *)
      simpl. reflexivity.
    +(* m = S m' *)
      simpl. rewrite <- IHm'. reflexivity.
  - (* n = S n' *)
    induction m as [| m' IHm'].
    +(* m = 0 *)
      simpl. rewrite -> IHn'. reflexivity.
    +(* m = S m' *)
      simpl. rewrite -> IHn'. simpl. rewrite <- plus_n_Sm. reflexivity.
Qed.
(*my proof*)
Theorem plus_assoc : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  intros n m p.
  induction n as [].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn. reflexivity.
Qed.
(*my proof*)
Fixpoint double (n:nat) :=
  match n with
  | O => O
  | S n' => S (S (double n'))
  end.
(*my proof*)
Lemma double_plus : forall n, double n = n + n .
Proof.
  intros n. induction n as [| n' IHn'].
  -(* n = 0 *)
    simpl. reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. rewrite <- plus_n_Sm. reflexivity.
Qed.
(*my proof*)
Theorem evenb_S : forall n : nat,
  evenb (S n) = negb (evenb n).
Proof.
  intros n. induction n as [| n' IHn'].
  -(* n = 0 *)
    simpl. reflexivity.
  - (* n = S n' *)
    rewrite -> IHn'. simpl. rewrite -> negb_involutive. reflexivity.
Qed.

(* 请勿修改下面这一行： *)
Definition manual_grade_for_destruct_induction : option (nat*string) := None.

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).
Check plus_comm.
(*forall n m : nat, n + m = m + n*)
Proof.
  intros n m p q.
  (* 我们只需要将 (m + n) 交换为 (n + m)... 看起来 plus_comm 能搞定！*)
  rewrite -> plus_comm.
  (* 搞不定... Coq 选错了要改写的加法！ *)
Abort.

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 -> plus_comm. reflexivity. }
  rewrite -> H. reflexivity. Qed.

Theorem plus_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'. reflexivity. Qed.

Theorem plus_assoc'' : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  intros n m p. induction n as [| n' IHn'].
  - (* n = 0 *)
    reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity. Qed.
(*my proof*)
Theorem plus_swap : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  intros n m p.
  rewrite -> plus_comm.
  assert (H: p+n=n+p). { rewrite -> plus_comm. reflexivity. }
  rewrite <- H. rewrite <- plus_assoc'. reflexivity.
Qed.

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

Theorem plus_swap'' : forall n m p q : nat,
  n + m + (p + q)  = n + p + (m+ q).
Proof.
  intros n m p q.
  rewrite <- plus_assoc.
  assert (H: m + (p + q) = p + (m + q)).
  { rewrite -> plus_swap. reflexivity. }
  rewrite -> H. rewrite <- plus_assoc.
  reflexivity.
Qed.

(* ===> forall n m : nat, n * m + n = n * S m *)

Theorem mult_comm : forall m n : nat,
  m * n = n * m.
Proof.
  intros m n.
  induction m as [].
  - induction n as [].
    + reflexivity.
    + simpl. rewrite <- IHn. simpl.
      reflexivity.
  - induction n as [].
    + simpl. rewrite -> IHm. simpl.
      reflexivity.
    + simpl. rewrite -> IHm. simpl.
      rewrite <- mult_n_Sm. simpl.
      rewrite -> plus_swap'. reflexivity.
Qed.

Theorem leb_refl : forall n:nat,
  true = (n <= n).
Proof.
  intros n.
  simpl. induction n as []. simpl.
  reflexivity. simpl. apply IHn.
Qed.
Theorem zero_nbeq_S : forall n:nat,
  (0 = (S n)) = false.
Proof.
  intros n.
  simpl. reflexivity.
Qed.
Theorem andb_false_r : forall b : bool,
  andb b false = false.
Proof.
  (* 请在此处解答 *)
  intros b. destruct b as []. simpl.
  reflexivity. simpl. reflexivity.
Qed.
Theorem plus_ble_compat_l : forall n m p : nat,
  (n <= m) = true -> ((p + n) <= (p + m)) = true.
Proof.
  (* 请在此处解答 *)
  intros n m p eq. induction p as [].
  - simpl. rewrite -> eq. reflexivity.
  - simpl. rewrite -> IHp. reflexivity.
Qed.
Theorem S_nbeq_0 : forall n:nat,
  ((S n) = 0) = false.
Proof.
  (* 请在此处解答 *)
  intros n. simpl. reflexivity.
Qed.
Theorem mult_1_l :forall n:nat, 1* n = n.
Proof.
  (* 请在此处解答 *)
  intros n. simpl.
  induction n as [].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn.
    reflexivity.
Qed.
Theorem all3_spec : forall b c : bool,
    orb
      (andb b c)
      (orb (negb b)
               (negb c))
  = true.
Proof.
  (* 请在此处解答 *)
  intros b c.
  destruct b as [].
  - destruct c as [].
    * simpl. reflexivity.
    * simpl. reflexivity.
  - destruct c as [].
    * simpl. reflexivity.
    * simpl. reflexivity.
Qed.

(* mult_n_Sm ===> forall n m : nat, n * m + n = n * S m *)

(*  plus_swap'' ===> forall n m p q : nat,
  n + m + (p + q)  = n + p + (m+ q) *)
Theorem mult_plus_distr_r : forall n m p : nat,
  (n + m) * p = (n * p) + (m * p).
Proof.
  (* 请在此处解答 *)
  intros n m p.
  induction p as [].
  - simpl. rewrite <- mult_n_O.
    rewrite -> mult_n_0_m_0.
    reflexivity.
  - simpl. rewrite <- mult_n_Sm.
    rewrite <- mult_n_Sm. rewrite <- mult_n_Sm.
    rewrite -> IHp. rewrite -> plus_swap''.
    reflexivity.
Qed.
Theorem mult_assoc : forall n m p : nat,
  n * (m * p) = (n * m) * p.
Proof.
  (* 请在此处解答 *)
  intros n m p.
  rewrite -> mult_comm.
  induction n as [].
  - simpl. rewrite <- mult_n_O.
    reflexivity.
  - simpl. rewrite -> mult_plus_distr_r.
    rewrite <- IHn. rewrite <- mult_n_Sm.
    rewrite <- plus_comm. reflexivity.
Qed.

Theorem eqb_refl : forall n : nat,
  true = (n = n).
Proof.
  (* 请在此处解答 *)
  intros n. induction n as [].
  - simpl. reflexivity.
  - simpl. rewrite <- IHn. reflexivity.
Qed.

Theorem plus_swap''' : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  (* 请在此处解答 *)
  intros n m p.
  rewrite -> plus_assoc''.
  rewrite -> plus_assoc''.
  replace (m+n) with (n+m).
  - reflexivity.
  - rewrite -> plus_comm. reflexivity.
Qed.

Lemma nat_add' : forall n : nat,
  S (n +S (n+0)) = S (S (n+(n+0))).
Proof.
  intros n. rewrite <- plus_n_O.
  rewrite <- plus_n_Sm. reflexivity.
Qed.

Lemma  bin_to_nat_pres_incr : forall b : bin ,
  bin_to_nat (incr b) = S (bin_to_nat b).
Proof.
  intros b.
  induction b as [].
  - simpl. reflexivity.
  - simpl. reflexivity.
  - simpl. rewrite -> IHb. simpl.
    rewrite -> nat_add'. reflexivity.
Qed.

Fixpoint nat_to_bin (n:nat) : bin :=
  (* 将本行替换成 ":= _你的_定义_ ." *)
  match n with
  |O => Z
  |S n' => incr (nat_to_bin n')
end.

Compute (nat_to_bin 8).

Theorem nat_bin_nat : forall n,
  bin_to_nat (nat_to_bin n) = n.
Proof.
  (* 请在此处解答 *)
  intros n. induction n as [].
  - simpl. reflexivity.
  - simpl. rewrite -> bin_to_nat_pres_incr.
    rewrite -> IHn. reflexivity.
Qed.

Fixpoint normalize (b : bin) : bin :=
  match b with
  |Z=>Z
  |A b' => match normalize b' with
           |Z => Z
           |b'' => A b''
           end
  |B b' => B (normalize b')
end.

Compute (normalize (A (A (A (A Z))))).


Require Import Nat Arith.

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

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

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

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

Fixpoint append (append_arg0 : Lst) (append_arg1 : Lst) : Lst
           := match append_arg0, append_arg1 with
              | nil, x => x
              | cons x y, z => cons x (append y z)
              end.

Fixpoint len (len_arg0 : Lst) : Nat
           := match len_arg0 with
              | nil => zero
              | cons x y => succ (len y)
              end.

Fixpoint rotate (rotate_arg0 : Nat) (rotate_arg1 : Lst) : Lst
           := match rotate_arg0, rotate_arg1 with
              | zero, x => x
              | succ n, nil => nil
              | succ n, cons y x => rotate n (append x (cons y nil))
              end.

Lemma append_nil : forall (x : Lst), append x nil = x.
Proof.
  intros.
  induction x.
  - reflexivity.
  - simpl. rewrite IHx. reflexivity.
Qed.

Lemma append_assoc : forall (x y z : Lst), append (append x y) z = append x (append y z).
Proof.
  intros.
  induction x.
  - reflexivity.
  - simpl. rewrite IHx. reflexivity.
Qed.

Theorem theorem0 : forall (x : Lst) (y : Lst), eq (rotate (len x) (append x y)) (append y x).
Proof.
  induction x.
  - intros. simpl. rewrite append_nil. reflexivity.
  - intros. simpl. rewrite append_assoc. rewrite IHx. rewrite append_assoc. simpl. reflexivity.
Qed.


(** * 6.887 Formal Reasoning About Programs - Lab 1 *)

Require Import Frap.

(* Authors: Peng Wang (wangpeng@csail.mit.edu), Adam Chlipala (adamc@csail.mit.edu) *)

(** * MapReduce *)

(* *MapReduce* is a popular model for distributed computing in data centers.  See:
 *   https://en.wikipedia.org/wiki/MapReduce
 * But we'll explain our tiny subset of it from scratch here and prove some
 * algebraic properties.  We'll make the simplifying assumption that every
 * MapReduce job starts as a list of natural numbers.  Our goal is to compute
 * some summary of such lists. *)

(* The first step of a MapReduce job is a *map*, which applies a pure function
 * to every element of the input list, producing a new derived list.
 * We can define a syntactic type of allowed map operations. *)
Inductive map_ :=
| Constant (n : nat)
| Input
| Add (e1 e2 : map_)
| Compose (e1 e2 : map_).

(* After replacing each input element with some new value, we apply some
 * operator repeatedly to reduce to a final summary.  Here are the operators
 * supported in our modest simplification. *)
Inductive reduce :=
| Sum
| Max.

(* Paired together, they form a whole MapReduce task. *)
Definition mapReduce := (map_ * reduce)%type.
                           (* ^-- pair type *)

(* Here's what a [map_] does to a number. *)
Fixpoint interp_map (e : map_) (x : nat) : nat :=
  match e with
  | Constant n => n
  | Input => x
  | Add e1 e2 => interp_map e1 x + interp_map e2 x
  | Compose e1 e2 => interp_map e1 (interp_map e2 x)
  end.

(* And here's what a [reduce] does to a list of numbers. *)
Definition interp_reduce (e : reduce) (ls : list nat) : nat :=
  match e with
  | Sum => fold_left plus ls 0
  | Max => fold_left max ls 0
  end.
(* It may be helpful to examine the definition of [fold_left]. *)
Print fold_left.

(* Now we have the overall MapReduce job executor. *)
Definition interp_mr (e : mapReduce) ls :=
  interp_reduce (snd e) (map (interp_map (fst e)) ls).
              (* ^-- projection functions --^ *)

(* Here's a simple condition on a [map_], capturing when it only contains
 * positive constants.  That will imply that, given a positive input, the
 * output is also positive, which you will prove, as specified below. *)
Fixpoint allPositive (m : map_) : Prop :=
  match m with
  | Constant n => n > 0
  | Input => True
  | Add m1 m2 => allPositive m1 /\ allPositive m2
  | Compose m1 m2 => allPositive m1 /\ allPositive m2
  end.

(* Finally, the module type listing the theorems that we ask you to prove. *)
Module Type S.
  (* Prove that [allPositive] means what we want it to mean. *)
  Axiom allPositive_ok : forall (m : map_) (x : nat),
    allPositive m
    -> x > 0
    -> interp_map m x > 0.

  (* Input order is irrelevant to the results of MapReduce jobs. *)
  Axiom reduce_swap : forall (e : reduce) (ls1 ls2 : list nat),
    interp_reduce e (ls1 ++ ls2) = interp_reduce e (ls2 ++ ls1).
  Axiom interp_swap : forall (e : mapReduce) (ls1 ls2 : list nat),
    interp_mr e (ls1 ++ ls2) = interp_mr e (ls2 ++ ls1).
  (* Note that a list of length [n] can, in general, be expressed as [n+1]
   * different concatenations of other lists.  These theorems tell us that
   * swapping at any split point in the input list preserves output values.
   * Iterating these results shows that any permutation on an input list leads
   * to the same output. *)

  (* Furthermore, we can decompose computation into arbitrary treelike structures.
   * That is, we can break the input list into chunks, or *partitions*, and
   * reduce them separately, then do a further reduce on those results.
   * Imagine a different server in a cluster assigned to each partition, so that
   * they can all run in parallel, saving significant time over treating the
   * whole input list sequentially. *)
  Axiom mapReduce_partition_two : forall (m : map_) (r : reduce) (ls1 ls2 : list nat),
    interp_mr (m, r) (ls1 ++ ls2) = interp_reduce r [interp_mr (m, r) ls1; interp_mr (m, r) ls2].
  Arguments app {_} _ _ . (* Some magic to allow us to use [app] below,
                           * without specifying its type parameter *)
  Axiom mapReduce_partition : forall (m : map_) (r : reduce) (lsls : list (list nat)),
    interp_mr (m, r) (fold_left app lsls []) = interp_reduce r (map (interp_mr (m, r)) lsls).
  (* Note that here [lsls], a list of lists, expresses an arbitrary division of
   * a list into contiguous partitions. *)

End S.

(* That's the end of the required part of this assignment.
 * Since we are still working on gauging difficulty, we're also including
 * another, optional part, in case you are looking for something else to do!
 * When you submit your solution, we'll appreciate your feedback on whether we
 * should have made this next part required. *)

(** * Interpreting unbounded loops *)

(* First, let's copy in the last lecture's interpreter for a loopy language. *)

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.

Fixpoint interp (e : arith) (v : valuation) : nat :=
  match e with
  | Const n => n
  | Var x =>
    match v $? x with
    | None => 0 (* goofy default value! *)
    | 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.

Inductive cmd :=
| Skip
| Assign (x : var) (e : arith)
| Sequence (c1 c2 : cmd)
| Repeat (e : arith) (body : cmd).

Fixpoint selfCompose {A} (f : A -> A) (n : nat) : A -> A :=
  match n with
  | O => fun x => x
  | S n' => fun x => selfCompose f n' (f x)
  end.

Fixpoint exec (c : cmd) (v : valuation) : valuation :=
  match c with
  | Skip => v
  | Assign x e => v $+ (x, interp e v)
  | Sequence c1 c2 => exec c2 (exec c1 v)
  | Repeat e body => selfCompose (exec body) (interp e v) v
  end.

(* That's the end of the copied code.  Next, we define a popular optimization
 * for languages of this type: *constant propagation*, which infers that certain
 * variables hold known values at certain points, so that mentions of those
 * variables can be *replaced* with constants. *)

(* This function applies constant propagation to an arithmetic expression.
 * It takes a variable valuation as an argument.  Recall that valuations are
 * *partial* finite maps; not all variables will be present.  In fact, even
 * fewer variables will be present than for the interpreter: we only include
 * mappings for those variables *whose values are known at compile time*.
 * Those are exactly the variables that we should replace in the expression! *)
Fixpoint constPropArith (e : arith) (v : valuation) : arith :=
  match e with
  | Const _ => e
  | Var x => match v $? x with
             | None => e
             | Some n => Const n (* Found a replaceable variable! *)
             end
  | Plus e1 e2 =>
    let e1' := constPropArith e1 v in
    let e2' := constPropArith e2 v in
    match e1', e2' with
    | Const n1, Const n2 => Const (n1 + n2)
    | _, _ => Plus e1' e2'
    end
  | Minus e1 e2 =>
    let e1' := constPropArith e1 v in
    let e2' := constPropArith e2 v in
    match e1', e2' with
    | Const n1, Const n2 => Const (n1 - n2)
    | _, _ => Minus e1' e2'
    end
  | Times e1 e2 =>
    let e1' := constPropArith e1 v in
    let e2' := constPropArith e2 v in
    match e1', e2' with
    | Const n1, Const n2 => Const (n1 * n2)
    | _, _ => Times e1' e2'
    end
  end.

(* Crucial helper function.  It takes in a valuation assigning constant values
 * to those variables where we can figure out the constants.  It then models how
 * that knowledge *changes* based on the effect of a command. *)
Fixpoint effectOf (c : cmd) (v : valuation) : valuation :=
  match c with
  | Skip => v
  | Assign x e =>
    let e' := constPropArith e v in
    match e' with
    | Const n =>
      v $+ (x, n)
      (* We inferred the value that is being assigned.
       * Record that knowledge in the valuation. *)
    | _ =>
      v $- x
      (* We couldn't be sure what value is assigned.
       * Conservatively, *remove* this variable from the valuation.
       * (Note the use of a new infix operator for removal.) *)
    end
  | Sequence c1 c2 =>
    effectOf c2 (effectOf c1 v)
    (* Crucial pattern: we take the effect of [c1], followed by the effect of
     * [c2]. *)
  | Repeat _ _ => $0
    (* It would take much more advanced analysis to summarize the effect of a
     * loop, so let's punt and return an empty set of knowledge. *)
  end.

(* OK, we come to the main transformation, parameterized on knowledge, like the
 * other functions have been. *)
Fixpoint constProp (c : cmd) (v : valuation) : cmd :=
  match c with
  | Skip => c
  | Assign x e => Assign x (constPropArith e v)
  | Sequence c1 c2 =>
    Sequence (constProp c1 v) (constProp c2 (effectOf c1 v))
    (* Here we have a crucial use of [effectOf], to expand the knowledge as we
     * descend into the second command. *)
  | Repeat e c1 =>
    Repeat (constPropArith e v) (constProp c1 $0)
    (* Again, because analyzing loops is beyond our intentions, we reset
     * knowledge to empty as we descend into the loop body. *)
  end.

(* You may remember this helpful lemma from class.
 * It's likely to come in handy again here. *)
Lemma selfCompose_extensional : forall {A} (f g : A -> A) n x,
  (forall y, f y = g y)
  -> selfCompose f n x = selfCompose g n x.
Proof.
  induct n; simplify; try equality.

  rewrite H.
  apply IHn.
  trivial.
Qed.

(* Finally, we come to your task: prove this fact. *)
Definition whatToProve := forall (c : cmd) (v1 v2 : valuation),
  (* [v1] captures compile-time knowledge of variable values,
   * while [v2] captures the full runtime knowledge.
   * The premise here captures that [v1] includes a subset of the mappings known
   * in [v2]. *)
  (forall x n, v1 $? x = Some n -> v2 $? x = Some n)
  (* Given that premise, we conclude that constant propagation doesn't change
   * the semantics of commands. *)
  -> exec (constProp c v1) v2 = exec c v2.