(** * Prop: Propositions and Evidence *)

Require Export Logic.

(* ####################################################### *)
(** * Inductively Defined Propositions *)

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

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

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

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

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

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

(** The first line declares that [ev] is a proposition -- or,
    more formally, a family of propositions "indexed by" natural
    numbers.  (That is, for each number [n], the claim that "[n] is
    even" is a proposition.)  Such a family of propositions is
    often called a _property_ of numbers.

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

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

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

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

(** For [ev], we had already defined [even] as a function (returning a
   boolean), and then defined an inductive relation that agreed with
   it. However, we don't necessarily need to think about propositions
   first as boolean functions, we can start off with the inductive
   definition.
*)

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

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

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

       - Rule [b_0]: The number [0] is [beautiful].
       - Rule [b_3]: The number [3] is [beautiful].
       - Rule [b_5]: The number [5] is [beautiful].
       - Rule [b_sum]: If [n] and [m] are both [beautiful], then so is
         their sum. *)

(** We will see many definitions like this one during the rest
    of the course, and for purposes of informal discussions, it is
    helpful to have a lightweight notation that makes them easy to
    read and write.  _Inference rules_ are one such notation: *)
(**
                              -----------                               (b_0)
                              beautiful 0

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

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

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

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

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

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

(* 2 *)
(** [] *)

(* ####################################################### *)
(** ** Constructing Evidence *)

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

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

(** *** *)
(**
    The rules introduced this way have the same status as proven
    theorems; that is, they are true axiomatically.
    So we can use Coq's [apply] tactic with the rule names to prove
    that particular numbers are [beautiful].  *)

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

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

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

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

(** **** Exercise: 2 stars (b_times2)  *)
Theorem b_times2: forall n, beautiful n -> beautiful (2*n).
Proof.
  intros.
  simpl. rewrite <- plus_n_O.
  apply b_sum with (n:=n) (m:=n).
  apply H. apply H.
Qed.
(** [] *)

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

(* ####################################################### *)
(** * Using Evidence in Proofs *)
(** ** Induction over Evidence *)

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

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

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

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

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

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

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

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

...
[]
*)

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

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

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

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

(** *** *)

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

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

(* These exercises also require the use of induction on the evidence. *)

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

(** **** Exercise: 3 stars, advanced (beautiful__gorgeous)  *)
Theorem beautiful__gorgeous : forall n, beautiful n -> gorgeous n.
Proof.
  intros.
  induction H.
  apply g_0.
  apply g_plus3.
  apply g_0.
  apply g_plus5.
  apply g_0.
  apply gorgeous_sum.
  apply IHbeautiful1.
  apply IHbeautiful2.
Qed.
(** [] *)

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

Lemma helper_g_times2 : forall x y z, x + (z + y) = z + x + y.
Proof.
  intros.
  induction z. reflexivity.
  simpl. rewrite <- plus_n_Sm. apply f_equal. apply IHz.
Qed.

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

(** Here is a proof that the inductive definition of evenness implies
the computational one. *)

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

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

(* no, it gets stuck when n is odd. *)
(** [] *)

(** Intuitively, the induction principle [ev n] evidence [ev n] is
    similar to induction on [n], but restricts our attention to only
    those numbers for which evidence [ev n] could be generated. *)

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

   no evidence
*)
(** [] *)

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

Theorem ev_sum : forall n m,
   ev n -> ev m -> ev (n+m).
Proof.
  intros.
  induction H. apply H0.
  apply ev_SS in IHev.
  apply IHev.
Qed.
(** [] *)

(* ####################################################### *)
(** ** Inversion on Evidence *)

(** Having evidence for a proposition is useful while proving, because we
   can _look_ at that evidence for more information. For example, consider
    proving that, if [n] is even, then [pred (pred n)] is
    too.  In this case, we don't need to do an inductive proof.  Instead
    the [inversion] tactic provides all of the information that we need.

 *)

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

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

(* fail *)
(** [] *)

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

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

(** ** The Inversion Tactic Revisited *)

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

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

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

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

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

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

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

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

Theorem ev_ev__ev : forall n m,
  ev (n+m) -> ev n -> ev m.
Proof.
  intros. induction H0.
  apply H.
  inversion H.
  apply IHev.
  apply H2.
Qed.
(** [] *)

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

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

(* ####################################################### *)
(** * Discussion and Variations *)
(** ** Computational vs. Inductive Definitions *)

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

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

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

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

(* ####################################################### *)
(** ** Parameterized Data Structures *)

(** So far, we have only looked at propositions about natural numbers. However,
   we can define inductive predicates about any type of data. For example,
   suppose we would like to characterize lists of _even_ length. We can
   do that with the following definition.  *)

Inductive ev_list {X:Type} : list X -> Prop :=
  | el_nil : ev_list []
  | el_cc  : forall x y l, ev_list l -> ev_list (x :: y :: l).

(** Of course, this proposition is equivalent to just saying that the
length of the list is even. *)

Lemma ev_list__ev_length: forall X (l : list X), ev_list l -> ev (length l).
Proof.
    intros X l H. induction H.
    Case "el_nil". simpl. apply ev_0.
    Case "el_cc".  simpl.  apply ev_SS. apply IHev_list.
Qed.

(** However, because evidence for [ev] contains less information than
evidence for [ev_list], the converse direction must be stated very
carefully. *)

Lemma ev_length__ev_list: forall X n, ev n -> forall (l : list X), n = length l -> ev_list l.
Proof.
  intros X n H.
  induction H.
  Case "ev_0". intros l H. destruct l.
    SCase "[]". apply el_nil.
    SCase "x::l". inversion H.
  Case "ev_SS". intros l H2. destruct l.
    SCase "[]". inversion H2. destruct l.
    SCase "[x]". inversion H2.
    SCase "x :: x0 :: l". apply el_cc. apply IHev. inversion H2. reflexivity.
Qed.

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

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

    - Prove [pal_app_rev] that
       forall l, pal (l ++ rev l).
    - Prove [pal_rev] that
       forall l, pal l -> l = rev l.
*)

Inductive pal {X:Type} : list X -> Prop :=
  | pal_nil : pal []
  | pal_1 : forall x, pal [x]
  | pal_cc  : forall x l, pal l -> pal (x :: (snoc l x)).

Theorem pal_app_rev : forall (X:Type) (l:list X),
  pal (l ++ rev l).
Proof.
  intros.
  induction l.
  apply pal_nil.
  simpl. rewrite <- snoc_with_append.
  apply pal_cc.
  apply IHl.
Qed.

Theorem pal_rev : forall (X:Type) (l:list X),
  pal l -> l = rev l.
Proof.
  intros.
  induction H.
  reflexivity.
  simpl. reflexivity.
  simpl. rewrite rev_snoc.
  simpl. apply f_equal.
  rewrite <- IHpal.
  reflexivity.
Qed.
(** [] *)

(* Again, the converse direction is much more difficult, due to the
lack of evidence. *)

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

Theorem palindrome_converse : forall (X:Type) (l:list X),
  l = rev l -> pal l.
Proof.
  intros.
(* FILL IN HERE *)
Abort.
(** [] *)

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

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

Module LeModule.

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

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

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

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

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

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

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

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

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

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

End LeModule.

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

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

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

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

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

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

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

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

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

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

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

Lemma le_trans : forall m n o, m <= n -> n <= o -> m <= o.
Proof.
  intros.
  induction H0. apply H.
  apply le_S. apply IHle.
Qed.

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

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

Theorem Sn_le_Sm__n_le_m : forall n m,
  S n <= S m -> n <= m.
Proof.
  intros.
  inversion H. apply le_n.
  apply le_trans with (n:=S n).
  apply le_S. apply le_n. apply H1.
Qed.

Theorem le_plus_l : forall a b,
  a <= a + b.
Proof.
  intros.
  induction b.
  rewrite <- plus_n_O.
  apply le_n.
  rewrite <- plus_n_Sm.
  apply le_S. apply IHb.
Qed.

Theorem plus_lt : forall n1 n2 m,
  n1 + n2 < m ->
  n1 < m /\ n2 < m.
Proof.
  unfold lt.
  intros.
  split. apply le_trans with (n:=S (n1 + n2)).
  rewrite plus_comm. rewrite plus_n_Sm. rewrite plus_comm.
  apply le_plus_l. apply H.
  apply le_trans with (n:=S (n1 + n2)).
  rewrite plus_n_Sm. rewrite plus_comm.
  apply le_plus_l. apply H.
Qed.

Theorem lt_S : forall n m,
  n < m ->
  n < S m.
Proof.
  unfold lt.
  intros.
  apply le_trans with (n:=m).
  apply H. apply le_S. apply le_n.
Qed.

Theorem ble_nat_true : forall n m,
  ble_nat n m = true -> n <= m.
Proof.
  intros n.
  induction n.
  intros. apply O_le_n.
  intros.
  simpl in H. destruct m.
  inversion H. apply n_le_m__Sn_le_Sm.
  apply IHn. apply H.
Qed.

Theorem le_ble_nat : forall n m,
  n <= m ->
  ble_nat n m = true.
Proof.
  (* Hint: This may be easiest to prove by induction on [m]. *)
  intros n m.
  generalize n.
  induction m.
  intros. inversion H. reflexivity.
  intros. destruct n0. reflexivity.
  simpl. apply IHm. apply Sn_le_Sm__n_le_m.
  apply H.
Qed.

Theorem ble_nat_true_trans : forall n m o,
  ble_nat n m = true -> ble_nat m o = true -> ble_nat n o = true.
Proof.
  (* Hint: This theorem can be easily proved without using [induction]. *)
  intros.
  apply le_ble_nat.
  apply ble_nat_true in H.
  apply ble_nat_true in H0.
  apply le_trans with (n:=m).
  apply H. apply H0.
Qed.

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

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

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

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

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

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

[R 1 1 2] is provable.
no, only c1-3 is enough for nat +.
same.
[]
*)

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

Theorem R_m_n_o : forall (m n o:nat),
  R m n o <-> m + n = o.
Proof.
  split.
  intros. induction H. reflexivity.
  rewrite plus_comm. rewrite <- plus_n_Sm.
  rewrite plus_comm. apply f_equal.
  apply IHR. rewrite <- plus_n_Sm.
  apply f_equal. apply IHR.
  inversion IHR. rewrite <- plus_n_Sm in H1.
  inversion H1. reflexivity. rewrite plus_comm.
  apply IHR.
  generalize n o. induction m.
  intros n0. induction n0.
  intros. rewrite <- H. apply c1.
  intros. simpl in H. destruct o0. inversion H.
  apply c3. apply IHn0. inversion H. reflexivity.
  intros n0. induction n0.
  intros. destruct o0. inversion H.
  apply c2. inversion H. rewrite H1. apply IHm. apply H1.
  intros. destruct o0. inversion H.
  destruct o0. inversion H. rewrite <- plus_n_Sm in H1.
  inversion H1.
  apply c2. apply c3. apply IHm.
  inversion H. rewrite <- plus_n_Sm in H1.
  inversion H1. reflexivity.
Qed.
(** [] *)

End R.

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

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

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

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

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

Inductive subseq {X:Type} : list X -> list X -> Prop :=
  | sub_nil : forall l, subseq [] l
  | sub2 : forall n l1 l2, subseq l1 l2 -> subseq l1 (n :: l2)
  | sub3 : forall n l1 l2, subseq l1 l2 -> subseq (n :: l1) (n :: l2).

Theorem cons_app : forall (X:Type) (l1 l2:list X) (x:X),
  (x :: l1) ++ l2 = x :: (l1 ++ l2).
Proof.
  intros. destruct l1. reflexivity.
  simpl. reflexivity.
Qed.

Theorem subseq_refl : forall (X:Type) (l:list X), subseq l l.
Proof.
  intros. induction l. apply sub_nil.
  apply sub3. apply IHl.
Qed.

Theorem subseq_app_nil : forall (X:Type) (l:list X), subseq nil l.
Proof.
  intros.
  induction l. apply subseq_refl.
  apply sub2. apply IHl.
Qed.

Theorem subseq_app_self : forall (X:Type) (l1 l2:list X), subseq l1 (l1 ++ l2).
Proof.
  intros.
  induction l1. apply subseq_app_nil. rewrite cons_app.
  apply sub3. apply IHl1.
Qed.

Theorem subseq_app : forall (X:Type) (l1 l2 l3:list X),
  subseq l1 l2 -> subseq l1 (l2 ++ l3).
Proof.
  intros.
  induction H. apply sub_nil.
  rewrite cons_app. apply sub2. apply IHsubseq.
  rewrite cons_app. apply sub3. apply IHsubseq.
Qed.

Theorem subseq_cons : forall (X:Type) (l1 l2:list X) (n:X),
  subseq (n :: l1) l2 -> subseq l1 l2.
Proof.
  intros X l1 l2 n.
  generalize n l1.
  induction l2.
  intros. inversion H. intros.
  inversion H. apply sub2. apply IHl2 with (n:=n0).
  apply H2. apply sub2. apply H1.
Qed.

Theorem subseq_cut : forall (X:Type) (l1 l2:list X) (n1 n2:X),
  subseq (n1 :: l1) (n2 :: l2) -> subseq l1 l2.
Proof.
  intros. inversion H.
  apply subseq_cons in H2. apply H2. apply H1.
Qed.

Theorem subseq_trans : forall (X:Type) (l1 l2 l3:list X),
  subseq l1 l2 -> subseq l2 l3 -> subseq l1 l3.
Proof.
  intros X l1 l2 l3. generalize dependent l1.
  generalize dependent l2. induction l3.
  intros l1 l2 h i. inversion i.
  rewrite <- H in h. inversion h. apply sub_nil.
  intros l1 l2 h i. inversion i.
  rewrite <- H in h. inversion h. apply sub_nil.
  destruct h as [| h' | h'].
  apply sub_nil.
  apply sub2. apply IHl3 with (l2:=h' :: l2). apply sub2. apply h.
  apply H1.
  apply sub2. apply IHl3 with (l2:=h' :: l2). apply sub3. apply h.
  apply H1.
  destruct h as [| h' | h'].
  apply sub_nil. apply sub2. apply IHl3 with (l2:=l2).
  apply h. apply subseq_cut in i. apply i.
  inversion H0. rewrite <- H4. rewrite H. apply sub3. apply IHl3 with (l2:=l2).
  apply h. apply subseq_cut in i. apply i.
Qed.

(** [] *)

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

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

(** [] *)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Theorem plus_fact_is_true :
  plus_fact.
Proof. reflexivity.  Qed.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

(** **** Exercise: 3 stars (combine_odd_even)  *)
(** Complete the definition of the [combine_odd_even] function
    below. It takes as arguments two properties of numbers [Podd] and
    [Peven]. As its result, it should return a new property [P] such
    that [P n] is equivalent to [Podd n] when [n] is odd, and
    equivalent to [Peven n] otherwise. *)

Definition combine_odd_even (Podd Peven : nat -> Prop) : nat -> Prop :=
  fun (n:nat) => match (oddb n) with
                 | true => Podd n
                 | false => Peven n
               end.

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

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

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

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

(** [] *)

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

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

Fixpoint true_upto_n__true_everywhere (n:nat) (p:nat -> Prop) : Prop :=
  match n with
      | 0 => true_for_all_numbers p
      | S n' => p n -> true_upto_n__true_everywhere n' p
  end.

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

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


(**
  This module defines the Abelian Group record type which can be
  used to represent abelian groups and provides a collection of
  axioms and theorems describing them.

  Copyright (C) 2018 Larry D. Lee Jr. <llee454@gmail.com>

  This program is free software: you can redistribute it and/or modify
  it under the terms of the GNU Lesser General Public License as
  published by the Free Software Foundation, either version 3 of the
  License, or (at your option) any later version.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU Lesser General Public License for more details.

  You should have received a copy of the GNU Lesser General Public
  License along with this program. If not, see
  <https://www.gnu.org/licenses/>.
*)

Require Import Description.
Require Import base.
Require Import function.
Require Import monoid.
Require Import group.

Module Abelian_Group.

(**
  Accepts one argument: f, a binary function;
  and asserts that f is commutative.
*)
Definition is_comm (T : Type) (f : T -> T -> T)
  :  Prop
  := forall x y : T, f x y = f y x.

(** Represents algebraic abelian groups. *)
Structure Abelian_Group : Type := abelian_group {

  (** Represents the set of group elements. *)
  E : Set;

  (** Represents the identity element. *)
  E_0 : E;

  (** Represents the group operation. *)
  op : E -> E -> E;

  (** Asserts that the group operator is associative. *)
  op_is_assoc : Monoid.is_assoc E op;

  (** Asserts that the group operator is commutative. *)
  op_is_comm : is_comm E op;

  (** Asserts that E_0 is the left identity element. *)
  op_id_l : Monoid.is_id_l E op E_0;

  (**
    Asserts that every element has a left inverse.

    Strictly speaking, this axiom should be:

      forall x : E, exists y : E,
        Monoid.is_inv_l E op E_0 op_id x y

    which asserts and verifies that op y x equals
    the identity element. Technically, we haven't
    shown that E_0 is the identity element yet, so
    we're being a bit presumptuous defining inverses
    in this way. While we could prove op_id in this
    structure definition, we prefer not to to improve
    readability and instead use the form given below,
    which Monoid.is_inv_l reduces to anyway.
  *)
  op_inv_l_ex : forall x : E, exists y : E, op y x = E_0
}.

(** Enable implicit arguments for group properties. *)

Arguments E_0 {a}.

Arguments op {a} x y.

Arguments op_is_assoc {a} x y z.

Arguments op_is_comm {a} x y.

Arguments op_id_l {a} x.

Arguments op_inv_l_ex {a} x.

(** Define notations for group properties. *)

Notation "0" := E_0 : abelian_group_scope.

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

Notation "{+}" := op : abelian_group_scope.

Open Scope abelian_group_scope.

Section Theorems.

(**
  Represents an arbitrary abelian group.

  Note: we use Variable rather than Parameter
  to ensure that the following theorems are
  generalized w.r.t ag.
*)
Variable g : Abelian_Group.

(**
  Represents the set of group elements.

  Note: We use Let to define E as a
  local abbreviation.
*)
Let E := E g.

(**
  Accepts one group element, x, and asserts
  that x is the left identity element.
*)
Definition op_is_id_l := Monoid.is_id_l E {+}.

(**
  Accepts one group element, x, and asserts
  that x is the right identity element.
*)
Definition op_is_id_r := Monoid.is_id_r E {+}.

(**
  Accepts one group element, x, and asserts
  that x is the identity element.
*)
Definition op_is_id := Monoid.is_id E {+}.

(**
  Proves that every left identity must also
  be a right identity.
*)
Theorem op_is_id_lr
  :  forall x : E, op_is_id_l x -> op_is_id_r x.
Proof
  fun x H y
    => H y
    || a = y @a by op_is_comm y x.

(**
  Proves that every left identity is an
  identity.
*)
Theorem op_is_id_lid
  : forall x : E, op_is_id_l x -> op_is_id x.
Proof
  fun x H
    => conj H (op_is_id_lr x H).

(** Proves that 0 is the right identity element. *)
Theorem op_id_r
  :  op_is_id_r 0.
Proof op_is_id_lr 0 op_id_l.

(** Proves that 0 is the identity element. *)
Theorem op_id
  :  op_is_id 0.
Proof conj op_id_l op_id_r.

(**
  Accepts two group elements, x and y, and
  asserts that y is x's left inverse.
*)
Definition op_is_inv_l := Monoid.is_inv_l E {+} 0 op_id.

(**
  Accepts two group elements, x and y, and
  asserts that y is x's right inverse.
*)
Definition op_is_inv_r := Monoid.is_inv_r E {+} 0 op_id.

(**
  Accepts two group elements, x and y, and
  asserts that y is x's inverse.
*)
Definition op_is_inv := Monoid.is_inv E {+} 0 op_id.

(** Proves that every element has a right inverse. *)
Theorem op_inv_r_ex
  :  forall x : E, exists y : E, op_is_inv_r x y.
Proof
  fun x
    => ex_ind
         (fun (y : E) (H : op_is_inv_l x y)
           => ex_intro
                (op_is_inv_r x)
                y
                (H || a = 0 @a by op_is_comm x y))
         (op_inv_l_ex x).

(**
  Represents the group structure formed by
  op over E.
*)
Definition op_group := Group.group E 0 {+} op_is_assoc op_id_l op_id_r op_inv_l_ex op_inv_r_ex.

(** Represents the monoid formed by op over E. *)
Definition op_monoid := Group.op_monoid op_group.

(**
  Accepts one argument, x, and asserts that
  x has a left inverse.
*)
Definition has_inv_l := Group.has_inv_l op_group.

(**
  Accepts one argument, x, and asserts that
  x has a right inverse.
*)
Definition has_inv_r := Group.has_inv_r op_group.

(**
  Accepts one argument, x, and asserts that
  x has an inverse.
*)
Definition has_inv := Group.has_inv op_group.

(** Proves that the left identity element is unique. *)
Theorem op_id_l_uniq
  :  forall x : E, Monoid.is_id_l E {+} x -> x = 0.
Proof Group.op_id_l_uniq op_group.

(** Proves that the right identity element is unique. *)
Theorem op_id_r_uniq
  :  forall x : E, Monoid.is_id_r E {+} x -> x = 0.
Proof Group.op_id_r_uniq op_group.

(** Proves that the identity element is unique. *)
Theorem op_id_uniq
  :  forall x : E, Monoid.is_id E {+} x -> x = 0.
Proof Group.op_id_uniq op_group.

(**
  Proves that for every group element, x,
  its left and right inverses are equal.
*)
Theorem op_inv_l_r_eq
  :  forall x y : E, op_is_inv_l x y -> forall z : E, op_is_inv_r x z -> y = z.
Proof Group.op_inv_l_r_eq op_group.

(**
  Proves that the inverse relation is
  symmetrical.
*)
Theorem op_inv_sym
  :  forall x y : E, op_is_inv x y <-> op_is_inv y x.
Proof Group.op_inv_sym op_group.

(**
  Proves that every group element has an
  inverse.
*)
Theorem op_inv_ex
  :  forall x : E, exists y : E, op_is_inv x y.
Proof Group.op_inv_ex op_group.

(** Proves the left introduction rule. *)
Theorem op_intro_l
  :  forall x y z : E, x = y -> z + x = z + y.
Proof Group.op_intro_l op_group.

(** Proves the right introduction rule. *)
Theorem op_intro_r
  :  forall x y z : E, x = y -> x + z = y + z.
Proof Group.op_intro_r op_group.

(** Proves the left cancellation rule. *)
Theorem op_cancel_l
  :   forall x y z : E, z + x = z + y -> x = y.
Proof Group.op_cancel_l op_group.

(** Proves the right cancellation rule. *)
Theorem op_cancel_r
  :   forall x y z : E, x + z = y + z -> x = y.
Proof Group.op_cancel_r op_group.

(**
  Proves that an element's left inverse
  is unique.
*)
Theorem op_inv_l_uniq
  :  forall x y z : E, op_is_inv_l x y -> op_is_inv_l x z -> z = y.
Proof Group.op_inv_l_uniq op_group.

(**
  Proves that an element's right inverse
  is unique.
*)
Theorem op_inv_r_uniq
  :  forall x y z : E, op_is_inv_r x y -> op_is_inv_r x z -> z = y.
Proof Group.op_inv_r_uniq op_group.

(** Proves that an element's inverse is unique. *)
Theorem op_inv_uniq
  :  forall x y z : E, op_is_inv x y -> op_is_inv x z -> z = y.
Proof Group.op_inv_uniq op_group.

(**
  Proves explicitly that every element has a
  unique inverse.
*)
Theorem op_inv_uniq_ex
  :  forall x : E, exists! y : E, op_is_inv x y.
Proof Group.op_inv_uniq_ex op_group.

(**
  Proves that the identity element is its own
  left inverse.
*)
Theorem op_inv_0_l
  :  op_is_inv_l 0 0.
Proof Group.op_inv_0_l op_group.

(**
  Proves that the identity element is its own
  right inverse.
*)
Theorem op_inv_0_r
  :  op_is_inv_r 0 0.
Proof Group.op_inv_0_r op_group.

(**
  Proves that the identity element is its own
  inverse.
*)
Theorem op_inv_0
  :  op_is_inv 0 0.
Proof Group.op_inv_0 op_group.

(**
  Proves that the identity element has a
  left inverse.
*)
Theorem op_has_inv_l_0
  :  has_inv_l 0.
Proof Group.op_has_inv_l_0 op_group.

(**
  Proves that the identity element has a
  right inverse.
*)
Theorem op_has_inv_r_0
  :  has_inv_r 0.
Proof Group.op_has_inv_r_0 op_group.

(**
  Proves that the identity element has an
  inverse.
*)
Theorem op_has_inv_0
  :  has_inv 0.
Proof Group.op_has_inv_0 op_group.

(**
  Proves that if an element's, x, inverse
  equals 0, x equals 0.
*)
Theorem op_inv_0_eq_0
  :  forall x : E, op_is_inv x 0 -> x = 0.
Proof Group.op_inv_0_eq_0 op_group.

(**
  Proves that 0 is the only element whose
  inverse is 0.
*)
Theorem op_inv_0_uniq
  :  unique (fun x => op_is_inv x 0) 0.
Proof Group.op_inv_0_uniq op_group.

(** Represents strongly-specified negation. *)
Definition op_neg_strong
  :  forall x : E, { y | op_is_inv x y }
  := Group.op_neg_strong op_group.

(** Represents negation. *)
Definition op_neg
  :  E -> E
  := Group.op_neg op_group.

Close Scope nat_scope.

Notation "{-}" := (op_neg) : abelian_group_scope.

Notation "- x" := (op_neg x) : abelian_group_scope.

(**
  Asserts that the negation returns the inverse
  of its argument.
*)
Theorem op_neg_def
  :  forall x : E, op_is_inv x (- x).
Proof Group.op_neg_def op_group.

(** Proves that negation is one-to-one *)
Theorem op_neg_inj
  :  is_injective E E op_neg.
Proof Group.op_neg_inj op_group.

(** Proves the cancellation property for negation. *)
Theorem op_cancel_neg
  :  forall x : E, op_neg (- x) = x.
Proof Group.op_cancel_neg op_group.

(** Proves that negation is onto *)
Theorem op_neg_onto
  :  is_onto E E op_neg.
Proof Group.op_neg_onto op_group.

(** Proves that negation is surjective *)
Theorem op_neg_bijective
  :  is_bijective E E op_neg.
Proof Group.op_neg_bijective op_group.

(** Proves that neg x = y -> neg y = x *)
Theorem op_neg_rev
  :  forall x y : E, - x = y -> - y = x.
Proof Group.op_neg_rev op_group.

(**
  Proves that the left inverse of x + y is -y + -x.
*)
Theorem op_neg_distrib_inv_l
  :  forall x y : E, op_is_inv_l (x + y) (- y + - x).
Proof Group.op_neg_distrib_inv_l op_group.

(**
  Proves that the right inverse of x + y is -y + -x.
*)
Theorem op_neg_distrib_inv_r
  :  forall x y : E, op_is_inv_r (x + y) (- y + - x).
Proof Group.op_neg_distrib_inv_r op_group.

(**
  Proves that the inverse of x + y is -y + -x.
*)
Theorem op_neg_distrib_inv
  :  forall x y : E, op_is_inv (x + y) (- y + - x).
Proof Group.op_neg_distrib_inv op_group.

(**
  Proves that negation is distributive: i.e.
  -(x + y) = -y + -x.
*)
Theorem op_neg_distrib
  :  forall x y : E, - (x + y) = - y + - x.
Proof Group.op_neg_distrib op_group.

End Theorems.

End Abelian_Group.

Notation "0" := (Abelian_Group.E_0) : abelian_group_scope.

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

Notation "{+}" := (Abelian_Group.op) : abelian_group_scope.

Notation "{-}" := (Abelian_Group.op_neg _) : abelian_group_scope.

Notation "- x" := (Abelian_Group.op_neg _ x) : abelian_group_scope.


Inductive UBTree : Set :=
  | leaf0 : UBTree
  | node2 : UBTree -> UBTree -> UBTree
  | node1 : UBTree -> UBTree.

Fixpoint right_UB (t:UBTree) (s:UBTree) : UBTree :=
  match t with
    | leaf0 => node2 leaf0 s
    | node2 t0 t1 => node2 t0 (right_UB t1 s)
    | node1 t => node1 (right_UB t s)
  end.

Eval compute in right_UB (node2 leaf0 leaf0) (node2 leaf0 (node2 leaf0 leaf0)).
Eval compute in right_UB (node2 leaf0 (node1 leaf0)) (node2 leaf0 (node2 leaf0 leaf0)).

Fixpoint length_UB (t:UBTree) : nat :=
  match t with
    | leaf0 => 1
    | node2 t1 t2 => (length_UB t1) + (length_UB t2)
    | node1 t => length_UB t
  end.

Eval compute in length_UB (right_UB (node2 leaf0 leaf0) (node2 leaf0 (node2 leaf0 leaf0))).
Eval compute in length_UB (right_UB (node2 leaf0 (node1 leaf0)) (node2 leaf0 (node2 leaf0 leaf0))).

Theorem right_UB_length : forall s t:UBTree, length_UB(right_UB s t) = length_UB s + length_UB t.
Proof.
  induction s, t.
  simpl; reflexivity.
  simpl; reflexivity.
  simpl; reflexivity.
  Require Import Omega.
  simpl. rewrite IHs2. simpl. omega.
  simpl. rewrite IHs2. simpl. omega.
  simpl. rewrite IHs2. simpl. omega.
  simpl. rewrite IHs. simpl. reflexivity.
  simpl. rewrite IHs. simpl. reflexivity.
  simpl. rewrite IHs. simpl. reflexivity.
Qed.


Require Import Algebra Tactics Equal ZArith.
Open Scope Z_scope.

Inductive Vec3 : Type :=
  | vec3 : Z -> Z -> Z -> Vec3.

Definition specification_add_vec3 (add : Vec3 -> Vec3 -> Vec3) :=
  forall x1 y1 z1 x2 y2 z2 : Z,
    add (vec3 x1 y1 z1)
        (vec3 x2 y2 z2) =
    vec3 (x1 + x2)
          (y1 + y2)
          (z1 + z2).

Theorem specification_of_add_vec3_is_unique :
  forall add add' : Vec3 -> Vec3 -> Vec3,
    specification_add_vec3 add  ->
    specification_add_vec3 add' ->
    forall v1 v2 : Vec3,
      add v1 v2 = add' v1 v2.
Proof.
  intros add add'.
  unfold specification_add_vec3.
  intros S_add S_add'.
  intros v1 v2.
  destruct v1 as [x1 y1 z1].
  destruct v2 as [x2 y2 z2].
  rewrite -> S_add.
  symmetry.
  exact (S_add' x1 y1 z1 x2 y2 z2).
Qed.

Function add_vec3 (v1 v2 : Vec3) : Vec3 :=
  match v1, v2 with
    | vec3 x1 y1 z1, vec3 x2 y2 z2 =>
      vec3 (x1 + x2) (y1 + y2) (z1 + z2)
  end.

Lemma unfold_add_vec3 :
  forall x1 y1 z1 x2 y2 z2 : Z,
    add_vec3 (vec3 x1 y1 z1)
              (vec3 x2 y2 z2) =
    vec3 (x1 + x2)
          (y1 + y2)
          (z1 + z2).
Proof.
  unfold_tactic add_vec3.
Qed.

Theorem add_vec3_satisfies_the_specification :
  specification_add_vec3 add_vec3.
Proof.
  unfold specification_add_vec3.
  exact unfold_add_vec3.
Qed.

Theorem Vec3_and_addition_is_associative :
  Associative Vec3 add_vec3 eq.
Proof.
  unfold Associative.
  intros [x1 y1 z1] [x2 y2 z2] [x3 y3 z3].
  rewrite ->4 unfold_add_vec3.
  rewrite ->3 Z.add_assoc.
  reflexivity.
Qed.

Corollary Vec3_and_addition_is_a_semi_group :
    Semi_Group Vec3 add_vec3 eq.
Proof.
  unfold Semi_Group.
  split.
  exact (eq_is_a_valid_Equal Vec3).
  exact Vec3_and_addition_is_associative.
Qed.

Definition O_vec3 : Vec3 := vec3 0 0 0.

Lemma add_O_vec3_l :
  forall v : Vec3,
    add_vec3 O_vec3 v = v.
Proof.
  intros [x y z].
  unfold O_vec3.
  rewrite -> unfold_add_vec3.
  rewrite ->3 Z.add_0_l.
  reflexivity.
Qed.

Lemma add_O_vec3_r :
  forall v : Vec3,
    add_vec3 v O_vec3 = v.
Proof.
  intros [x y z].
  unfold O_vec3.
  rewrite -> unfold_add_vec3.
  rewrite ->3 Z.add_0_r.
  reflexivity.
Qed.

Theorem Vec3_and_addition_has_a_neutral_element :
  exists (O : Vec3),
    Neutral Vec3 add_vec3 O eq.
Proof.
  unfold Neutral.
  exists O_vec3.
  intro v.
  split.
    exact (add_O_vec3_r v).

    exact (add_O_vec3_l v).
Qed.

Corollary Vec3_and_addition_is_a_monoid :
  Monoid Vec3 add_vec3 eq.
Proof.
  unfold Monoid.
  split.
  exact Vec3_and_addition_has_a_neutral_element.
  exact Vec3_and_addition_is_a_semi_group.
Qed.

Theorem Vec3_and_addition_is_commutative :
  Commutative Vec3 add_vec3 eq.
Proof.
  unfold Commutative.
  intros [x1 y1 z1] [x2 y2 z2].
  rewrite ->2 unfold_add_vec3.
  symmetry.
  rewrite -> (Z.add_comm x2 x1).
  rewrite -> (Z.add_comm y2 y1).
  rewrite -> (Z.add_comm z2 z1).
  reflexivity.
Qed.

Definition opp_vec3 (v : Vec3) : Vec3 :=
  match v with
    | vec3 x y z => vec3 (Z.opp x) (Z.opp y) (Z.opp z)
  end.

Lemma add_opp_vec3_r :
  forall v : Vec3,
    add_vec3 v (opp_vec3 v) = O_vec3.
Proof.
  intros [x y z].
  unfold opp_vec3.
  unfold O_vec3.
  rewrite -> unfold_add_vec3.
  rewrite ->3 Zegal_left; reflexivity.
Qed.

Lemma add_opp_vec3_l :
  forall v : Vec3,
    add_vec3 (opp_vec3 v) v = O_vec3.
Proof.
  intro v.
  rewrite -> (Vec3_and_addition_is_commutative (opp_vec3 v) v).
  exact (add_opp_vec3_r v).
Qed.

Theorem Vec3_and_addition_has_an_inverse :
  Inverse Vec3 add_vec3 eq.
Proof.
  unfold Inverse.
  intro v.
  exists O_vec3.
  exists (opp_vec3 v).
  exact (add_opp_vec3_r v).
Qed.

Corollary Vec3_and_addition_is_a_Abelian_group :
  Abelian_Group Vec3 add_vec3 eq.
Proof.
  unfold Abelian_Group.
  split.
    exact Vec3_and_addition_is_commutative.
    split.
      exact Vec3_and_addition_has_an_inverse.
      exact Vec3_and_addition_is_a_monoid.
Qed.

(* Vector multiplication is not assciative, because of its type : Vec3 -> Vec3 -> Z *)
(* Therefore it is not a semi group. *)
(* I assume that the vectors is transposed properly *)

Definition specification_of_vec3_multiplication (mult : Vec3 -> Vec3 -> Z) :=
  forall x1 y1 z1 x2 y2 z2 : Z,
    mult (vec3 x1 y1 z1) (vec3 x2 y2 z2) = x1 * x2 + y1 * y2 + z1 * z2.

Theorem specification_of_vec3_multiplication_is_unique :
  forall mult mult' : Vec3 -> Vec3 -> Z,
    specification_of_vec3_multiplication mult ->
    specification_of_vec3_multiplication mult' ->
    forall v w : Vec3,
      mult v w = mult' v w.
Proof.
  intros mult mult'.
  unfold specification_of_vec3_multiplication.
  intros S_mult S_mult'.
  intros [x1 y1 z1] [x2 y2 z2].
  rewrite -> S_mult.
  symmetry.
  exact (S_mult' x1 y1 z1 x2 y2 z2).
Qed.

Function mult_vec3 (v w : Vec3) : Z :=
  match v, w with
    | vec3 x1 y1 z1, vec3 x2 y2 z2 =>
      x1 * x2 + y1 * y2 + z1 * z2
  end.

Lemma unfold_mult_vec3 :
  forall x1 y1 z1 x2 y2 z2 : Z,
    mult_vec3 (vec3 x1 y1 z1) (vec3 x2 y2 z2) = x1 * x2 + y1 * y2 + z1 * z2.
Proof.
  unfold_tactic mult_vec3.
Qed.

Search (_ * _ = _ * _).

Theorem mult_vec3_is_commutative :
  forall v w : Vec3,
    mult_vec3 v w = mult_vec3 w v.
Proof.
  intros [x1 y1 z1] [x2 y2 z2].
  rewrite ->2 unfold_mult_vec3.
  symmetry.
  rewrite -> (Z.mul_comm x2 x1).
  rewrite -> (Z.mul_comm y2 y1).
  rewrite -> (Z.mul_comm z2 z1).
  reflexivity.
Qed.

(* Please continue with Matrix3x3 *)


(* Final Exam --- January 7, 2019 *)

(****** 10152160137

        陈弈君
******)
Require Import Nat.
Require Import List.

Notation "[ ]" := nil.
Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..).

Definition admit {T: Type} : T.  Admitted.

(* 1. Prove the following two facts about natural numbers. *)

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

Lemma mul_1_r : forall n : nat, n * 1 = n.
Proof.
  intro n. induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite IHn'. reflexivity.
Qed.

(* 2. Complete the following definition so that (div5 n) returns true
iff n is divisible by 5. *)

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

Example test1: div5 15 = true.
Proof.
  simpl. reflexivity.
Qed.

Example test2: div5 23 = false.
Proof.
  simpl. reflexivity.
Qed.

(* 3. Define a function createList such that (createList n) returns
a list of n numbers from 2n to 1. *)

Fixpoint createList (n : nat) : list nat :=
  match n with
  | O => nil
  | S n' => [n*2; n*2-1] ++ (createList n')
  end.

Example test3 : createList 4 = [8;7;6;5;4;3;2;1].
Proof.
  simpl. reflexivity.
Qed.

(* 4. (1) Define the relation gtodd between odd numbers such that
   (gtodd m n) holds if and only if m is greater than n for odd numbers m and n.
(2) Show the transitivity of the relation gtodd. *)

Inductive od : nat -> Prop :=
  | od_1 : od (S 0)
  | od_SS : forall n : nat, od n -> od (S (S n)).

Inductive gtodd : nat -> nat -> Prop :=
  | equal : forall n, od n -> gtodd n n
  | greater : forall n m, (gtodd n m) -> (gtodd (S (S n)) m).

Example test4 : gtodd 3 1.
Proof.
  apply greater.
  apply equal.
  apply od_1.
Qed.

Example test5 : ~ (gtodd 4 3).
Proof.
  unfold not. intros. inversion H. inversion H1. inversion H4.
Qed.

Theorem gtodd_trans : forall m n p,
  gtodd m n -> gtodd n p -> gtodd m p.
Proof.
  intros. induction H.
  - apply H0.
  - apply greater. apply IHgtodd. apply H0.
Qed.

(* 5. Write a function (partition):

      partition : list nat -> list (list nat )

   which partitions a list into a list of 3 sublists. The first sublist
   contains all even numbers in the original list. The second sublist
   contains all odd numbers divisible by 5 in the original list. The last
   sublist contains all other elements. The order of elements in the
   three sublists should be the same as their order in the original list.

   Hint: You can make use of the Coq function (filter).
*)

(********* Start Define evenb , oddb , orb  *************)
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).
Definition orb (b1:bool) (b2:bool) : bool :=
  match b1 with
  | true => true
  | false => b2
  end.
(********* End Define evenb , oddb , orb *************)

Definition partition (l : list nat) : list (list nat) :=
  [ filter evenb l;
    filter div5 l;
    filter (fun n => if orb (evenb n) (div5 n) then false else true) l].

Example test6: partition [1;2;3;9;4;5;6;15] = [[2;4;6]; [5;15]; [1;3;9]].
Proof.
  unfold partition.
  simpl. reflexivity.
Qed.

(* 6. Prove that the excluded middle axiom implies the Peirce's law. *)

Theorem peirce :
  (forall P, P \/ ~P) -> (forall P Q : Prop, ((P->Q)->P)->P).
Proof.
  intros. destruct (H P).
  - apply H1.
  - unfold not in H1. apply H1 in H0.
    + inversion H0.
    + intros. apply H1 in H2. inversion H2.
Qed.

(* 7. Let a sequence of numbers F(n) be given as follows.
   F(0) = 0
   F(1) = 1
   F(2) = 1
   F(n) = F(n-1) + F(n-2) + F(n-3)   for n > 2.

Define the function Seq such that (Seq n) returns the sequence.

[0; F(0); 1; F(1); 2; F(2); 3; F(3); ... ; n; F(n)].
*)

Fixpoint Seq (n: nat) : list nat :=
  match n with
  | O => [0;0]
  | S n' => match n' with
            | O => (Seq n') ++ [1;1]
            | S m => match m with
                     | O => (Seq n') ++ [2;1]
                     | S o => (Seq n') ++ [n; (hd 0 (rev(Seq m)) + hd 0 (rev(Seq n')) + hd 0 (rev(Seq o)))]
                     end
            end
  end.

Example test7 :  Seq 10 =
[0; 0; 1; 1; 2; 1; 3; 2; 4; 4; 5; 7; 6; 13; 7; 24; 8; 44; 9; 81; 10; 149].
Proof.
  simpl. reflexivity.
Qed.

(* 8. Consider the following type:

Inductive btree : Set :=
 | leaf : btree
 | node : nat->btree->btree->btree.

Define a function taking as argument a natural number n
and a tree t and returning the number of occurrences of n in t.

Hint: You may use the function (eqb n m) which returns true iff the two natural
numbers n and m are equal.
*)

Inductive btree : Set :=
  | leaf : btree
  | node : nat->btree->btree->btree.

Fixpoint occur (n: nat)(t: btree) : nat :=
  match t with
  | leaf => 0
  | node m tl tr => match (eqb m n) with
                    | true => (occur n tl) + (occur n tr) + 1
                    | false => (occur n tl) + (occur n tr)
                    end
  end.

Example test8 : occur 2 (node 1 (node 2 leaf (node 2 leaf leaf)) (node 3 (node 2 leaf leaf) leaf)) = 3.
Proof.
  simpl. reflexivity.
Qed.

(* 9 Design a sorting algorithm which transforms a list of natural numbers into
a list sorted in ascending oder. *)

(************* Start define insert *************)
Fixpoint insert (n : nat)(l : list nat) : list nat :=
  match l with
  | nil => n :: nil
  | h :: l' => match (leb h n) with
               | false => n :: l
               | true => h :: insert n l'
               end
  end.
(************* End define insert *************)

Fixpoint transform (l: list nat) : list nat :=
  match l with
  | nil => nil
  | h :: l' => insert h (transform l')
  end.

Example test10 : transform [2;4;1;6;9;6;4;1;3;5;10] = [1;1;2;3;4;4;5;6;6;9;10].
Proof.
  simpl. reflexivity.
Qed.

(* 10. The following definitions specify the abstract syntax of
    some arithmetic expressions and an evaluation function. *)

Inductive aexp : Type :=
  | ANum : nat -> aexp
  | APlus : aexp -> aexp -> aexp
  | AMinus : aexp -> aexp -> aexp
  | AMult : aexp -> aexp -> aexp.

Fixpoint aeval (a : aexp) : nat :=
  match a with
  | ANum n => n
  | APlus a1 a2 => (aeval a1) + (aeval a2)
  | AMinus a1 a2 => (aeval a1) - (aeval a2)
  | AMult a1 a2 => (aeval a1) * (aeval a2)
  end.

(* Suppose we define a function that takes an arithmetic expression
   and slightly simplifies it, changing every occurrence of [e * 1]
   (i.e., [(AMult e (ANum 1)]) into just [e]. *)

Fixpoint optimize_mult1 (a:aexp) : aexp :=
  match a with
  | ANum n => ANum n
  | APlus e1 e2 => APlus (optimize_mult1 e1) (optimize_mult1 e2)
  | AMinus e1 e2 => AMinus (optimize_mult1 e1) (optimize_mult1 e2)
  | AMult e1 (ANum (S O)) => optimize_mult1 e1
  | AMult e1 e2 => AMult (optimize_mult1 e1) (optimize_mult1 e2)
  end.

(* Prove the following theorem that states the correctness of the
optimization with respect to the evaluation of arithmetic expressions. *)

Theorem optimize_mult1_sound: forall a,
 aeval (optimize_mult1 a) = aeval a.
Proof.
  intros a. induction a.
  - reflexivity.
  - simpl. rewrite IHa1. rewrite IHa2. reflexivity.
  - simpl. rewrite IHa1. rewrite IHa2. reflexivity.
  - destruct a2; try (simpl; simpl in IHa2; rewrite IHa1; rewrite IHa2; reflexivity).
  + simpl. destruct n eqn:eq.
    * simpl. rewrite IHa1. reflexivity.
    * simpl. destruct n0.
      ** rewrite IHa1. rewrite mul_1_r. reflexivity.
      ** simpl. rewrite IHa1. reflexivity.
Qed.


Require Import Arith.

Goal forall x y, x < y -> x + 10 < y + 10.
Proof.

SearchAbout (_ + _ < _ + _).

intros.
apply NPeano.Nat.add_lt_mono_r.
assumption.
Qed.

Goal forall P Q: nat -> Prop, P 0 -> (forall x, P x -> Q x) -> Q 0.
Proof.
  intros.
  apply H0 . apply H.
Qed.

Goal forall P : nat -> Prop, P 2 -> (exists y, P (1 + y)).
Proof.
  intros.
  exists 1.
  simpl.
  apply H.
Qed.

Goal forall P : nat -> Prop, (forall n m, P n -> P m) -> (exists p, P p) -> forall q, P q.
Proof.
  intros.
  destruct H0.
  apply (H x).
  assumption.
Qed.

Goal forall m n : nat, (n * 10) + m = (10 * n) + m.
intros.
assert(n * 10 = 10 * n).
apply mult_comm.
rewrite H. reflexivity.
Qed.
(* SearchAbout (_ * _ = _ * _). *)

Goal forall n m p q : nat, (n + m) + (p + q) = (n + p) + (m + q).
Proof.
  intros.
  SearchAbout (_ + _ = _ + _).
  apply plus_permute_2_in_4.
Qed.

Goal forall n m : nat, (n + m) * (n + m) = n * n + m * m + 2 * n * m.
Proof.
SearchAbout ((_ + _) * _).
intros.
rewrite mult_plus_distr_l.
rewrite mult_plus_distr_r.
rewrite mult_plus_distr_r.
assert(H: m * n = n * m).
rewrite mult_comm.
reflexivity.
rewrite H.
assert(H2: n * m + n * m = 2 * n * m).
simpl.  rewrite mult_plus_distr_r.
rewrite mult_plus_distr_r.
simpl.  SearchAbout (_ + 0).
rewrite <- plus_n_O.
reflexivity.
rewrite <- H2.
SearchAbout (_ + _ + _).
rewrite -> plus_assoc.
rewrite -> plus_assoc.
assert(H3:n * m + m * m = m * m + n * m).
rewrite -> plus_comm. reflexivity.
rewrite <- plus_assoc. rewrite H3.
SearchAbout (_ + _ + _).
rewrite <- plus_permute_2_in_4.
rewrite -> plus_assoc.
reflexivity.
Qed.

(* 課題10 *)

Parameter G : Set.
Parameter mult : G -> G -> G.
Notation "x * y" := (mult x y).
Parameter one : G.
Notation "1" := one.
Parameter inv : G -> G.
Notation "/ x" := (inv x).
Notation "x / y" := (mult x (inv y)).
Axiom mult_assoc : forall x y z, x * (y * z) = (x * y) * z.
Axiom one_unit_l : forall x, 1 * x = x.
Axiom inv_l : forall x, /x * x = 1.

Lemma inv_inv_inv_l : forall x : G, //x*/x=1.
Proof.
 intros.
  rewrite inv_l. reflexivity.
Qed.

Lemma inv_r : forall x, x * / x = 1.
Proof.
  intros.
  assert (H1: 1 * x / x = x / x).
  rewrite one_unit_l.  reflexivity.
  rewrite <- H1.
  assert (H2: 1 * x / x = //x*/x*x/x).
  rewrite inv_inv_inv_l. reflexivity.
  rewrite H2.
  assert(H3: //x/x*x/x=//x*(/x*x)*/x).
  rewrite -> mult_assoc. reflexivity.
  rewrite H3. rewrite inv_l.
  rewrite <- mult_assoc.
  rewrite one_unit_l.
  rewrite inv_inv_inv_l. reflexivity.
Qed.

Lemma one_unit_r: forall x, x * 1 = x.
Proof.
 intros.
 assert(H1: x * 1 = x * /x * x).
 rewrite <- mult_assoc.
 rewrite inv_l. reflexivity.
 rewrite  H1.  rewrite inv_r. rewrite one_unit_l.
 reflexivity.
Qed.


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

Require Import List Arith Nat Lia.

Set Implicit Arguments.

Section interval.

  (* A small interval & valuation library *)

  Definition interval := (nat * nat)%type. (* (a,b) <~~~> [a,b[ *)

  Implicit Types (i j : interval).

  Definition in_interval i x := let (a,b) := i in a <= x < b.
  Definition out_interval i x := let (a,b) := i in x < a \/ b <= x.
  Definition interval_disjoint i j := forall x, in_interval i x -> in_interval j x -> False.

  Definition interval_union (i j : interval) :=
    match i, j with (a1,b1),(a2,b2) => (min a1 a2, max b1 b2) end.

  Fact in_out_interval i x : in_interval i x -> out_interval i x -> False.
  Proof. destruct i; simpl; lia. Qed.

  Fact in_out_interval_dec i x : { in_interval i x } + { out_interval i x }.
  Proof.
    destruct i as (a,b); simpl.
    destruct (le_lt_dec a x); destruct (le_lt_dec b x); try (left; lia);right; lia.
  Qed.

  Fact interval_union_left i j x : in_interval i x -> in_interval (interval_union i j) x.
  Proof.
    revert i j; intros (a,b) (u,v); simpl.
    generalize (Nat.le_min_l a u) (Nat.le_max_l b v); lia.
  Qed.

  Fact interval_union_right i j x : in_interval j x -> in_interval (interval_union i j) x.
  Proof.
    revert i j; intros (a,b) (u,v); simpl.
    generalize (Nat.le_min_r a u) (Nat.le_max_r b v); lia.
  Qed.

  Definition valuation_union i1 (g1 : nat -> nat) i2 g2 :
               interval_disjoint i1 i2
            -> { g | (forall x, in_interval i1 x -> g x = g1 x)
                  /\ (forall x, in_interval i2 x -> g x = g2 x) }.
  Proof.
    intros H2.
    exists (fun x => if in_out_interval_dec i1 x then g1 x else g2 x).
    split; intros x Hx.
    + destruct (in_out_interval_dec i1 x) as [ | H3 ]; auto.
      exfalso; revert Hx H3; apply in_out_interval.
    + destruct (in_out_interval_dec i1 x) as [ H3 | ]; auto.
      exfalso; revert H3 Hx; apply H2.
  Qed.

  Definition valuation_one_union k v i1 (g1 : nat -> nat) i2 g2 :
               ~ in_interval (interval_union i1 i2) k
            -> interval_disjoint i1 i2
            -> { g | g k = v /\ (forall x, in_interval i1 x -> g x = g1 x)
                             /\ (forall x, in_interval i2 x -> g x = g2 x) }.
  Proof.
    intros H1 H2.
    exists (fun x => if eq_nat_dec x k then v
                     else if in_out_interval_dec i1 x then g1 x
                     else g2 x).
    split; [ | split ].
    + destruct (eq_nat_dec k k) as [ | [] ]; auto.
    + intros x Hx.
      destruct (eq_nat_dec x k) as [ | ].
      * subst; destruct H1; apply interval_union_left; auto.
      * destruct (in_out_interval_dec i1 x) as [ | H3 ]; auto.
        exfalso; revert Hx H3; apply in_out_interval.
    + intros x Hx.
      destruct (eq_nat_dec x k) as [ | ].
      * subst; destruct H1; apply interval_union_right; auto.
      * destruct (in_out_interval_dec i1 x) as [ H3 | ]; auto.
        exfalso; revert H3 Hx; apply H2.
  Qed.

End interval.


(* This code is copyrighted by its authors; it is distributed under  *)
(* the terms of the LGPL license (see LICENSE and description files) *)

(* Contribution to the Coq Library   V6.3 (July 1999)                    *)

(****************************************************************************)
(*                                                                          *)
(*                                                                          *)
(*                   Solange Coupet-Grimal & Line Jakubiec                  *)
(*                                                                          *)
(*                                                                          *)
(*              Laboratoire d'Informatique de Marseille                     *)
(*               CMI-Technopole de Chateau-Gombert                          *)
(*                   39, Rue F. Joliot Curie                                *)
(*                   13453 MARSEILLE Cedex 13                               *)
(*           e-mail:{Solange.Coupet,Line.Jakubiec}@lim.univ-mrs.fr          *)
(*                                                                          *)
(*                                                                          *)
(*                                Coq V5.10                                 *)
(*                              May 30th 1996                               *)
(*                                                                          *)
(****************************************************************************)
(*                                Lib_Exp.v                                 *)
(****************************************************************************)

Require Export Lib_Mult.

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

Fixpoint exp_n (n m : nat) {struct m} : nat :=
  match m return nat with
  | O =>
      (*O*)  1
      (*S p*)
  | S p => n * exp_n n p
  end.

(************************************************************************)
(********************************* Base 2 *******************************)
(************************************************************************)

Lemma eq_exp_2_exp_n : forall n : nat, exp_2 n = exp_n 2 n.
simple induction n; auto with arith.
intros.
change (exp_2 (S n0) = 2 * exp_n 2 n0) in |- *.
elim H; auto with arith.
Qed.
Hint Resolve eq_exp_2_exp_n.

Lemma exp_2_n_plus_n : forall n : nat, exp_2 n + exp_2 n = exp_2 (S n).
intro.
rewrite plus_mult.
change (2 * exp_2 n = 2 * exp_2 n) in |- *.
reflexivity.
Qed.
Hint Resolve exp_2_n_plus_n.

Lemma exp_2_plus_pn_pn :
 forall n : nat, 0 < n -> exp_2 (pred n) + exp_2 (pred n) = exp_2 n.
intros.
rewrite exp_2_n_plus_n.
rewrite S_pred_n; auto with arith.
Qed.
Hint Resolve exp_2_plus_pn_pn.

Lemma exp_2_le_pn_n : forall n : nat, exp_2 (pred n) <= exp_2 n.
simple induction n; auto with arith.
intros.
simpl in |- *.
elim plus_n_O; auto with arith.
Qed.
Hint Resolve exp_2_le_pn_n.

Lemma exp_2_pos : forall n : nat, 0 < exp_2 n.
simple induction n; auto with arith.
intros.
simpl in |- *.
elim plus_n_O; auto with arith.
Qed.
Hint Resolve exp_2_pos.

Lemma exp_2_incr : forall n m : nat, n <= m -> exp_2 n <= exp_2 m.
intros.
elim H; auto with arith.
intros.
simpl in |- *.
elim plus_n_O.
elim H1; auto with arith.
Qed.
Hint Resolve exp_2_incr.

Lemma exp_2_n_plus_m : forall n m : nat, exp_2 (n + m) = exp_2 n * exp_2 m.
simple induction n.
intro.
simpl in |- *.
elim plus_n_O; reflexivity.
intros.
simpl in |- *.
elim plus_n_O.
apply sym_equal.
elim plus_n_O.
rewrite H.
elim mult_plus_distr_r; reflexivity.
Qed.
Hint Resolve exp_2_n_plus_m.

(************************************************************************)
(********************************** Base n ******************************)
(************************************************************************)

Lemma exp_n_incr : forall n m p : nat, n <= m -> exp_n n p <= exp_n m p.
simple induction p; auto with arith.
intros.
simpl in |- *.
apply le_mult_csts; auto with arith.
Qed.
Hint Resolve exp_n_incr.

Lemma exp_n_neutre : forall n : nat, exp_n 1 n = 1.
simple induction n; auto with arith.
intros.
simpl in |- *.
rewrite H; auto with arith.
Qed.
Hint Resolve exp_n_neutre.

Lemma exp_n_plus_mult :
 forall n m p : nat, exp_n n (m + p) = exp_n n m * exp_n n p.
simple induction p.
simpl in |- *.
elim plus_n_O.
elim mult_n_Sm.
auto with arith.
elim mult_n_O; auto with arith.

clear p; intros p H_rec.
elim plus_n_Sm.
simpl in |- *.
rewrite H_rec.
elim mult_assoc_reverse.
rewrite (mult_comm n (exp_n n m)).
auto with arith.
Qed.
Hint Resolve exp_n_plus_mult.

Lemma exp_n_permut :
 forall n m p : nat, exp_n n (m * p) = exp_n (exp_n n p) m.
simple induction m; auto with arith.
intros.
simpl in |- *.
elim H.
elim exp_n_plus_mult; auto with arith.
Qed.
Hint Resolve exp_n_permut.

Lemma exp_n_plus_p1 : forall n p : nat, exp_n n (p + 1) = n * exp_n n p.
simple induction p; simpl in |- *.
auto with arith.
intros no H; rewrite H; auto with arith.
Qed.
Hint Resolve exp_n_plus_p1.

Lemma exp_n_pos : forall n p : nat, 0 < n -> 0 < exp_n n p.
simple induction p.
simpl in |- *; auto with arith.
intros.
simpl in |- *.
apply lt_nm_mult; auto with arith.
Qed.
Hint Resolve exp_n_pos.

Lemma le_exp_n_mult : forall n p : nat, 0 < n -> exp_n n p <= n * exp_n n p.
auto with arith.
Qed.
Hint Resolve le_exp_n_mult.

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


Inductive natural : Type :=  Zero : natural| Succ : natural -> natural.

Inductive lst : Type := Cons : natural -> lst -> lst |  Nil : lst.

Inductive tree : Type := Node : natural -> tree -> tree -> tree |  Leaf : tree.

Inductive Pair : Type := mkpair : natural -> natural -> Pair
with Zlst : Type := zcons : Pair -> Zlst -> Zlst |  znil : Zlst.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) : natural
           := match plus_arg0, plus_arg1 with
              | Zero, n => n
              | Succ n, m => Succ (plus n m)
              end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) : natural
           := match mult_arg0, mult_arg1 with
              | Zero, n => Zero
              | Succ n, m => plus (mult n m) m
              end.

Fixpoint fac (fac_arg0 : natural) : natural
           := match fac_arg0 with
              | Zero => Succ Zero
              | Succ n => mult (fac n) n
              end.

Fixpoint qfac (qfac_arg0 : natural) (qfac_arg1 : natural) : natural
           := match qfac_arg0, qfac_arg1 with
              | Zero, n => n
              | Succ n, m => qfac n (mult m n)
              end.

Lemma plus_succ : forall (x y : natural), plus x (Succ y) = Succ (plus x y).
Proof.
intros.
induction x.
- reflexivity.
- simpl. rewrite IHx. reflexivity.
Qed.

Lemma plus_assoc : forall (x y z : natural), plus (plus x y) z = plus x (plus y z).
Proof.
intros.
induction x.
- reflexivity.
- simpl. rewrite IHx. reflexivity.
Qed.

Lemma plus_zero : forall (x : natural), plus x Zero = x.
Proof.
intros.
induction x.
- reflexivity.
- simpl. rewrite IHx. reflexivity.
Qed.

Lemma plus_commut : forall (x y : natural), plus x y = plus y x.
Proof.
intros.
induction x.
- rewrite plus_zero. reflexivity.
- simpl. rewrite plus_succ. rewrite IHx. reflexivity.
Qed.

Lemma mult_zero : forall (x : natural), mult x Zero = Zero.
Proof.
intros.
induction x.
- reflexivity.
- simpl. rewrite IHx. reflexivity.
Qed.

Lemma mult_succ : forall (x y : natural), plus (mult x y) x = mult x (Succ y).
Proof.
intros.
induction x.
- reflexivity.
- simpl. rewrite plus_succ. rewrite plus_assoc. rewrite (plus_commut y x). rewrite <- plus_assoc. rewrite IHx. rewrite plus_succ. reflexivity.
Qed.

Lemma mult_commut : forall (x y : natural), mult x y = mult y x.
Proof.
intros.
induction x.
- rewrite mult_zero. reflexivity.
- simpl. rewrite IHx. rewrite mult_succ. reflexivity.
Qed.

Lemma distrib : forall (x y z : natural), mult (plus x y) z = plus (mult x z) (mult y z).
Proof.
intros.
induction x.
- reflexivity.
- simpl. rewrite IHx. rewrite plus_assoc. rewrite (plus_commut (mult y z) z). rewrite <- plus_assoc. reflexivity.
Qed.

Lemma mult_assoc : forall (x y z : natural), mult (mult x y) z = mult x (mult y z).
Proof.
intros.
induction x.
- reflexivity.
- simpl. rewrite distrib. rewrite IHx. reflexivity.
Qed.

Theorem theorem0 : forall (x : natural) (y : natural), eq (mult (fac x) y) (qfac x y).
Proof.
induction x.
- reflexivity.
- intros. simpl. rewrite <- IHx. rewrite mult_assoc. rewrite (mult_commut x y). reflexivity.
Qed.


(* Software Foundations *)
(* Exercice 3 stars, bag_more_functions *)

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

Notation "[]" := nil.
Notation " x :: l" := (cons x l).
Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..).

Definition bag := natlist.

Fixpoint count (v: nat) (s: bag) : nat :=
match s with
|nil     => O
|h :: t => if (Nat.eqb v h) then S(count v t) else count v t
end.

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

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

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

Fixpoint remove_all (v:nat) (s:bag) : bag :=
match s with
|nil => nil
|h::t => if (Nat.eqb 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. Proof. reflexivity. Qed.
Example test_remove_all2: count 5 (remove_all 5 [2;1;4;1]) = 0. Proof. reflexivity. Qed.
Example test_remove_all3: count 4 (remove_all 5 [2;1;4;5;1;4]) = 2. Proof. reflexivity. Qed.
Example test_remove_all4: count 5 (remove_all 5 [2;1;5;4;5;1;4;5;1;4]) = 0. Proof. reflexivity. Qed.

Fixpoint subset (s1:bag) (s2:bag) : bool :=
match s1 with
|nil  => true
|h::t => if (member h s2) then subset t (remove_one h s2) else false
end.
Example test_subset1 : subset [1;2] [2;1;4;1] = true. Proof. reflexivity. Qed.
Example test_subset2 : subset [1;2;2] [2;1;4;1] = false. Proof. reflexivity. Qed.


(*******************************************************************************

Title: Arith.v
Authors: Jeremy Avigad, Chris Kapulkin, Peter LeFanu Lumsdaine
Date: 1 March 2013

This file contains some basic arithmetic, ported from Coq’s standard Peano.v.
(We cannot import that, since it is not all homotopy-compatible.)

Once the HoTT library contains its own development of arithmetic, this
file will be obsolete.

*******************************************************************************)

Require Import HoTT.
Require Import Auxiliary.

Open Scope nat_scope.

Hint Resolve (ap S): v62.
Hint Resolve (ap (A:=nat)): core.

(** Booleans *)
Inductive Bool : Type :=
  | true : Bool
  | false : Bool.

Definition is_true (b:Bool) : Type
  := match b with true => Unit | false => Empty end.

Definition true_neq_false : true = false -> Empty
  := (fun H => transport is_true H tt).

(** The predecessor function *)

Definition pred (n:nat) : nat := match n with
                                 | O => n
                                 | S u => u
                                 end.
Hint Resolve (ap pred): v62.

Theorem pred_Sn : forall n:nat, n = pred (S n).
Proof.
  simpl; reflexivity.
Defined.

(** Injectivity of successor *)

(* eq_add_S in Peano.v *)
Definition S_inj : forall {n m:nat}, S n = S m -> n = m.
Proof.
  intros n m p. apply (ap pred p).
Defined.
Hint Resolve S_inj: core.

Definition is_succ (n:nat) : Type :=
  match n with
  | O => Empty
  | S p => Unit
  end.

Definition is_zero (n:nat) : Type :=
  match n with
  | O => Unit
  | S p => Empty
  end.

(** Zero is not the successor of a number *)

Theorem O_neq_S {n:nat} : 0 = S n -> Empty.
Proof.
  intros p. apply (transport is_zero p). constructor.
Defined.

Hint Resolve O_neq_S: core.

Theorem n_Sn : forall n:nat, n = S n -> Empty.
Proof.
  induction n; auto; apply O_neq_S.
Defined.

Hint Resolve n_Sn: core.

(** Addition *)

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

where "n + m" := (plus n m) : nat_scope.

Hint Resolve (ap10 o (ap plus)): v62.

Lemma plus_n_O : forall n:nat, n = n + 0.
Proof.
  induction n; simpl; auto.
Defined.
Hint Resolve plus_n_O: core.

Lemma plus_O_n : forall n:nat, 0 + n = n.
Proof.
  auto.
Defined.

Lemma plus_n_Sm : forall n m:nat, S (n + m) = n + S m.
Proof.
  intros n m; induction n; simpl; auto.
Defined.
Hint Resolve plus_n_Sm: core.

Lemma plus_Sn_m : forall n m:nat, S n + m = S (n + m).
Proof.
  auto.
Defined.

(** Standard associated names *)

Notation plus_0_r_reverse := plus_n_O (compat "8.2").
Notation plus_succ_r_reverse := plus_n_Sm (compat "8.2").

(** Multiplication *)

Fixpoint mult (n m:nat) : nat :=
  match n with
  | O => 0
  | S p => m + p * m
  end

where "n * m" := (mult n m) : nat_scope.

Hint Resolve (ap10 o (ap mult)): core.

Lemma mult_n_O : forall n:nat, 0 = n * 0.
Proof.
  induction n; simpl; auto.
Defined.
Hint Resolve mult_n_O: core.

Lemma mult_n_Sm : forall n m:nat, n * m + n = n * S m.
Proof.
  intros; induction n as [| p H]; simpl; auto.
  destruct H; rewrite <- plus_n_Sm; apply (ap S).
  pattern m at 1 3; elim m; simpl; auto.
Defined.
Hint Resolve mult_n_Sm: core.

(** Standard associated names *)

Notation mult_0_r_reverse := mult_n_O (compat "8.2").
Notation mult_succ_r_reverse := mult_n_Sm (compat "8.2").

(** Truncated subtraction: [m-n] is [0] if [n>=m] *)

Fixpoint minus (n m:nat) : nat :=
  match n, m with
  | O, _ => n
  | S k, O => n
  | S k, S l => k - l
  end

where "n - m" := (minus n m) : nat_scope.

(** Definition of the usual orders, the basic properties of [le] and [lt]
    can be found in files Le and Lt *)

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

where "n <= m" := (le n m) : nat_scope.

Hint Constructors le: core.
(*i equivalent to : "Hints Resolve le_n le_S : core." i*)

Definition lt (n m:nat) := S n <= m.
Hint Unfold lt: core.

Infix "<" := lt : nat_scope.

Definition ge (n m:nat) := m <= n.
Hint Unfold ge: core.

Infix ">=" := ge : nat_scope.

Definition gt (n m:nat) := m < n.
Hint Unfold gt: core.

Infix ">" := gt : nat_scope.

(* Awaiting definition of /\:
Notation "x <= y <= z" := (x <= y /\ y <= z) : nat_scope.
Notation "x <= y < z" := (x <= y /\ y < z) : nat_scope.
Notation "x < y < z" := (x < y /\ y < z) : nat_scope.
Notation "x < y <= z" := (x < y /\ y <= z) : nat_scope.
*)

Theorem S_preserves_le : forall n m, n <= m -> (S n) <= (S m).
Proof.
intros n m H; induction H; auto.
Defined.

(** le_pred in Peano.v *)
Theorem pred_preserves_le : forall n m, n <= m -> pred n <= pred m.
Proof.
induction 1; auto. destruct m; simpl; auto.
Defined.

(** le_S_n *)
Theorem S_reflects_le : forall {n m}, S n <= S m -> n <= m.
Proof.
intros n m. exact (pred_preserves_le (S n) (S m)).
Defined.

Theorem O_le_n n : O <= n.
Proof.
  induction n; auto.
Defined.

Theorem n_le_O : forall {n:nat}, n <= 0 -> n = 0.
Proof.
  assert (gen : forall n m, 0 = m -> n <= m -> n = m).
  intros n. induction n as [ | n' IH].
    intros; auto.
    intros m p H. destruct H as [ | m' H'].
      destruct (O_neq_S p).
      destruct (O_neq_S p).
  intros; apply gen; auto.
Defined.

Definition le_refl := le_n.

Theorem le_trans : forall {i j k:nat}, i <= j -> j <= k -> i <= k.
Proof.
  intros i j k Hij Hjk. induction Hjk as [ | k' Hjk' IH].
    auto.
    auto.
Defined.

(** Case analysis *)

Theorem nat_case :
 forall (n:nat) (P:nat -> Type), P 0 -> (forall m:nat, P (S m)) -> P n.
Proof.
  induction n; auto.
Defined.

(** Principle of double induction *)

Theorem nat_double_ind :
 forall R:nat -> nat -> Type,
   (forall n:nat, R 0 n) ->
   (forall n:nat, R (S n) 0) ->
   (forall n m:nat, R n m -> R (S n) (S m)) -> forall n m:nat, R n m.
Proof.
  induction n; auto.
  destruct m; auto.
Defined.

(** max and min omitted *)

(** [n]th iteration of the function [f] *)

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

Lemma nat_iter_succ_r n {A} (f:A->A) (x:A) :
  nat_iter (S n) f x = nat_iter n f (f x).
Proof.
  induction n; intros; simpl; rewrite <- ?IHn; trivial.
Defined.

Theorem nat_iter_plus :
  forall (n m:nat) {A} (f:A -> A) (x:A),
    nat_iter (n + m) f x = nat_iter n f (nat_iter m f x).
Proof.
  induction n; intros; simpl; rewrite ?IHn; trivial.
Defined.

(** Preservation of invariants : if [f : A->A] preserves the invariant [Inv],
    then the iterates of [f] also preserve it. *)

Theorem nat_iter_invariant :
  forall (n:nat) {A} (f:A -> A) (P : A -> Type),
    (forall x, P x -> P (f x)) ->
    forall x, P x -> P (nat_iter n f x).
Proof.
  induction n; simpl; trivial.
  intros A f P Hf x Hx. apply Hf, IHn; trivial.
Defined.

(** Decidability

Note: there are several possible approaches to decidability.
Here we mix a few of them. *)

Fixpoint booleq_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' => booleq_nat n' m'
      end
    end.

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

Definition le_bool__le {n m : nat} : (le_bool n m = true) -> n <= m.
Proof.
  revert m. induction n as [ | n' IHn]; intros [ | m']; simpl.
    auto.
    intros; apply O_le_n.
    intros H. destruct (true_neq_false (H^)).
    intros H. apply S_preserves_le. apply IHn. assumption.
Defined.

Definition le__le_bool {n m : nat} : n <= m -> (le_bool n m = true).
Proof.
  revert m. induction n as [ | n' IHn]; intros [ | m']; simpl.
    auto.
    auto.
    intros H. destruct (O_neq_S (n_le_O H)^).
    intros H. apply IHn. apply S_reflects_le. assumption.
Defined.

Definition Decide (A:Type) := (A + (A -> Empty))%type.

Definition eq_dec_nat : forall (n m:nat), Decide (n = m).
Proof.
  intros n; induction n as [ | n' IHn];
    intros m; destruct m as [ | m'].
    (* O = O *) apply inl. auto.
    (* O = S m' *) apply inr. apply O_neq_S.
    (* S n' = 0 *) apply inr.
      intros H. exact (O_neq_S H^).
    (* Sn' = S m' *)
      destruct (IHn m') as [ yes | no ].
      (* yes *) apply inl; auto.
      (* now *) apply inr.
        intros H. apply no. apply (S_inj H).
Defined.

Definition le_dec : forall (n m:nat), Decide (n <= m).
Proof.
  intros n; induction n as [ | n' IHn];
    intros m; destruct m as [ | m'].
    (* O = O *) apply inl. auto.
    (* O = S m' *) apply inl. apply O_le_n.
    (* S n' = 0 *) apply inr.
      intros H. exact (O_neq_S (n_le_O H)^).
    (* Sn' = S m' *)
      destruct (IHn m') as [ yes | no ].
      (* yes *) apply inl; apply S_preserves_le; auto.
      (* now *) apply inr.
        intros H. apply no. apply (S_reflects_le H).
Defined.

Theorem nat_is_hset : IsHSet nat.
Proof.
  apply hset_decpaths. unfold DecidablePaths. apply eq_dec_nat.
Defined.

Definition nat_HSet : HSet
  := Build_HSet nat nat_is_hset.

(* TODO (mid): re-enable this as soon as the Canonical Structures issue is fixed.
Canonical Structure nat_HSet.
*)

(*
Local Variables:
coq-prog-name: "hoqtop"
End:
*)


Inductive Nat : Type := Zero : Nat  | Succ : Nat -> Nat.

Fixpoint plus (n m:Nat) : Nat :=
    match n with
    | Zero      => m
    | Succ n    => Succ (plus n m)
    end.

Inductive Vec : Type -> Nat -> Type :=
| VNil : forall (a:Type), Vec a Zero
| VCons: forall (a:Type) (n:Nat) (x:a) (xs:Vec a n), Vec a (Succ n)
.

Fixpoint replicate (a:Type) (n:Nat) (x:a) : Vec a n :=
    match n with
    | Zero      => VNil a
    | Succ n    => VCons a n x (replicate a n x)
    end.

Compute replicate.
(*
    = fix Ffix (x : Type) (x0 : Nat) (x1 : x) {struct x0} : Vec x x0 :=
      match x0 as c return (Vec x c) with
      | Zero => VNil x
      | Succ x2 => VCons x x2 x1 (Ffix x x2 x1)
      end
      : forall (a : Type) (n : Nat), a -> Vec a n
*)

Arguments replicate {a} _ _.

Definition replicate' :=
    fix f (a:Type) (n:Nat) (x:a) : Vec a n :=
        match n as n' return (Vec a n') with
        | Zero      => VNil a
        | Succ p    => VCons a p x (f a p x)
        end.

Check replicate'.

Arguments replicate' {a} _ _.

Lemma replicate_correct : forall (a:Type) (n:Nat) (x:a),
   replicate n x = replicate' n x.
Proof.
    intros a n x. induction n.
    - reflexivity.
    - simpl. rewrite IHn. reflexivity.
Qed.

Lemma Vec_Same : forall (a:Type) (n m:Nat), n = m -> Vec a n = Vec a m.
Proof. intros a n m H. rewrite H. reflexivity. Qed.

Definition cast (a b:Type) (p:a = b) (x:a) : b :=
    match p in _ = T return T with
    | eq_refl    => x
    end.

Arguments cast {a} {b} _ _.

Definition toVec (a:Type) (n m:Nat) (p:n = m) (x:Vec a n) : Vec a m :=
    cast (Vec_Same a n m p) x.

Lemma plus_0_n : forall (n:Nat), n = plus Zero n.
Proof. intros n. induction n; reflexivity. Qed.

Arguments VNil {a}.
Arguments VCons {a} {n} _ _.


From LF Require Export Basics.
From LF Require Export Induction.
From LF Require Export Lists.

(*1 балл*)
Theorem mult_comm : forall n m : nat,
  n * m = m * n.
Proof.
  intros. induction n as [|m'].
  - simpl. rewrite mult_0_r. reflexivity.
  - simpl. rewrite IHm'.
    assert (H: forall x y, x + x * y = x * S y).
    { intros. induction x as [|x'].
      - reflexivity.
      - simpl. rewrite <- IHx'. rewrite plus_swap. reflexivity. }
    rewrite H. reflexivity.
Qed.

(*2 балл*)
Theorem mult_plus_distr_l : forall n m p : nat,
 p* (n + m)  = (p* n) + (p * m).
Proof.
intros n m p.
induction p.
reflexivity.
simpl.
rewrite IHp.
rewrite<- plus_assoc.
pattern (m + (p * n + p * m)).
rewrite plus_assoc.
pattern (m + p * n).
rewrite plus_comm.
rewrite plus_assoc.
rewrite plus_assoc.
rewrite plus_assoc.
reflexivity.
Qed.

(*3 балла*)
Lemma plusCrazy : forall m n p q : nat,
                  plus m (plus n (plus p q)) = plus n (plus (plus q m) p).
Proof.
  intros m n p q.
  + rewrite plus_swap. replace (m+(p+q)) with (q+m+p). {reflexivity. } rewrite plus_comm.
    replace (q+m) with (m+q). { rewrite plus_swap. reflexivity. } rewrite plus_comm.
    reflexivity.
Qed.

(*4 балла*)
Theorem mult_S_1 : forall n m : nat,   m = S n -> mult m (plus 1 n) = mult m m.
Proof.
  intros n m.
  intros H.
  rewrite -> plus_1_l.
  rewrite <- H.
  reflexivity. Qed.

(*Дополнительно*)
Inductive natlist : Type :=
  | nil
  | cons (n : nat) (l : natlist).

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

Fixpoint nonzeros (l:natlist) : natlist :=
  match l with
    | [] => []
    | h :: t =>
        match h with
          | 0 => nonzeros t
          | nz => nz :: (nonzeros t)
        end
  end.

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


From mathcomp Require Import ssreflect.

Require Import Coq.Arith.Peano_dec.

Check eq_nat_dec.

Eval compute in eq_nat_dec 1 1.
Eval compute in eq_nat_dec 1 0.

About eq_nat_dec.
Check eq_nat_dec.
Check eq_nat_dec 1 1.

Definition test_func (n m:nat) : nat :=
  match eq_nat_dec n m with
  | left _ => 1
  | right _ => 0
  end.

Eval compute in test_func 1 1. (* result 1 *)
Eval compute in test_func 1 0. (* result 0 *)


Require Import Coq.ZArith.ZArith.
Require Import Coq.micromega.Lia.
Require Import Crypto.Util.ZUtil.Hints.Core.
Require Import Crypto.Util.ZUtil.Tactics.LtbToLt.
Local Open Scope Z_scope.

Module Z.
  Lemma positive_is_nonzero : forall x, x > 0 -> x <> 0.
  Proof. intros; lia. Qed.
#[global]
  Hint Resolve positive_is_nonzero : zarith.

  Lemma le_lt_trans n m p : n <= m -> m < p -> n < p.
  Proof. lia. Qed.

  Lemma le_fold_right_max : forall low l x, (forall y, List.In y l -> low <= y) ->
    List.In x l -> x <= List.fold_right Z.max low l.
  Proof.
    induction l as [|a l IHl]; intros ? lower_bound In_list; [cbv [List.In] in *; intuition | ].
    simpl.
    destruct (List.in_inv In_list); subst.
    + apply Z.le_max_l.
    + etransitivity.
      - apply IHl; auto; intuition auto with datatypes.
      - apply Z.le_max_r.
  Qed.

  Lemma le_fold_right_max_initial : forall low l, low <= List.fold_right Z.max low l.
  Proof.
    induction l as [|a l IHl]; intros; try reflexivity.
    etransitivity; [ apply IHl | apply Z.le_max_r ].
  Qed.

  Lemma add_compare_mono_r: forall n m p, (n + p ?= m + p) = (n ?= m).
  Proof.
    intros n m p.
    rewrite <-!(Z.add_comm p).
    apply Z.add_compare_mono_l.
  Qed.

  Lemma leb_add_same x y : (x <=? y + x) = (0 <=? y).
  Proof. destruct (x <=? y + x) eqn:?, (0 <=? y) eqn:?; Z.ltb_to_lt; try reflexivity; lia. Qed.
#[global]
  Hint Rewrite leb_add_same : zsimplify.

  Lemma ltb_add_same x y : (x <? y + x) = (0 <? y).
  Proof. destruct (x <? y + x) eqn:?, (0 <? y) eqn:?; Z.ltb_to_lt; try reflexivity; lia. Qed.
#[global]
  Hint Rewrite ltb_add_same : zsimplify.

  Lemma geb_add_same x y : (x >=? y + x) = (0 >=? y).
  Proof. destruct (x >=? y + x) eqn:?, (0 >=? y) eqn:?; Z.ltb_to_lt; try reflexivity; lia. Qed.
#[global]
  Hint Rewrite geb_add_same : zsimplify.

  Lemma gtb_add_same x y : (x >? y + x) = (0 >? y).
  Proof. destruct (x >? y + x) eqn:?, (0 >? y) eqn:?; Z.ltb_to_lt; try reflexivity; lia. Qed.
#[global]
  Hint Rewrite gtb_add_same : zsimplify.

  Lemma sub_pos_bound a b X : 0 <= a < X -> 0 <= b < X -> -X < a - b < X.
  Proof. lia. Qed.

  Lemma le_sub_1_iff x y : x <= y - 1 <-> x < y.
  Proof. lia. Qed.

  Lemma le_add_1_iff x y : x + 1 <= y <-> x < y.
  Proof. lia. Qed.
End Z.