(** * MoreLogic: More on Logic in Coq *)

Require Export "Prop".

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

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

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

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

*)

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

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

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

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

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

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

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

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

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

(** Here is another example of how to work with existentials. *)
Lemma exists_example_3 :
  exists (n:nat), even n /\ beautiful n.
Proof.
(* WORKED IN CLASS *)
  exists 8.
  split.
  unfold even. simpl. reflexivity.
  apply b_sum with (n:=3) (m:=5).
  apply b_3. apply b_5.
Qed.

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

(* FILL IN HERE *)

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

Theorem dist_not_exists : forall (X:Type) (P : X -> Prop),
  (forall x, P x) -> ~ (exists x, ~ P x).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

Theorem not_exists_dist :
  excluded_middle ->
  forall (X:Type) (P : X -> Prop),
    ~ (exists x, ~ P x) -> (forall x, P x).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

Theorem dist_exists_or : forall (X:Type) (P Q : X -> Prop),
  (exists x, P x \/ Q x) <-> (exists x, P x) \/ (exists x, Q x).
Proof.
   (* FILL IN HERE *) Admitted.
(** [] *)

(* ###################################################### *)
(** * Evidence-Carrying Booleans *)

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

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

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

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

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

(** *** *)

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

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

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

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

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

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

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

(** **** Exercise: 1 star (override_shadow')  *)
Theorem override_shadow' : forall (X:Type) x1 x2 k1 k2 (f : nat->X),
  (override' (override' f k1 x2) k1 x1) k2 = (override' f k1 x1) k2.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

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

Inductive all (X : Type) (P : X -> Prop) : list X -> Prop :=
  (* FILL IN HERE *)
.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Lemma appears_in_app : forall (X:Type) (xs ys : list X) (x:X),
     appears_in x (xs ++ ys) -> appears_in x xs \/ appears_in x ys.
Proof.
  (* FILL IN HERE *) Admitted.

Lemma app_appears_in : forall (X:Type) (xs ys : list X) (x:X),
     appears_in x xs \/ appears_in x ys -> appears_in x (xs ++ ys).
Proof.
  (* FILL IN HERE *) Admitted.

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

(* FILL IN HERE *)

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

(* FILL IN HERE *)

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

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

(** **** Exercise: 3 stars (nostutter)  *)
(** Formulating inductive definitions of predicates is an important
    skill you'll need in this course.  Try to solve this exercise
    without any help at all.

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

Inductive nostutter:  list nat -> Prop :=
 (* FILL IN HERE *)
.

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

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

Example test_nostutter_1:      nostutter [3;1;4;1;5;6].
(* FILL IN HERE *) Admitted.
(*
  Proof. repeat constructor; apply beq_nat_false; auto. Qed.
*)

Example test_nostutter_2:  nostutter [].
(* FILL IN HERE *) Admitted.
(*
  Proof. repeat constructor; apply beq_nat_false; auto. Qed.
*)

Example test_nostutter_3:  nostutter [5].
(* FILL IN HERE *) Admitted.
(*
  Proof. repeat constructor; apply beq_nat_false; auto. Qed.
*)

Example test_nostutter_4:      not (nostutter [3;1;1;4]).
(* FILL IN HERE *) Admitted.
(*
  Proof. intro.
  repeat match goal with
    h: nostutter _ |- _ => inversion h; clear h; subst
  end.
  contradiction H1; auto. Qed.
*)
(** [] *)

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

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

Lemma app_length : forall (X:Type) (l1 l2 : list X),
  length (l1 ++ l2) = length l1 + length l2.
Proof.
  (* FILL IN HERE *) Admitted.

Lemma appears_in_app_split : forall (X:Type) (x:X) (l:list X),
  appears_in x l ->
  exists l1, exists l2, l = l1 ++ (x::l2).
Proof.
  (* FILL IN HERE *) Admitted.

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

Inductive repeats {X:Type} : list X -> Prop :=
  (* FILL IN HERE *)
.

(** Now here's a way to formalize the pigeonhole principle. List [l2]
    represents a list of pigeonhole labels, and list [l1] represents
    the labels assigned to a list of items: if there are more items
    than labels, at least two items must have the same label.  This
    proof is much easier if you use the [excluded_middle] hypothesis
    to show that [appears_in] is decidable, i.e. [forall x
    l, (appears_in x l) \/ ~ (appears_in x l)].  However, it is also
    possible to make the proof go through _without_ assuming that
    [appears_in] is decidable; if you can manage to do this, you will
    not need the [excluded_middle] hypothesis. *)

Theorem pigeonhole_principle: forall (X:Type) (l1  l2:list X),
   excluded_middle ->
   (forall x, appears_in x l1 -> appears_in x l2) ->
   length l2 < length l1 ->
   repeats l1.
Proof.
   intros X l1. induction l1 as [|x l1'].
  (* FILL IN HERE *) Admitted.
(** [] *)

(* FILL IN HERE *)

(** $Date: 2014-12-31 16:01:37 -0500 (Wed, 31 Dec 2014) $ *)


Module NatPlayground.

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

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

End NatPlayground.

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

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

Definition oddb ( n : nat) : bool := negb ( evenb n).

Module NatPlayground2.

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

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

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

  End NatPlayground2.

  Fixpoint exp ( base power : nat) : nat :=
    match power with
    | O  => S O
    | S p => mult base (exp base p)
    end.

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

  Notation "x + y" := (plus x y)
                        (at level 50, left associativity)
                      : nat_scope.
  Notation "x - y" := (minus x y)
                        (at level 50, left associativity)
                      :nat_scope.
  Notation " x * y" :=(mult x y)
                        (at level 40, left associativity)
                      :nat_scope.

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

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

  Example test_leb1: (leb 2 2)  = true.
  Proof. simpl. reflexivity. Qed.
  Example test_leb2: (leb 1 4) = true.
  Proof. simpl. reflexivity. Qed.
  Example test_leb3: (leb 5 2) = false.
  Proof. simpl. reflexivity. Qed.

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

  Example test_blt_nat1: (blt_nat 2 2) =false.
  Proof. simpl. reflexivity. Qed.

  Theorem plus_O_n : forall n : nat, O + n = n.
  Proof.
    intros n. simpl. reflexivity. Qed.

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

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

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

  Theorem plus_id_exercise: forall n m o: nat,
      n = m -> m = o -> n + m = m + o.
  Proof.
    intros n m o.
    intros H.
    rewrite -> H.
    intros H0.
    rewrite -> H0.
    reflexivity. Qed.

  Theorem mult_O_plus : forall n m: nat,
      (O + n) * m = n * m.
  Proof.
    intros n m.
    rewrite -> plus_O_n.
    reflexivity. Qed.

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

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

  Theorem andb_commutative : forall b c, andb b c = andb c b.
  Proof.
    intros b c. destruct b.
    - destruct c.
      + reflexivity.
      + reflexivity.
    - destruct c.
      + reflexivity.
      + reflexivity.
  Qed.

  Theorem andb_true_elim2 : forall b c:bool,
      andb b c = true -> c = true.
  Proof.
    intros [] c.
    - simpl.
      congruence.
    - simpl.
      discriminate.
  Qed.

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

  (* Fixpoint tmp_rec ( n m : nat) : nat :=
    match n with
    | O => O
    | _ =>
      match m with
      | O => (tmp_rec (n + 1) (m + 1))
      | _ => (tmp_rec (minustwo n) O)
      end
    end. *)
  Theorem identity_fn_applied_twice :
    forall ( f : bool -> bool),
      (forall (x : bool), f x = x) ->
      forall (b : bool), f ( f b) = b.
  Proof.
    intros f x b.
    rewrite -> x.
    rewrite -> x.
    reflexivity.
    Qed.

  Theorem negation_fn_applied_twice :
    forall (f :bool -> bool),
      (forall (x : bool), f x = negb x) ->
      forall (b : bool), f ( f b) = b.
  Proof.
    intros f x b.
    rewrite -> x.
    rewrite -> x.
    destruct b.
    - reflexivity.
    - reflexivity.
  Qed.

  Theorem andb_eq_orb :
    forall ( b c :bool), (andb b c = orb b c) -> b =c.
  Proof.
    intros [] c.
    - simpl.
      congruence.
    - simpl.
      congruence.
  Qed.


From mathcomp Require Import all_ssreflect.

(** *** Exercise 1 :
    - Prove this statement by induction  using big_nat_recr and big_geq
    - alternatively by using big_morph
*)

Lemma sum_mull f (k n : nat) :
  k * (\sum_(0 <= i < n) f i) = \sum_(0 <= i < n) (k * f i).
Proof.
(*D*)(* elim: n => [|n IH]; first by rewrite !big_geq. *)
(*D*)(* by rewrite !big_nat_recr //= mulnDr IH. *)
(*D*)by apply: (big_morph (fun n => k * n)) => // x y; rewrite mulnDr.
Qed.

(** *** Exercise 2 :
    - Prove this statement by using big_morph
*)

Lemma sum_mulr f (k n : nat) :
  (\sum_(0 <= i < n) f i) * k = \sum_(0 <= i < n) (f i * k).
Proof.
(*D*)(* elim: n => [|n IH]; first by rewrite !big_geq. *)
(*D*)(* by rewrite !big_nat_recr //= mulnDl IH. *)
(*D*)by apply: (big_morph (fun n => n * k)) => // x y; rewrite mulnDl.
Qed.

(** *** Exercise 3 :
    - Prove this statement by induction.
    - Relevant lemmas are
        - doubleS odd_double addn0 addnn mulnn
        - big_mkcond big_nat_recr big_geq
*)

Lemma sum_odd n : \sum_(0 <= i < n.*2 | odd i) i = n ^ 2.
Proof.
(*D*)elim: n => [|n IHn]; first by rewrite big_geq.
(*D*)rewrite doubleS big_mkcond 2?big_nat_recr // -big_mkcond /=.
(*D*)rewrite {}IHn odd_double /= addn0 -addnn -!mulnn.
(*D*)by rewrite mulSn mulnC mulSn addnA addSn addnC.
Qed.

(** *** Exercise 4 :
    - Prove this statement by induction.
    - Relevant lemmas are
        - doubleD muln2 addn2 big_nat_recr big_geq
*)

Lemma sum_gauss n : (\sum_(0 <= i < n) i).*2 = n * n.-1.
Proof.
(*D*)elim: n => [|n IH]; first by rewrite big_geq.
(*D*)rewrite big_nat_recr //= doubleD {}IH.
(*D*)case: n => [|n /=]; first by rewrite muln0.
(*D*)by rewrite -muln2 -mulnDr addn2 mulnC.
Qed.

(**
   In what follows we are going to mimic the proof of Gauss :

<<
       1 +     2 + .....        +  n.-2     + n.-1
 +  n.-1 +  n.-2 +              +     2     +    1

   = n.-1 * n
>>

**)

(** *** Exercise 5 :
    - Prove this statement without induction.
    - Relevant lemma is big_nat_rev
*)

Lemma sum_gauss_rev n : \sum_(0 <= i < n) (n.-1 - i)  = \sum_(0 <= i < n) i.
Proof.
(*D*)rewrite [RHS]big_nat_rev /=.
(*D*)by case: n => //.
Qed.

(** *** Exercise 6 :
    - Prove this statement without induction.
    - Relevant lemma is addnn
*)
Lemma sum_gauss_double n : (\sum_(0 <= i < n) i).*2  =
       \sum_(0 <= i < n) i + \sum_(0 <= i < n) (n.-1 - i).
Proof.
(*D*)by rewrite sum_gauss_rev addnn.
Qed.

(** *** Exercise 7 :
    - Prove this statement without induction.
    - Relevant lemma are big_split and eq_big_nat
*)

Lemma sum_gaussD n :
  \sum_(0 <= i < n) i + \sum_(0 <= i < n) (n.-1 - i) =
           \sum_(0 <= i < n) n.-1.
Proof.
(*D*)rewrite -big_split /=.
(*D*)apply: eq_big_nat => i Hi.
(*D*)rewrite addnC subnK //.
(*D*)by case: n Hi.
Qed.

(** *** Exercise 8 :
    - Prove this statement without induction.
    - Relevant lemma are sum_nat_const_nat
*)

Lemma sum_gauss_const n k : \sum_(0 <= i < n) k = n * k.
Proof.
(*D*)by rewrite sum_nat_const_nat subn0.
Qed.

(** *** Exercise 9 :
    - Prove this statement using exercises 5-8
*)
Lemma sum_gauss_alt1 n : (\sum_(0 <= i < n) i).*2 = n * n.-1.
Proof.
(*D*)by rewrite sum_gauss_double sum_gaussD sum_gauss_const.
Qed.

(** *** Exercise 10 :
    - Prove this statement directly without using the lemmas
    - defined in exercises 5-9
*)

Lemma sum_gauss_alt2 n : (\sum_(0 <= i < n) i).*2 = n * n.-1.
Proof.
(*D*)rewrite -addnn [X in X + _ = _]big_nat_rev -big_split /=.
(*D*)rewrite -[X in _ = X * _]subn0 -sum_nat_const_nat.
(*D*)apply: eq_big_nat => i.
(*D*)by case: n => // n /andP[iP iLn]; rewrite [_ + _]subnK.
Qed.

(** ***  Now we try to prove the sum of squares.

**)

(** ***  We first define the property for a function to be increasing
**)

Definition fincr f := forall n, f n <= f n.+1.

(** *** Exercise 11 :
    - Prove this statement by induction
*)

Lemma fincrD f m n : fincr f -> f m <= f (n + m).
Proof.
(*D*)move=> Hf; elim: n => // n H; exact: leq_trans H (Hf _).
Qed.

(** *** Exercise 12 :
    - Prove this statement using exercise 11
    - Hint : subnK
*)

Lemma fincr_leq f m n : fincr f -> m <= n -> f m <= f n.
Proof.
(*D*)by move=> Hf Hn; rewrite -(subnK Hn) fincrD.
Qed.

(** *** Exercise 13 :
        - Proof by induction
        - Hints : addnCA subnK fincr_leq big_geq
*)

Lemma sum_consecutive n f :
  fincr f -> f n = \sum_(0 <= i < n) (f i.+1 - f i) + f 0.
Proof.
(*D*)move=> Hf.
(*D*)elim: n => [|n IH]; first by  rewrite big_geq.
(*D*)by rewrite big_nat_recr //= addnAC -IH addnC subnK.
Qed.

(** *** Exercise 14 :
        - Proof using the previous lemma
        - Hints : leq_exp2r
*)
Lemma sum_consecutive_cube n :
  n^3 = \sum_(0 <= i < n) (i.+1 ^ 3 - i ^ 3).
Proof.
(*D*)rewrite (sum_consecutive _ (fun i => i ^ 3)) ?addn0 //.
(*D*)by move=> m; rewrite leq_exp2r.
Qed.

(** *** We give the proof of a technical result
*)

Ltac sring :=
  rewrite !(expn1, expnS, =^~mul2n, mulSn, mulnS, addnS, addSn,
          mulnDr, mulnDl, add0n, addn0, muln0, addnA, mulnA);
  do ! congr (S _);
  do ! ((congr (_ + _); [idtac]) ||  (rewrite [in LHS]addnC ?[in LHS]addnA //)).

Lemma succ_cube n : n.+1 ^ 3 = n ^ 3  + (3 * n ^ 2 + 3 * n + 1).
Proof. sring. Qed.

(** *** Exercise 15 :
        - Hints : big_split sum_mull sum_gauss sum_gauss_const
*)
Lemma sum_sum3 n :
  \sum_(0 <= i < n) (6 * i ^ 2 + 6 * i + 2) =
   6 * (\sum_(0 <= i < n)  i ^ 2) + 3 * n * n.-1 + n.*2.
Proof.
(*D*)rewrite big_split big_split /=.
(*D*)rewrite -!sum_mull sum_gauss_const.
(*D*)by rewrite -mulnA -sum_gauss // -mul2n mulnA muln2.
Qed.

(** *** Exercise 16 :
        - Hints : big_split sum_mull sum_gauss sum_gauss_const
*)
Lemma sum_sum4 n :
 (n ^ 3).*2 = 6 * (\sum_(0 <= i < n)  i ^ 2) + 3 * n * n.-1 + n.*2.
Proof.
(*D*)rewrite sum_consecutive_cube -sum_sum3 -mul2n sum_mull.
(*D*)apply: eq_big_nat => i Hi.
(*D*)by rewrite succ_cube addKn 2!mulnDr !mulnA.
Qed.

(** *** Another technical lemma
*)

Lemma sum_tech n : (n ^ 3).*2 = n * n.-1 * n.-1.*2.+1 + 3 * n * n.-1 + n.*2.
Proof. by case: n => //= n1; sring. Qed.

(** *** Exercise 17 :
      - Hint : addIn sum_sum4 sum_tech.
*)
Lemma sum_square n : 6 * (\sum_(0 <= i < n)  i ^ 2) =  n * n.-1 * n.-1.*2.+1.
Proof.
(*D*)apply: (@addIn (3 * n * n.-1 + n.*2)).
(*D*)by rewrite addnA -sum_sum4 sum_tech !addnA.
Qed.

(** *** Exercise 18 :
     - Prove the theorem directly using only sum_gauss and the tactic sring.
*)
Lemma sum_square_alt n : 6 * (\sum_(0 <= i < n)  i ^ 2) =  n * n.-1 * n.-1.*2.+1.
Proof.
(*D*)apply: (@addIn (3 * n * n.-1 + n.*2)).
(*D*)rewrite addnA -[6]/(2 * 3) -!mulnA mul2n (big_morph _ (mulnDr _) (muln0 _)).
(*D*)rewrite -{1}sum_gauss -doubleMr (big_morph _ (mulnDr _) (muln0 _)).
(*D*)rewrite -{3}[n]muln1 -{3}[n]subn0 -sum_nat_const_nat.
(*D*)rewrite -!doubleD -!big_split /=.
(*D*)rewrite (eq_big_nat _ _ (_ : forall i, _ -> _ = i.+1 ^ 3 - i ^3)) => [|i H]; last first.
(*D*)  rewrite -[LHS](addKn (i ^ 3)); congr (_ - _).
(*D*)  by sring.
(*D*)apply: etrans (_ : (n^3).*2 = _).
(*D*)  congr (_.*2).
(*D*)  elim: n => [|n IH]; first by rewrite big_geq.
(*D*)  by rewrite big_nat_recr //= IH addnC subnK // leq_exp2r.
(*D*)by case: n => //= n1; sring.
Qed.


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

Add LoadPath "/Users/Harry/Documents/Fall 2016/CSC 495/Software Foundations - Code".
Require Export Induction.
Module NatList.

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

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

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

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

Check (pair 3 5).

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

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

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

Compute (fst (pair 3 5)).
(* ===> 3 *)

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

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

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

Compute (fst (3,5)).

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

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

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

(** Let's try to prove a few simple facts about pairs.

    If we state things in a particular (and slightly peculiar) way, we
    can complete proofs with just reflexivity (and its built-in
    simplification): *)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

(** It is not necessary to understand the details of these
    declarations, but in case you are interested, here is roughly
    what's going on.  The [right associativity] annotation tells Coq
    how to parenthesize expressions involving several uses of [::] so
    that, for example, the next three declarations mean exactly the
    same thing: *)

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

(** The [at level 60] part tells Coq how to parenthesize
    expressions that involve both [::] and some other infix operator.
    For example, since we defined [+] as infix notation for the [plus]
    function at level 50,

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

   the [+] operator will bind tighter than [::], so [1 + 2 :: [3]]
   will be parsed, as we'd expect, as [(1 + 2) :: [3]] rather than [1
   + (2 :: [3])].

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

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

(* ----------------------------------------------------------------- *)
(** *** Repeat *)

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

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

(* ----------------------------------------------------------------- *)
(** *** Length *)

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

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

(* ----------------------------------------------------------------- *)
(** *** Append *)

(** The [app] function concatenates (appends) two lists. *)

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

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

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

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

(* ----------------------------------------------------------------- *)
(** *** Head (with default) and Tail *)

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

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

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

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

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

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

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

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

Fixpoint oddmembers (l:natlist) : natlist :=
  match l with
  | nil => nil
  | n :: nx => match oddb n with
               | true  => n :: oddmembers nx
               | false => oddmembers nx
               end
  end.

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

Fixpoint countoddmembers (l:natlist) : nat :=
  match l with
    | nil => 0
    | hd ::tl => match (oddb hd) with
                | true =>  S (countoddmembers tl)
                | false => countoddmembers tl
              end
  end.

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

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

Example test_countoddmembers3:
  countoddmembers nil = 0.
Proof.
  simpl.
  reflexivity.
Qed.

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

    Note: one natural and elegant way of writing [alternate] will fail
    to satisfy Coq's requirement that all [Fixpoint] definitions be
    "obviously terminating."  If you find yourself in this rut, look
    for a slightly more verbose solution that considers elements of
    both lists at the same time.  (One possible solution requires
    defining a new kind of pairs, but this is not the only way.)  *)
Fixpoint alternate (l1 l2 : natlist) : natlist :=
  match l1 with
    | [] => l2
    | hd1::tl1 => match l2 with
                  | [] => l1
                  | hd2 :: tl2 => hd1 :: hd2 :: (alternate tl1 tl2)
                end
  end.
Example test_alternate1:
  alternate [1;2;3] [4;5;6] = [1;4;2;5;3;6].
Proof.
  simpl.
  reflexivity.
Qed.

Example test_alternate2:
  alternate [1] [4;5;6] = [1;4;5;6].
Proof.
  simpl.
  reflexivity.
Qed.

Example test_alternate3:
  alternate [1;2;3] [4] = [1;4;2;3].
Proof.
  simpl.
  reflexivity.
Qed.

Example test_alternate4:
  alternate [] [20;30] = [20;30].
Proof.
  simpl.
  reflexivity.
Qed.
(** [] *)

(* ----------------------------------------------------------------- *)
(** *** Bags via Lists *)

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

Definition bag := natlist.

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

Fixpoint count (v:nat) (s:bag) : nat :=
  match s with
  | [] => 0
  | s :: sIn =>
              match (beq_nat s v) with
              |true => count v sIn + 1
              |false => count v sIn
              end
  end.

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

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

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

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

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

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

Definition add (v:nat) (s:bag) : bag :=
app s [v].

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

Definition member (v:nat) (s:bag) : bool :=
 match count v s with
  | 0 => false
  | s => true
  end.

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

Example test_member2:             member 2 [1;4;1] = false.
Proof.
  reflexivity.
Qed.
(** [] *)

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

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

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

Fixpoint remove_one (v:nat) (s:bag) : bag :=
  (* When remove_one is applied to a bag without the number to remove,
     it should return the same bag unchanged. *)
  match s with
    | nil => nil
    | h :: t => match beq_nat h v with
              |true => remove_all v t
              |false => h :: remove_all v t
             end
    end.

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

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

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

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

Fixpoint subset (s1:bag) (s2:bag) : bool :=
  match s1 with
  |nil => true
  |h :: t => match beq_nat 0 (count h s2) with
              |true => false
              |false => subset t (remove_one h s1)
              end
  end.

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

(** **** Exercise: 3 stars, recommended (bag_theorem)  *)
(** Write down an interesting theorem [bag_theorem] about bags
    involving the functions [count] and [add], and prove it.  For
    this, replace the [admit] command below with the statement of your
    theorem. Note that, since this problem is somewhat open-ended,
    it's possible that you may come up with a theorem which is true,
    but whose proof requires techniques you haven't learned yet.  Feel
    free to ask for help if you get stuck! *)

Theorem bag_theorem :
  (* FILL IN HERE *) admit.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

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

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

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

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

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

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

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

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

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

(* ================================================================= *)
(** ** Induction on Lists *)

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

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

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

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

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

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

(** Notice that, as when doing induction on natural numbers, the
    [as...] clause provided to the [induction] tactic gives a name to
    the induction hypothesis corresponding to the smaller list [l1']
    in the [cons] case. Once again, this Coq proof is not especially
    illuminating as a static written document -- it is easy to see
    what's going on if you are reading the proof in an interactive Coq
    session and you can see the current goal and context at each
    point, but this state is not visible in the written-down parts of
    the Coq proof.  So a natural-language proof -- one written for
    human readers -- will need to include more explicit signposts; in
    particular, it will help the reader stay oriented if we remind
    them exactly what the induction hypothesis is in the second
    case. *)

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

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

   _Proof_: By induction on [l1].

   - First, suppose [l1 = []].  We must show

       ([] ++ l2) ++ l3 = [] ++ (l2 ++ l3),

     which follows directly from the definition of [++].

   - Next, suppose [l1 = n::l1'], with

       (l1' ++ l2) ++ l3 = l1' ++ (l2 ++ l3)

     (the induction hypothesis). We must show

       ((n :: l1') ++ l2) ++ l3 = (n :: l1') ++ (l2 ++ l3).

     By the definition of [++], this follows from

       n :: ((l1' ++ l2) ++ l3) = n :: (l1' ++ (l2 ++ l3)),

     which is immediate from the induction hypothesis.  [] *)

(* ----------------------------------------------------------------- *)
(** *** Reversing a list *)

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

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

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

(* ----------------------------------------------------------------- *)
(** *** Proofs about reverse *)

(** Now let's prove some theorems about our newly defined [rev].
    For something a bit more challenging than what we've seen, let's
    prove that reversing a list does not change its length.  Our first
    attempt gets stuck in the successor case... *)

Theorem rev_length_firsttry : forall l : natlist,
  length (rev l) = length l.
Proof.
  intros l. induction l as [| n l' IHl'].
  - (* l = [] *)
    reflexivity.
  - (* l = n :: l' *)
    (* This is the tricky case.  Let's begin as usual
       by simplifying. *)
    simpl.
    (* Now we seem to be stuck: the goal is an equality
       involving [++], but we don't have any useful equations
       in either the immediate context or in the global
       environment!  We can make a little progress by using
       the IH to rewrite the goal... *)
    rewrite <- IHl'.
    (* ... but now we can't go any further. *)
Abort.

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

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

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

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

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

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

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

    _Proof_: By induction on [l1].

    - First, suppose [l1 = []].  We must show

        length ([] ++ l2) = length [] + length l2,

      which follows directly from the definitions of
      [length] and [++].

    - Next, suppose [l1 = n::l1'], with

        length (l1' ++ l2) = length l1' + length l2.

      We must show

        length ((n::l1') ++ l2) = length (n::l1') + length l2).

      This follows directly from the definitions of [length] and [++]
      together with the induction hypothesis. [] *)

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

    _Proof_: By induction on [l].

      - First, suppose [l = []].  We must show

          length (rev []) = length [],

        which follows directly from the definitions of [length]
        and [rev].

      - Next, suppose [l = n::l'], with

          length (rev l') = length l'.

        We must show

          length (rev (n :: l')) = length (n :: l').

        By the definition of [rev], this follows from

          length ((rev l') ++ [n]) = S (length l')

        which, by the previous lemma, is the same as

          length (rev l') + length [n] = S (length l').

        This follows directly from the induction hypothesis and the
        definition of [length]. [] *)

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

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

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

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

(* ================================================================= *)
(** ** [SearchAbout] *)

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

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

 SearchAbout rev.

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

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

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

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

Theorem app_nil_r : forall l : natlist,
  l ++ [] = l.
Proof.
  intro l.
  induction l.
    - simpl. reflexivity.
    - simpl. rewrite -> IHl. simpl. reflexivity.
Qed.

 SearchAbout rev.
Theorem rev_involutive : forall l : natlist,
  rev (rev l) = l.
Proof.
Admitted.
(** There is a short solution to the next one.  If you find yourself
    getting tangled up, step back and try to look for a simpler
    way. *)

Theorem app_assoc4 : forall l1 l2 l3 l4 : natlist,
  l1 ++ (l2 ++ (l3 ++ l4)) = ((l1 ++ l2) ++ l3) ++ l4.
Proof.

Admitted.

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

Lemma nonzeros_app : forall l1 l2 : natlist,
  nonzeros (l1 ++ l2) = (nonzeros l1) ++ (nonzeros l2).
Proof.
  intros l1 l2.
  induction l1 as [| n l1'].
    - reflexivity.
    - destruct n as [| n']. simpl. rewrite -> IHl1'. reflexivity. simpl. rewrite -> IHl1'. reflexivity.
Qed.

(** [] *)

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

Fixpoint beq_natlist (l1 l2 : natlist) : bool :=
match l1 with
| nil => match l2 with
| nil => true
| x => false
end
| v1 :: r1 => match l2 with
| nil => false
| v2 :: r2 => if beq_nat v1 v2 then beq_natlist r1 r2
else false
end
end.

Example test_beq_natlist1 :
  (beq_natlist nil nil = true).
Proof.
  reflexivity.
Qed.

Example test_beq_natlist2 :
  beq_natlist [1;2;3] [1;2;3] = true.
Proof.
  reflexivity.
Qed.

Example test_beq_natlist3 :
  beq_natlist [1;2;3] [1;2;4] = false.
Proof.
  reflexivity.
Qed.

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

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

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

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

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

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

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

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

(** [] *)

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

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

(There is a hard way and an easy way to do this.) *)

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

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

(** Suppose we want to write a function that returns the [n]th
    element of some list.  If we give it type [nat -> natlist -> nat],
    then we'll have to choose some number to return when the list is
    too short... *)

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

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

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

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

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

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

(** (In the HTML version, the boilerplate proofs of these
    examples are elided.  Click on a box if you want to see one.)

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

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

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

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

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

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

Definition hd_error (l : natlist) : natoption :=
  match l with
    | [] => None
    | h :: t => Some h
  end.

Example test_hd_error1 : hd_error [] = None.
Proof.
reflexivity.
Qed.

Example test_hd_error2 : hd_error [1] = Some 1.
Proof.
reflexivity.
Qed.

Example test_hd_error3 : hd_error [5;6] = Some 5.
Proof.
reflexivity.
Qed.

(** [] *)

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

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

End NatList.

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

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

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

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

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

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

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

(** **** Exercise: 1 star (beq_id_refl) *)
SearchAbout beq_nat.

Theorem beq_id_refl : forall x, true = beq_id x x.
Proof.
  intros x.
  induction x.
  - simpl. rewrite <- beq_nat_refl. reflexivity.
Qed.

(** [] *)

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

Module PartialMap.
Import NatList.

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

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

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

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

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

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

(** **** Exercise: 1 star (update_eq) *)
(*SearchAbout beq_id *)
SearchAbout beq_nat.

Theorem update_eq :
  forall (d : partial_map) (k : id) (v: nat),
    find k (update d k v) = Some v.
Proof.
  intros.
  - simpl. rewrite <- beq_id_refl. reflexivity.
Qed.

(** **** Exercise: 1 star (update_neq)  *)
Theorem update_neq :
  forall (d : partial_map) (m n : id) (o: nat),
    beq_id m n = false -> find m (update d n o) = find m d.
Proof.
  intros.
  - simpl. rewrite -> H. reflexivity.
Qed.
(** [] *)

End PartialMap.

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

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

(** How _many_ elements does the type [baz] have?  (Answer in English
    or the natural language of your choice.)

Answer: 0
*)
(** [] *)

(** $Date: 2016-06-01 15:34:59 -0400 (Wed, 01 Jun 2016) $ *)


Require Export Basics.

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.
  (* WORKED IN CLASS *)
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *)
    simpl. reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity. Qed.

Theorem mult_0_r : forall n:nat,
  n * 0 = 0.
Proof.
  intros n. induction n as [|n' IHn'].
  reflexivity.
  simpl. rewrite -> IHn'. reflexivity. Qed.

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

Theorem plus_comm : forall n m : nat,
  n + m = m + n.
Proof.
  intros n m. induction n as [| n' IHn'].
  simpl. rewrite <- plus_n_O. reflexivity.
  simpl. rewrite -> IHn'. rewrite -> plus_n_Sm. 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'].
  simpl. reflexivity.
  simpl. rewrite -> IHn'. reflexivity.
Qed.

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

Lemma double_plus : forall n, double n = n + n .
Proof.
   intros n. induction n as [|n' IHn'].
   reflexivity.
   simpl.
   rewrite -> IHn'.
   rewrite <- plus_n_Sm.
   reflexivity.
Qed.

(* Proofs Within Proofs *)

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

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

Theorem plus_swap : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  intros n m p.
  assert (H1: n + (m + p) = (n + m) + p). { rewrite <- plus_assoc. reflexivity. }
  rewrite -> H1.
  assert (H2: m + (n + p) = (m + n) + p). { rewrite <- plus_assoc. reflexivity. }
  rewrite -> H2.
  assert (H3: m + n = n + m). { rewrite <- plus_comm. reflexivity. }
  rewrite <- H3. reflexivity.
Qed.

Lemma mult_n_zero : forall n : nat,
  n * 0 = 0 * n.
Proof.
  intros n. induction n as [|n' IHn'].
  reflexivity.
  simpl. rewrite -> IHn'. simpl. reflexivity.

Qed.

Lemma mult_m_plus_Sn_eq_mn: forall m n : nat,
  m * S n = m + m * n.
Proof.
  intros n m. induction n as [|n' IHn'].
  simpl. reflexivity.
  simpl. rewrite -> IHn'. rewrite <- plus_swap. reflexivity.
Qed.

Theorem mult_comm : forall m n : nat,
  m * n = n * m.
Proof.
  intros m n. induction n as [|n' IHn'].
  rewrite -> mult_n_zero. reflexivity.
  simpl. rewrite <- IHn'. rewrite <- mult_m_plus_Sn_eq_mn. reflexivity.
Qed.

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

Theorem beq_nat_refl : forall n : nat,
  true = beq_nat n n.
Proof.
  intros n. induction n as [|n' IHn'].
  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.
  assert (H1: n + (m + p) = (n + m) + p). { rewrite <- plus_assoc. reflexivity. }
  rewrite -> H1.
  assert (H2: m + (n + p) = (m + n) + p). { rewrite <- plus_assoc. reflexivity. }
  rewrite -> H2.
  replace (m + n) with (n + m). reflexivity.
  rewrite <- plus_comm. reflexivity.
Qed.


Require Import PeanoNat.

(* Algorithm from
 *  <https://en.wikipedia.org/wiki/Modular_exponentiation#Memory-efficient_method>
 *)
Fixpoint modexp' m b e c :=
  match e with
  | 0    => c mod m
  | S e' => modexp' m b e' ((b * c) mod m)
  end.
Definition modexp m b e := modexp' m b e 1.

Lemma modexp'_correct : forall m b e c, m <> 0 -> b <> 0 ->
  modexp' m b e c = (b ^ e * c) mod m.
Proof.
  intros m b e.
  induction e; intros.
  - cbn.
    now rewrite Nat.add_0_r.
  - cbn.
    rewrite IHe; auto.
    rewrite Nat.mul_mod_idemp_r; auto.
    now rewrite Nat.mul_assoc, (Nat.mul_comm _ b).
Qed.

Lemma modexp_correct : forall m b e, m <> 0 -> b <> 0 ->
  modexp m b e = (b ^ e) mod m.
Proof.
  intros.
  unfold modexp.
  rewrite modexp'_correct; auto.
  now rewrite Nat.mul_1_r.
Qed.


Module NatNameSpace.

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

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

Inductive bin_nat : Type :=
  | b : bin_nat
  | b0 : bin_nat -> bin_nat
  | b1 : bin_nat -> bin_nat.

End NatNameSpace.

Check (S (S (S O))).
(* ===> 3 : nat *)

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

Compute (minustwo 4).
Check S.
Check pred.
Check minustwo.

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

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

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

Definition oddb (n : nat) : bool := negb (evenb n).

Example test_oddb1 : oddb 1 = true.
Proof. simpl. reflexivity. Qed.
Example test_oddb2 : oddb 4 = false.
Proof. simpl. reflexivity. Qed.

Module NatNameSpace2.

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

Fixpoint mult (n m : nat) : nat :=
    match n with
    | O => O
    | S n' => plus m (mult n' m)
    end.
Example test_mult1 : (mult 3 3) = 9.
Proof. simpl. reflexivity. Qed.

Fixpoint minus (n m : nat) : nat :=
    match n, m with
    | O , _ => O
    | S _ , O => n
    | S n' , S m' => minus n' m'
    end.
Example test_minus1: (minus 2 1) = 1.
Proof. simpl. reflexivity. Qed.
End NatNameSpace2.

Fixpoint exp (base power: nat) : nat :=
    match power with
    | O => S O
    | S p => mult base (exp base p)
    end.
Example test_exp1: (exp 9 0) = 1.
Proof. simpl. reflexivity. Qed.
Example test_exp2: (exp 9 3) = 729.
Proof. simpl. reflexivity. Qed.

Fixpoint fibo (n: nat) : nat :=
    match n with
    | O => 1
    | S O => 1
    | S n' => (fibo (minus n' 1)) + (fibo n')
    end.
Example test_fibo1: (fibo 0) = 1.
Proof. simpl. reflexivity. Qed.
Example test_fibo2: (fibo 1) = 1.
Proof. simpl. reflexivity. Qed.
Example test_fibo3: (fibo 2) = 2.
Proof. simpl. reflexivity. Qed.

Fixpoint fact (n: nat) : nat :=
    match n with
    | O => 1
    | S n' => mult (S n') (fact n')
    end.
Example test_fact1: (fact 0) = 1.
Proof. simpl. reflexivity. Qed.
Example test_fact2: (fact 1) = 1.
Proof. simpl. reflexivity. Qed.
Example test_fact3: (fact 5) = 120.
Proof. simpl. reflexivity. Qed.

Fixpoint nat_iseq (n m: nat) : bool :=
    match n with
    | O => match m with
           | O => true
           | S m' => false
           end
    | S n' => match m with
              | O => false
              | S m' => nat_iseq n' m'
              end
    end.
Example test_nat_iseq1: (nat_iseq 1 1) = true.
Proof. simpl. reflexivity. Qed.
Example test_nat_iseq2: (nat_iseq 4 0) = false.
Proof. simpl. reflexivity. Qed.
Example test_nat_iseq3: (nat_iseq 4 5) = false.
Proof. simpl. reflexivity. Qed.

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

Fixpoint nat_lt (n m: nat) : bool :=
    match n with
    | O => match m with
           | O => false
           | S m' => true
           end
    | S n' => match m with
              | O => false
              | S m' => nat_lt n' m'
              end
    end.
Example test_nat_lt1: (nat_lt 0 1) = true.
Proof. simpl. reflexivity. Qed.
Example test_nat_lt2: (nat_lt 2 3) = true.
Proof. simpl. reflexivity. Qed.
Example test_nat_lt3: (nat_lt 1 1) = false.
Proof. simpl. reflexivity. Qed.
Example test_nat_lt4: (nat_lt 1 0) = false.
Proof. simpl. reflexivity. Qed.

Definition nat_lt2 (n m: nat) : bool := negb (nat_leq m n).
Example test_nat_lt21: (nat_lt 0 1) = true.
Proof. simpl. reflexivity. Qed.
Example test_nat_lt22: (nat_lt 2 3) = true.
Proof. simpl. reflexivity. Qed.
Example test_nat_lt23: (nat_lt 1 1) = false.
Proof. simpl. reflexivity. Qed.
Example test_nat_lt24: (nat_lt 1 0) = false.
Proof. simpl. reflexivity. Qed.


Require Export BasicsThales.

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'].
  - (* n = 0 *)
    reflexivity. (* so far so good... *)
  - (* n = S n' *)
    simpl. (* ...but here we are stuck again *)
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.
  (* WORKED IN CLASS *)
  intros n. induction n as [| n' IHn'].
  - (* n = 0 *)
    simpl. reflexivity.
  - (* n = S n' *)
    simpl. rewrite -> IHn'. reflexivity. Qed.

(*Exercise: 2 stars, recommended (basic_induction)
Prove the following using induction. You might need previously proven results.*)

(*
Theorem mult_0_r : forall n:nat,
  n * 0 = 0.
Proof.
  intros n.
  destruct n.
  -
    simpl.
    reflexivity.
  -
    simpl.
    induction n as [|n' IHn].
    +
      simpl.
      reflexivity.
    +
      simpl.
      assumption.
Qed.*)

Theorem mult_0_r : forall n:nat,
    n * 0 = 0.
Proof.
  intros n.
  induction n as [|n' IHn].
  -
    simpl.
    reflexivity.
  -
    simpl.
    rewrite -> IHn.
    reflexivity.
Qed.

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

(*Auxiliar Theorem*)
Theorem plus_n_0 : forall n: nat, n + 0 = n.
Proof.
  intros n.
  simpl.
  induction n as [|n' IHn].
  -
    simpl.
    reflexivity.
  -
    simpl.
    rewrite -> IHn.
    reflexivity.

  Qed.

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

Theorem plus_comm : forall n m : nat,
  n + m = m + n.
Proof.
  intros n m.
  induction n.
  +
    rewrite <- plus_n_O.
    simpl.
    reflexivity.
  +
    simpl.
    rewrite -> IHn.
    rewrite <- plus_n_m_n_plus_Sn.
    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].
  -
    simpl.
    reflexivity.
  -
    simpl.
    rewrite <- IHn.
    reflexivity.
Qed.

(*Exercise: 2 stars (double_plus)
Consider the following function, which doubles its argument:*)
Fixpoint double (n:nat) :=
  match n with
  | O => O
  | S n' => S (S (double n'))
  end.

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

(*Auxiliar for exercise below*)
Theorem negb_negb_b : forall b : bool, negb (negb b) = b.
Proof.
  intro b.
  destruct b.
  -
    simpl.
    reflexivity.
  -
    simpl.
    reflexivity.
Qed.

(*Exercise: 2 stars, optional (evenb_S)
One inconvenient aspect of our definition of evenb n is the recursive call on n - 2. This makes proofs about evenb n harder when done by induction on n, since we may need an induction hypothesis about n - 2. The following lemma gives an alternative characterization of evenb (S n) that works better with induction:*)
Theorem evenb_S : forall n : nat, evenb (S n) = negb (evenb n).
Proof.
  intro n.
  simpl.
  induction n.
  -
    simpl.
    reflexivity.
  -
    simpl.
    rewrite -> IHn.
    rewrite -> negb_negb_b.
    reflexivity.

Qed.

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

Theorem plus_rearrange_firsttry : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  (* We just need to swap (n + m) for (m + n)... seems
     like plus_comm should do the trick! *)
  rewrite -> plus_comm.
  (* Doesn't work...Coq rewrote the wrong plus! *)
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.

(*Exercise: 2 stars, optional (beq_nat_refl_informal)
Write an informal proof of the following theorem, using the informal proof of plus_assoc as a model. Don't just paraphrase the Coq tactics into English!*)
Theorem beq_nat_refl_informal: forall n : nat, beq_nat n n = true.
Proof.

  intro n.
  induction n as [|n' IHn].
  -
    simpl.
    reflexivity.
  -
    simpl.
    (*assumption.*)
    (*apply IHn.*)
    rewrite <- IHn.
    reflexivity.
Qed.

(*My simpler beq_nat*)
Fixpoint beq_nat_easy (n m : nat) : bool :=
  match n, m with
  | 0, 0 => true
  | S n, S m => beq_nat_easy n m
  | _, _ => false
  end.

(*My new - and personal - version of the theorem*)
Theorem beq_nat_refl_informal_easy: forall n : nat, beq_nat_easy n n = true.
Proof.

  intro n.
  induction n as [|n' IHn].
  -
    simpl.
    reflexivity.
  -
    simpl.
    (*assumption.*)
    (*apply IHn.*)
    rewrite <- IHn.
    reflexivity.
Qed.


Add LoadPath "../Basics".
Require Import EnumTypes.
Require Import CaseAnalysis.
Require Import NamingCases.
Require Import Induction.
Require Import ProofsInProofs.

(** EXERCISE [***]: Prove the following theorems. First determine
    whether they can be proven w/ simple rewriting and simplification.
    If not, determine whether it needs case analysis via [destruct], or
    full-on [induction] *)

(** INDUCTION *)
Theorem ble_nat_refl : forall n : nat,
   true = ble_nat n n.

Proof.
   intro n. induction n as [| n'].
   Case "n = 0".
      simpl. reflexivity.
   Case "n = S n'".
      simpl. rewrite -> IHn'. reflexivity. Qed.

(** REWRITE ONLY *)
Theorem zero_nbeq_S : forall n : nat,
   beq_nat 0 (S n) = false.

Proof.
   intro n. simpl. reflexivity. Qed.

(** CASE ANALYSIS *)
Theorem andb_false_r : forall b : bool,
   andb b false = false.

Proof.
   intro b. destruct b.
   Case "b = true".
      simpl. reflexivity.
   Case "b = false".
      simpl. reflexivity. Qed.

(** INDUCTION *)
Theorem plus_ble_compat_1 : forall n m p : nat,
   ble_nat n m = true ->
   ble_nat (p + n) (p + m) = true.

Proof.
   intros n m p. intro H.
   induction p as [| p'].
   Case "p = 0".
      simpl. rewrite -> H. reflexivity.
   Case "p = S p'".
      simpl. rewrite -> IHp'. reflexivity. Qed.

(** REWRITE ONLY *)
Theorem S_nbeq_0 : forall n : nat,
   beq_nat (S n) 0 = false.

Proof.
   intro n. simpl. reflexivity. Qed.

(** REWRITE ONLY *)
Theorem mult_1_1 : forall n : nat,
   1 * n = n.

Proof.
   intro n. simpl. rewrite <- plus_n_O. reflexivity. Qed.

(** CASE ANALYSIS *)
Theorem all3_spec : forall b c : bool,
   orb (andb b c) (orb (negb b) (negb c)) = true.

Proof.
   intros b c. destruct b.
   Case "b = true".
      destruct c.
      SCase "c = true".
         simpl. reflexivity.
      SCase "c = false".
         simpl. reflexivity.
   Case "b = false".
      destruct c.
      SCase "c = true".
         simpl. reflexivity.
      SCase "c = false".
         simpl. reflexivity. Qed.

(** TODO *)
Theorem mult_plus_distr_r : forall n m p : nat,
   (n + m) * p = (n * p) + (m * p).

Proof.
   Admitted.

(** INDUCTION *)
Theorem mult_assoc : forall n m p: nat,
   n * (m * p) = (n * m) * p.

Proof.
   intros n m p. induction n as [| n'].
   Case "n = 0".
      reflexivity.
   Case "n = S n'".
      simpl. rewrite -> IHn'. rewrite -> mult_plus_distr_r.
      reflexivity. Qed.

(** EXERCISE [**]: Prove the following theorem *)
Theorem beq_nat_refl : forall n : nat,
   true = beq_nat n n.

Proof.
   intro n. induction n as [| n'].
   Case "n = 0".
      reflexivity.
   Case "n = S n'".
      simpl. rewrite -> IHn'. reflexivity. Qed.

(** EXERCISE [**]: The [replace] tactice lets you specify a particular
    subterm to rewrite and what you want it rewritten to. That is,
    [replace (t) with (u)] replaces all copeis of expression [t] in
    the goal statement by expression [u], and generates [t = u] as an
    additional subgoal. Use this tactic to prove [plus_swap] without
    [assert] *)
Theorem plus_swap' : forall n m p : nat,
   n + (m + p) = m + (n + p).

Proof.
   intros n m p.
   replace (n + (m + p)) with ((m + p) + n).
   replace (n+p) with (p + n).
   rewrite -> plus_assoc.
   reflexivity.
   Case "Proof of second replacement".
      rewrite -> plus_comm. reflexivity.
   Case "Proof of first replacement".
      rewrite <- plus_comm. reflexivity. Qed.

(** EXERCISE [***]: Prove that [increment] and [binary-to-unary]
    commute. *)


(*
# Inductive propositions

```coq
*)

Require Bool List.

Module IndProp.

(*
```

We will use the following tactics:

  - `induction`
  - `apply`
  - `congruence`  (subsumes  `exact`, `assumption`, `reflexivity`)
  - `simpl`, `simpl <definition>`: Unfolding of definitions. Also `unfold`.
  - `trivial`: Like `auto`, but with a very limited search depth.
  - `repeat`: Milk a tactic dry. Good with `try`.
  - `tauto`: Solves propositional logic problems.
  - `replace`: Replaces a term by another, generates subgoal to show that they are equal.
  - `rewrite`: Replaces a term by another using a hypothesis.

We will introduce

  - `unfold` (and `fold`)

  - `discriminate`
  - `generalize`
  - `remember`
  - `inversion` (subsumes `destruct` (as) )

## Defining inductive properties

How to define the even natural numbers in Coq?

1. Mathematical characterisation.

   `unfold` and `discriminate`.

```coq
*)

Definition even_p (n : nat) : Prop := exists k, n = k + k.

Example even_8 : even_p 8.
unfold even_p.
exists 4.
simpl.
reflexivity.
Qed.

Example not_even_1 : ~(even_p 1).
unfold even_p.
intro.
destruct H as [ k Pk ].
destruct k.
simpl in Pk.
discriminate Pk.
simpl in Pk.
(* plus_n_Sm: forall n m : nat, S (n + m) = n + S m *)
rewrite <- plus_n_Sm in Pk.
discriminate Pk.
Qed.

(*
```

2. Decision algorithm.

```coq
*)

Fixpoint is_even (n : nat) : bool :=
  match n with
  | 0         => true
  | 1         => false
  | (S (S n)) => is_even n
  end.

Example is_even_5 : is_even 6 = true.
simpl. reflexivity.
Qed.

Example not_is_even_1 : is_even 1 = false.
simpl. reflexivity.
Qed.

(*
```

These are equivalent: proof in the appendix.

- Disadvantages

  - Mathematical characterizations are opaque
    (what does a proof of n = k + k look like?)
    They cannot be inspected, one can only gaze at them.

  - Decision procedures are only good for decidable properties.

Enter inductive predicates.

## Inductive predicates

Let’s take `even` as an example.

```coq
*)
Inductive even : nat -> Prop :=
  | even_0  : even 0
  | even_SS : forall n : nat, even n -> even (S (S (n))).

Example even_6 : even 6.
exact (even_SS 4 (even_SS 2 (even_SS 0 even_0))).
Qed.

Example even_4 : even 4.
apply even_SS.
apply even_SS.
apply even_0.
Qed.

Example even_200 : even 200.
repeat constructor.
Qed.

Example not_even_5 : ~(even 5).
intro H5.
inversion H5.
inversion H0.
inversion H2.
Qed.

(*
```

### Generalize

The importance of being general: `generalize`.

```coq
*)
Proposition even_correct : forall n, even n <-> even_p n.
  split.
  (* -> *)
    unfold even_p.
    intro H.
    induction H.
    (* H = even_0 *)
    exists 0. trivial.
    (* H = even_SS n' Hn' *)
    destruct IHeven as [ k Pk ].
    exists (S k).
    simpl "+". rewrite <- plus_n_Sm.
    congruence.

  (* <- *)
  unfold even_p.
  intros.
  destruct H as [ k Pk ].
  (* per AndreasLoow, you can do 'generalize dependent n' instead *)
  generalize n Pk.
  clear n Pk.
  induction k.
  intros. rewrite Pk. apply even_0.
  intros.
  rewrite Pk.
  simpl "+". rewrite <- plus_n_Sm.
  apply even_SS.
  apply IHk. trivial.
Qed.
(*
```

Exercises:

```coq
*)
Fixpoint nat_eq (m n : nat) : bool :=
  match m, n with
    | 0, 0 => true
    | S m, S n => nat_eq m n
    | _, _ => false
  end.

Lemma nat_eq_correct : forall m n, nat_eq m n = true <-> m = n.
Admitted.

(*
```

## Inductive relations

```coq
*)

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

Notation "m ≤ n" :=  (le m n) (at level 30).

Example le_3_5 : 3 ≤ 5.
apply le_S.
apply le_S.
apply le_n.
Qed.

Example le_big : 2 ≤ 20.
apply le_S.
apply le_S.
repeat (try (apply le_n); apply le_S).
Qed.

Example not_le_2_1 : ~(2 ≤ 1).
intro.
inversion H as [|m n H1].
inversion H1.
Qed.

Example not_le_100_10 : ~(100 ≤ 10).
intro.
repeat (rename H into H'; inversion H' as [|? ? H]; clear H').
Qed.

(*
```

### Remember to `remember`

The `induction` tactic is an amnesiac fellow.

```coq
*)
Lemma le_Sm_n_bad : forall m n, S m ≤ n -> m ≤ n.
  intros.
  remember (S m) as sm.
  induction H.
  (* H = le_n *)
  rewrite Heqsm.
  apply le_S.
  apply le_n.
  (* H = le_S *)
  apply le_S.
  apply IHle.
  trivial.
Qed.

Fixpoint le_Sm_n (m n : nat) ( H : S m ≤ n) : m ≤ n.
  inversion H.
  apply le_S.
  apply le_n.
  (* H = le_S *)
  apply le_S.
  apply le_Sm_n.
  assumption.
Qed.

Print le_Sm_n.

(*
```

When doing induction on an inductive proposition, we need to
explicitly remember the indices.

```coq
*)
(*
```

### Exercises:

(Software Foundations, IndProp).
R_provability2, R_fact:

```coq
*)

Section R.

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?
```coq
*)
Example exR1 : R 1 1 2. Admitted.
Example exR2 : R 2 2 6. Admitted.
(*
```

    * If we dropped constructor c5 from the definition of R, would the set of provable propositions change?
    * If we dropped constructor c4 from the definition of R, would the set of provable propositions change?

```coq
*)
Definition fR : nat -> nat -> nat.
Admitted.

Theorem R_equiv_fR : forall m n o, R m n o <-> fR m n = o.
Admitted.

End R.
(*
```

## Case study: regular expressions

```coq
*)

Import Bool List.
Import ListNotations.

Inductive regex (T : Type) : Type :=
  | empty   : regex T
  | ε       : regex T
  | char    : T -> regex T
  | concat  : regex T -> regex T -> regex T
  | union   : regex T -> regex T -> regex T
  | star    : regex T -> regex T.

Notation "∅" := (empty _).
Arguments ε {T}.
Notation "« x »" := (char _ x).
Notation "x · y" := (concat _ x y) (at level 35, right associativity).
Notation "x ∪ y" := (union _ x y) (at level 55, right associativity).
Notation "x **" := (star _ x) (at level 10).
(*
```

Examples of regular expressions.

```coq
*)

Example re_all_true : regex bool := (« true » **).

Example re_length_one : regex bool := (« true » ∪ « false »).

Example re_even_length : regex bool :=
  ((« true » ∪ « false ») · (« true » ∪ « false »)) **.

Example re_odd_length : regex bool.
  refine (_ · (_ · _) **); exact re_length_one.
Defined.

Eval compute in re_odd_length.
(*
```

What does it mean for a regular expression to match a string?

```coq
*)
Inductive matches {T} : regex T -> list T -> Prop :=
  | m_empty  : matches ε []
  | m_char   : forall x, matches « x »  [x]
  | m_concat : forall xs ys r₁ r₂,
              matches r₁ xs ->
              matches r₂ ys ->
              matches (r₁ · r₂) (xs ++ ys)
  | m_unionL : forall xs r₁ r₂,
              matches r₁ xs ->
              matches (r₁ ∪ r₂) xs
  | m_unionR : forall xs r₁ r₂,
              matches r₂ xs ->
              matches (r₁ ∪ r₂) xs
  (* Alternative:
  | m_union : forall xs r₁ r₂,
              matches r₁ xs \/ matches r₂ xs ->
              matches (r₁ ∪ r₂) xs
  *)
  | m_star0  : forall r₁, matches (r₁ **) []
  | m_starS  : forall xs ys r,
      matches r xs ->
      matches (r **) ys ->
      matches (r **) (xs ++ ys).

Notation "s ∈ re" := (matches re s) (at level 80).

Example match_length_one : forall b, [b] ∈ re_length_one.
intros.
unfold re_length_one.
induction b.
apply m_unionL. apply m_char.
apply m_unionR. apply m_char.
Defined.

Eval compute in match_length_one.

Example match_odd_3 : [true;true;false] ∈ re_odd_length.
unfold re_odd_length.
apply (m_concat [true] [true; false]).
apply match_length_one.
apply (m_starS [true; false] []).
apply (m_concat [true] [false]).
apply match_length_one.
apply match_length_one.
apply m_star0.
Defined.

Eval compute in match_odd_3.

(*
```

Good!

### Exercises

1. Define a decision procedure to check if a regular expression
   accepts the empty string, and show it correct.

```coq
*)

Fixpoint ε_in {T : Type} (re : regex T) : bool.
Admitted.

Lemma ε_in_good {T} (re : regex T) : ε_in re = true <-> [] ∈ re.
Admitted.
(*
```

  Ultimately, we want to decide if an expression matches a given list.
  We can only do this if we have a way of comparing elements in the alphabet
  for equality.

  To simplify, we will work with regular expresions over the boolean alphabet.
  It is easy to generalize this to any type with decidable equality.

  There is a polymorphic version of the exercise in the appendix, which you can
  do instead.

```coq
*)

Section ExerciseMonomorphic.

Definition bool_eq (x y : bool) : bool :=
  match x, y with
    | true, true => true
    | false, false => true
    | _, _ => false
  end.
Notation "x == y" := (bool_eq x y) (at level 60).

Definition reflect_bool_eq (x y : bool) :  x == y = true -> x = y.
  (intros; induction x, y; trivial; (discriminate H)).
Qed.

Definition compute_bool_eq (x : bool) :  x == x = true.
  induction x; simpl; trivial.
Qed.

(*
```

2. Given a regular expression X accepting a language L, compute the regular expression
   that accepts the [Brzozowski derivative](https://en.wikipedia.org/wiki/Brzozowski_derivative) of L,
   and prove the definition correct.

```coq
*)

Fixpoint derivative (re : regex bool) (t : bool) : regex bool
. Admitted.

Lemma derivative_good  re a x : x ∈ derivative re a <-> a :: x ∈ re.
Admitted.

(*
```

3. Prove that the matching function is correct. You can do this before solving
   part 1. or part 2.

```coq
*)
Fixpoint matches_b (re : regex bool) (x : list bool) : bool :=
  match x with
  | [] => ε_in re
  | t :: ts => matches_b (derivative re t) ts
  end.

Eval compute in matches_b (re_odd_length) [true;true;false;true;false].
Eval compute in matches_b (re_odd_length) [true;false;true;false].

Lemma matches_b_good (re : regex bool) (x : list bool) : matches_b re x = true <-> x ∈ re.
Admitted.

End ExerciseMonomorphic.
(*
```

4. (From SF)

Given:

```coq
*)
Fixpoint regex_list {T} (l : list T) :=
  match l with
  | [] => ε
  | x :: l' => « x » · (regex_list l')
  end.

(*
```

Show:

```coq
*)

Lemma reg_exp_of_list_spec {T} (x : list T) : x ∈ regex_list x.
Admitted.
(*
```

## Appendix

### Equivalence between `is_even` and `even_p`

First, define a new induction principle on the natural numbers,
and prove it correct.

```coq
*)

Fixpoint is_even_ind (P : nat -> Prop)
         (P0 : P 0)
         (P1 : P 1)
         (PSS : forall n, P n -> P (S (S n)))
         (n : nat) : P n.
  destruct n as [|[|n']]; try assumption.
  apply PSS.
  apply is_even_ind; assumption.
Qed.

Lemma is_even_correct : forall n,  is_even n = true <-> even_p n.
  split.

  (* -> *)
  induction n using is_even_ind.

  (* n = 0 *)
  intros.
  unfold even_p.
  exists 0.
  reflexivity.

  (* n = 1 *)
  intros.
  simpl in H. discriminate H.

  (* n = S (S n') *)
  simpl.
  unfold even_p in *.
  intros.
  specialize (IHn H); clear H.
  destruct IHn as [k Pk].
  exists (S k).
  simpl.
  (* obs: plus_n_Sm: forall n m : nat, S (n + m) = n + S m *)
  rewrite <- plus_n_Sm.
  congruence.

  (* <- *)
  unfold even_p.
  intros.
  destruct H as [k Pk].
  generalize n Pk; clear n Pk.
  induction k; intros n Hn; rewrite Hn; trivial.
  (* k = S k' *)
  simpl "+".
  rewrite <- plus_n_Sm.
  simpl is_even.
  apply IHk.
  reflexivity.
Qed.
(*
```

## Derivative for arbitrary types with decidable equality

Define a notion of decidable equality.

```coq
*)

Section RegexDec.

Class eqDec (T : Type) : Type :=
  mkEqDec {
    eqDec_f  : T -> T -> bool
  ; eqDec_pf : forall x y, eqDec_f x y = true <-> x = y
  }.

Notation "x == y" := (eqDec_f x y) (at level 60).

Definition reflectEq {T} {eq : eqDec T} {a b : T} : a == b = true -> a = b.
  intros.
  apply eqDec_pf.
  trivial.
Defined.

Definition computeEq {T} {eq : eqDec T} (a : T) : a == a = true.
  intros.
  apply eqDec_pf.
  trivial.
Defined.
(*
```

An instance for `nat`

```coq
*)
Fixpoint nat_eqDec_f (m n : nat) : bool :=
  match m, n with
  | 0, 0 => true
  | S n, S m => nat_eqDec_f n m
  | _, _ => false
  end.

Instance nat_eqDec : eqDec nat := { eqDec_f := nat_eqDec_f}.
Proof.
  (** x = 0 *)
  (** x = S _ *)
Admitted.

Fixpoint derivativeD {T} {eq : eqDec T} (re : regex T) (t : T) : regex T
. Admitted.

Fixpoint matchesD {T} {eq : eqDec T} (re : regex T) (x : list T) : bool
. Admitted.

Eval compute in matchesD ((«1» · «1» · «1») **) [1;1;1;1;1].

Eval compute in matchesD ((«1» · «1» · «1») **) [1;1;1;1;1;1].

End RegexDec.

End IndProp.

(*
```
*)


From mathcomp Require Import all_ssreflect.

Implicit Type p q r : bool.
Implicit Type m n a b c : nat.

(** *** Exercise 1:
    - look for lemmas supporting contrapositive reasoning
    - use the eqP view to finish the proof.
*)
Lemma bool_gimmics1 a : a != a.-1 -> a != 0.
(*D*)Proof. by apply: contra; move => /eqP E; rewrite E. Qed.

(** *** Exercise 2:
   - it helps to find out what is behind [./2] and [.*2] in order to [Search]
   - any proof would do, but there is one not using [implyP]
*)
Lemma view_gimmics1 p a b : p -> (p ==> (a == b.*2)) -> a./2 = b.
(*D*)Proof. by move=> -> /eqP->; exact: doubleK. Qed.

(** *** Exercise 3:
  - Prove this view by unfolding maxn and then using [leqP]
*)
Lemma maxn_idPl m n : reflect (maxn m n = m) (m >= n).
Proof. apply: (iffP idP).
(*D*)by rewrite /maxn; case: leqP.
(*D*)by move=> <-; rewrite /maxn; case: leqP.
Qed.

(** *** Exercise 4:
  - there is no need to prove [reflect] with [iffP]: here just use [rewrite] and [apply]
  - check out the definitions and theory of [leq] and [maxn]
  - proof sketch:
<<
   n <= m = n - m == 0
          = m + n - m == m + 0
          = maxn m n == m
>> *)
Lemma maxn_idPl_bis m n : reflect (maxn m n = m) (m >= n).
(*D*)Proof. by rewrite -subn_eq0 -(eqn_add2l m) addn0 -maxnE; apply: eqP. Qed.


Require Import Arith.

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

Fixpoint fib (n:nat) : nat :=
    match n with
    | O => 0
    | S q =>
        match q with
        | O => 1
        | S p => fib p + fib q
        end
    end.

Require Import ZArith.

Open Scope Z_scope.

Definition fact_aux (n:Z) :=
Z.iter n (fun p => (fst p + 1, snd p * (fst p + 1))) (0, 1).

Definition Z_fact (n:Z) := snd (fact_aux n).
Compute Z_fact 100.

Close Scope Z_scope.