(** The top-level command [Check <exp>] tells you the type of the given exp. *)
Check True.
Check False.

(** [True] and [False] are propositions or something classified by the type [Prop].
   They are not to be confused with [true] and [false] which are booleans.
   The distinction is roughly, that [true] and [false] are objects, whereas
   [True] and [False] are types.  What are the elements of the type [True]?
   They are all the *proofs* that allow us to conclude "True".  In contrast,
   the object [true] doesn't really name a collection of things.

   So what are some of the elements or proof objects in the special
   type [True]?
*)
Print True.
(** Aha!  We see that one element is the constructor [I].  It's a way
   (in fact, the best way) to build a proof whose conclusion is the
   trivial theorem [True].
*)
Check I.
(** But [I] is not the only way to build an object of type [True].  Another
   example is:
*)
Check (fun x => x) I.
(** And we will see many more examples of ways to construct a proof of [True].
   However, it will turn out that if a (closed) expression e : True, then

   So in general, an element of [Prop], such as [True], is the
   name of a theorem, and at the same type, names a collection of terms that
   correspond to proofs of that theorem.

   What about [False]?
*)
Print False.
(** [False] is a funny inductive definition which has no
   constructors.  So, there's no easy way to build an object that
   has type [False].  A very, very deep result about Coq is that in
   fact, there is no closed term E such that E : False.  In other
   words, there's no way construct a proof of False, and that's a
   very good thing.

   Now remember last time, that I said that all functions in Coq
   must terminate?  Well, one reason why is that if we had diverging
   computations, a la OCaml, then we would have a way to build
   a term E of type False.  For instance, in OCaml, we can define:

   letrec loop () : t = loop ()

   for any type [t] that we like, includng an empty type.  This
   means that in OCaml, every type has an element and thus we
   can't use OCaml types to represents propositions such as [False].
   Another way to say this is that in OCaml, the "logic" of the
   language is "inconsistent."

   There are other good reasons why Coq functions are required
   to terminate.  One is that the type-checker must sometimes
   normalize (i.e., simplify) expressions to see if they are equal.
   If that normalization process could diverge, then so could
   type-checking.

   Later on, we'll see how it's possible to *model* computations
   that might diverge.
*)

(** The top-level command [Locate "..."] helps to locate a symbol that's defined
   with notation.  In this case, we are searching for the notation for logical
   "and". *)
Locate "_ /\ _".
Check and.

(** The top-level command [Print <id>] prints the definition of a
   given identifier.  Note that [and] is just an inductive definition
   with one constructor, [conj] which takes two [Prop]s as arguments,
   and produces a [Prop] as a result. *)
Print and.
Locate "_ * _".
Check prod.
Print prod.
Locate "_ \/ _".
Check or.

(** Logical [or] is also just an inductive definition, but this
   time it has two constructors, one for the left and one for
   the right. *)
Print or.

(** I'm going to start a new module named [M1] so that I don't
   pollute the top-level namespace.  We end the module by writing
   [end M1.] -- see below. *)
Module M1.

  (** Now we can start building some interesting proofs. *)
  Definition proof_of_true_and_true : True /\ True :=
    conj I I.

  Definition proof_of_true_or_false : True \/ False :=
    or_introl I.

  Definition proof_of_false_or_true : False \/ True :=
    or_intror I.

  (** What about implication?  This can be represented as a
     function.  That is, we can think of "A implies B" as
     a function which takes evidence of A and constructs
     evidence of B from it.  In fact, we will use the notation
     "->" to denote both functions and implication.  And we
     will use [fun x => ...] to build a function, or evidence
ccer     of an implication.  For instance: *)
  Definition t0 {A:Prop} : A -> True :=
    fun (H:A) => I.

  Definition t1 {A B:Prop} : A -> B -> A /\ B :=
    fun (HA:A) (HB:B) => conj HA HB.

  (** This example shows taking apart some evidence.  In this
     case, we are given evidence of [A /\ B] and we need to
     construct from it evidence of [A].  So we use a pattern
     match to tear apart the proof of [A /\ B], since we know
     that it must've been built from [conj HA HB] where [HA]
     is a proof of [A] and [HB] is a proof of [B].  *)
  Definition t2 {A B:Prop} : A /\ B -> A :=
    fun (H : A /\ B) =>
      match H with
        | conj H1 H2 => H1
      end.

  Definition t3 {A B:Prop} : A /\ B -> B :=
    fun (H: A /\ B) =>
      match H with
        | conj H1 H2 => H2
      end.

  Definition t4 {A B C:Prop} :
    (A -> C) /\ (B -> C) -> (A \/ B) -> C :=
    fun (H1:(A->C)/\(B->C)) (H2:A\/B) =>
      match H1 with
        | conj H3 H4 => match H2 with
                          | or_introl H5 => H3 H5
                          | or_intror H6 => H4 H6
                        end
      end.

  Definition t5 {A:Prop} : False -> A :=
    fun (H:False) =>
      match H with
      end.

  Definition t6 {A B C D:Prop} (H1:A -> B \/ C) :
    (B -> D) -> (C -> D) -> (A -> D) :=
    fun H2 H3 H4 =>
      let H5 := H1 H4 in
      t4 (conj H2 H3) H5.

  Locate "~ _".
  Check not.
  Print not.

  (** Negation [~A] is just an abbreviation for [A -> False]. *)
  Definition t7 {A B C : Prop} :
    ~ (A /\ B) -> A -> B -> C :=
    fun (H1 : (A/\B) -> False) (H2:A) (H3:B) =>
      match H1 (conj H2 H3) with
      end.

  Definition t7' : forall {A B C:Prop},
    ~ (A /\ B) -> A -> B -> C.
    Abort.

  Definition t7'' :
    forall {A B C : Prop} (H1:~ (A /\ B)) (H2 : A) (H3 : B), C.
    Abort.

  Inductive animal : Type :=
  | Cow | Duck | Pig | Platypus.

  (** In addition to the built-in [Prop]s, we can define new
     propositional constructions.  For example, below I define
     a proposition called [has_bill] which is a predicate on
     [animal]s.
   *)
  Definition has_bill (a:animal) : Prop :=
    match a with
      | Duck => True
      | Platypus => True
      | _ => False
    end.

  (** Here's another predicate on animals... *)
  Definition live_birth (a:animal) : Prop :=
    match a with
      | Cow => True
      | Pig => True
      | _ => False
    end.

  (** Then we can use these definitions to construct a more
     interesting theorem.  Notice that here I'm universally
     quantifying over an animal, using [forall].  *)
  Definition darwin :
    forall a:animal, has_bill a -> ~ live_birth a :=
    fun (a:animal) =>
      match a return has_bill a -> ~live_birth a
      with
        | Duck => fun H1 H2 => H2
        | Platypus => fun H1 H2 => H2
        | Cow => fun H1 H2 => H1
        | Pig => fun H1 H2 => H1
      end.

  Definition moos (a:animal) : Prop :=
    match a with
      | Cow => True
      | _ => False
    end.

  Locate "exists".
  Check ex.
  Print ex.

  (** Notice that exists is not primitive and is in fact encoded using forall. Notice that the
      variable mentioned in forall is really a parameter to the [exists_intro] constructor, allowing
      us to construct a proof of an existential claim using _any_ witness.
      The [A] and [P] parameters to [ex_intro] are implicit. We can force ourselves to
      provide them explicitly by using [@ex_intro] instead. *)

  Definition darwin2 : exists a:animal, (moos a /\ live_birth a) :=
    ex_intro (fun a => moos a /\ live_birth a) Cow (conj I I).

  (** Sometimes, Coq can figure out what a missing argument is and
     we can omit it by putting in an underscore "_" as in the
     example below. *)
  Definition darwin3 : exists a:animal, (moos a /\ live_birth a) :=
    ex_intro _ Cow (conj I I).

End M1.

Module PSET1_EX1.

(**PROBLEM1:  *)

  Definition X1 {A B C D:Prop} : (B /\ (B -> C /\ D)) -> D :=
  fun (H1: B /\ (B -> C /\ D))  =>
    match H1 with
      | conj (H2) (H3) =>
        let H4 :(C /\ D ):= (H3 H2) in
        match H4 with
          | conj H5 H6 => H6
        end
  end.
Print and.

(**PROBLEM2:  *)
  Definition X2 {A B C:Prop} : ~(A \/ B) -> B -> C :=
  fun (H1: A \/ B -> False) (H2:B) =>
    let H3: (A\/B) := (or_intror H2) in
    match H1 H3 with
    end.

(** PROBLEM3: *)
  Definition X3 {A B C:Prop} :  A /\ (B \/ C) -> (A /\ B) \/ (A /\ C) :=
  fun (H1 : A /\ (B \/ C)) =>
    match H1 with
      | conj H2 H3 => match H3:(B \/ C) with
                      |or_introl b => or_introl (conj H2 b)
                      |or_intror H5 => or_intror (conj H2 H5)
                      end
    end.

(** PROBLEM 4: To solve the following, you'll need to figure
out what the definition of "<->" is and how to work with it... *)
Locate "_ <-> _".
Check iff.
Print iff.

Definition X4 {A:Prop} : A <-> A :=
    conj (fun (a:A) => a ) (fun (a:A) => a).

Print and.
(** PROBLEM4: *)
Definition X5 {A B:Prop} : (A <-> B) <-> (B <-> A):=
  conj
   (fun H1 =>
    match H1 with
      | conj H2 H3 => conj H3 H2
    end)

   (fun H1 =>
    match H1 with
      | conj H2 H3 => conj H3 H2
    end)
.

Print iff.
(** PROBLEM 5: *)

Definition assoc {A B  C: Prop} (f1:A -> B) (f2:B -> C) (a:A) : C :=
    f2 (f1 a).

Definition X6 {A B C:Prop} : (A <-> B) -> (B <-> C) -> (A <-> C):=
  fun (H1:((A -> B) /\ (B -> A))) (H2: ((B-> C) /\ (C -> B))) =>
    match H1, H2 with
    | conj h11 h12 , conj h21 h22 => conj (assoc h11 h21) (assoc h22 h12)
    end.

Lemma uncurrying: forall (A B C :Prop),
((A/\B)->C) <-> (A->B->C).
Abort.

(** PROBLEM think-about-it *)
Definition not_pos {A}: A \/ ~A.
Admitted.

(** Definition haltingProblem (n:N) : (n th TM halts) \/
(n th TM never halts). *)

(** Building proof objects by hand can be extremely difficult.
   So instead, we're going to use some *tactics* to construct
   these objects.  Some useful tactics include the following:

   auto   -- solves trivial goals such as "True" and "3 = 3" or
             "x = x".

   intro  -- given a goal A -> B, introduces A as an assumption,
             leaving B as the result.  It's the same as writing
             [refine (fun H:A => _)].

   intros -- same as above but introduces a bunch of assumptions.
             For instance, if our goal is A -> B -> C -> D, then
             intros will introduce hypotheses H1:A, H2:B, and
             H3:C and leave us with the goal D.  You can also
             give explicit names for the hypotheses as in
             intros H1 H2 H3.

   split --  if the goal is A /\ B, breaks this into two sub-goals,
             first A and then B.

   destruct -- if we have a hypothesis [H : A /\ B] then we can
               break it into two hypotheses [H1 : A] and [H2 : B].
               using [destruct].

   simpl --  simplifies the goal by reducing expressions as much
             as possible.  For instance, if our goal is
             [1 + 3 = 2 + 3], then calling [simpl] will reduce
             the goal to [4 = 4] which we can solve by auto.

   left --   given the goal A \/ B, reduces the goal to proving
             just A.

   right --  given goal A \/ B, reduces the goal to proving B.

   apply H -- apply the hypothesis H to solve the current goal.
              This only works when H names a hypothesis that
              matches the given goal.

   See also http://adam.chlipala.net/itp/tactic-reference.html
   for a better list.
*)

(** Re-doing the examples above using tactics. *)
Module M2.

  (** Notice that I didn't use ":=" but terminated the definition
     with a period.  This drops you into tactic mode. *)
  Definition proof_of_true_and_true : True /\ True.
  Proof.  (** not necessary, but a good visual indicator. *)
    (** prove True /\ True *)
    split. (** leaves us with two goals *)
      (** First goal:  True *)
      auto.
      (** Second goal: True *)
      auto.
   Qed.  (** claim that we've solved all goals. *)

  (** We can print out the proof object that the tactics
     constructed for us... *)
  Print proof_of_true_and_true.

  (** Instead of using the keyword [Definition] we can also
     use the keywords [Lemma] and [Theorem].  *)
  Lemma proof_of_true_and_true' : True /\ True.
  Proof.
    auto.  (** actually, auto will knock this off. *)
  Qed.

  Theorem prof_of_true_and_true'' : True /\ True.
  Proof.
    (** we can use previously existing proofs. *)
    apply proof_of_true_and_true'.
  Qed.

  Definition proof_of_true_or_false : True \/ False.
    Abort.

  Definition proof_of_false_or_true : False \/ True.
    Abort.

  Lemma t0 {A:Prop} : A -> True.
  Proof.
    intro.
    auto.
  Qed.

  Lemma t1 {A B:Prop} : A -> B -> A /\ B.
  Proof.
    auto.
  Qed.

  Lemma t2 {A B:Prop} : A /\ B -> A.
  Proof.
    tauto.
  Qed.

  Lemma t3 {A B:Prop} : A /\ B -> B.
  Proof.
    (** It's generally a bad idea to let Coq pick the names for you.
       We can usually give names that we want. *)
    intro H.
    destruct H as [H1 H2].
    apply H2.
  Qed.

  Lemma t3' {A B:Prop} : A /\ B -> B.
  Proof.
    (** We can also do some destruction as we introduce things. *)
    intros [H1 H2].
    apply H2.
  Qed.

  Lemma t3'' {A B:Prop} : A /\ B -> B.
  Proof.
    (** There are some fancier decision procedures that can knock this
       sort of thing off, such as [firstorder].  For now, try to avoid
       using these so that you can understand the basic tactics --- you
       will need them. *)
    firstorder.
  Qed.

  Definition t4 {A B C:Prop} :
    (A -> C) /\ (B -> C) -> (A \/ B) -> C.
  Proof.
    firstorder.
  Qed.

  Definition t5 {A:Prop} : False -> A.
  Proof.
    firstorder.
  Qed.

  Definition t6 {A B C D:Prop} :
    (A -> B \/ C) -> (B -> D) -> (C -> D) -> (A -> D).
  Proof.
    firstorder.
  Qed.

  Locate "~ _".
  Check not.
  Print not.

  (** Negation [~A] is just an abbreviation for [A -> False]. *)
  Definition t7 {A B C : Prop} :
    ~ (A /\ B) -> A -> B -> C.
  Proof.
    firstorder.
  Qed.

  (** We can write the type of [t7] using [forall], which shows that
      arrow types are really just a special case of a more powerful
      dependent type construct in which the type on the right-hand
      side of the arrow can mention the name of the argument. *)
  Definition t7' : forall {A B C:Prop},
    ~ (A /\ B) -> A -> B -> C.
  Proof.
    firstorder.
  Qed.

  Definition t7'' :
    forall {A B C : Prop} (H1:~ (A /\ B)) (H2 : A) (H3 : B), C.
  Proof.
    firstorder.
  Qed.

  Inductive animal : Type :=
  | Cow | Duck | Pig | Platypus.

  Definition has_bill (a:animal) : Prop :=
    match a with
      | Duck => True
      | Platypus => True
      | _ => False
    end.

  Definition live_birth (a:animal) : Prop :=
    match a with
      | Cow => True
      | Pig => True
      | _ => False
    end.

  (** Then we can use these definitions to construct a more
     interesting theorem.  Notice that here I'm universally
     quantifying over an animal, using [forall].  *)
  Definition darwin :
    forall a:animal, has_bill a -> ~ live_birth a.
  Proof.
    intro a.
    (** We need to tear apart [a] -- this is done with destruct,
        just as we tear apart a conjunection [A /\ B].  In
        general, destruct does our pattern match for us and
        leaves us with the corresponding goals. *)
    destruct a.
      (** [a = Cow] *)
      (** It's not immediately clear that this is trivial, unless
         we [simpl]ify the goal. *)
      simpl.
      auto.
      (** [a = Duck] *)
      (** auto will do the simplification for you if it needs to. *)
      auto.
      (** [a = Pig] *)
      auto.
      (** [a = Platypus] *)
      auto.
  Qed.

  (** We can string together tactics using a semicolon.  When you
     write [t1 ; t2], then [t1] is run on the current goal G.  This
     produces new sub-goals G1, G2, ..., Gn.  Then [t2] is run on
     each of these sub-goals.  So we can simplify the proof above
     as follows: *)
  Definition darwin' :
    forall a:animal, has_bill a -> ~ live_birth a.
  Proof.
    destruct a ;   (** automatically introduces a *)
    auto.
  Qed.

  Definition moos (a:animal) : Prop :=
    match a with
      | Cow => True
      | _ => False
    end.

  Locate "exists".
  Check ex.
  Print ex.

  Definition darwin2 : exists a:animal, (moos a /\ live_birth a).
  Proof.
    (** The [exists] tactic is the way to solve an existential goal.
       You have to give the witness. *)
    exists Cow.
    simpl.
    auto.
  Qed.

End M2.

Module PSET1_EX2.

(** Now remove the tauto tactics and redo these problems using only
the following tactics:
intros, apply, destruct, unfold, split, contradiction, left, right
(Hopefully we haven't left off any that you may need.
In general, don't use things like firstorder or tauto that
automatically solves goals. We want you to perform the basic steps
to see what is going on.)
*)

Lemma X1 {A B C D:Prop} :
    (B /\ (B -> C /\ D)) -> D.
  Proof.
    intros H1.
    destruct H1.
    apply H0 in H.
    destruct H.
    apply H1.
  Qed.

Check not.
Print not.
Lemma X2 {A B C:Prop} :
    ~(A \/ B) -> B -> C.
  Proof.
  intros.
  unfold not in H.
  apply (@or_intror A ) in H0.
  apply H in H0.
  destruct H0.
  Qed.

  Lemma X3 {A B C:Prop} : A /\ (B \/ C) -> (A /\ B) \/ (A /\ C).
  Proof.
    intros.
    destruct H.
    destruct H0.
     Show Proof.
   - left.
     Show Proof.
     split.
     Show Proof.
     + apply H.
     + apply H0.
   - right.
     Show Proof.
     split.
     Show Proof.
     apply H.
     apply H0.
  Qed.

Lemma X4 {A:Prop} : A <-> A.
  Proof.
    intros.
    Show Proof.
    split.
    - intros a. apply a.
    - intros a. apply a.
  Qed.

Lemma X5 {A B:Prop} :(A <-> B) <-> (B <-> A).
  Proof.
    intros.
    Show Proof.
    unfold iff.
    split.
    - intros H. destruct H.
      split.
       + apply H0.
       + apply H.
       Show Proof.
    - split.
      destruct H.
      + apply H0.
      + apply H.
  Qed.

Lemma assoc {A B C: Prop}: (A -> B) /\ (B-> C) -> (A -> C).
  Proof.
    intros.
    destruct H.
    apply H1.
    apply H.
    assumption.
  Qed.

Lemma X6 {A B C:Prop} : (A <-> B) -> (B <-> C) -> (A <-> C).
  Proof.
    intros.
    unfold iff.
    unfold iff in H.
    unfold iff in H0.
    destruct H.
    destruct H0.
    split.
    - Show Proof.
      apply @assoc with (B:=B).
      Show Proof.
      split;assumption.
    - apply @assoc with (B:=B).
      split; assumption.
  Qed.


Inductive day : Type :=
| monday : day
| tuesday : day
| wednesday : day
| thursday : day
| friday : day
| saturday : day
| sunday : day .

Definition next_weekday (d : day) : day :=
  match d with
    | monday => tuesday
    | tuesday => wednesday
    | wednesday => thursday
    | thursday => friday
    | friday => monday
    | saturday => monday
    | sunday => monday
  end.

Eval compute in next_weekday friday.
Eval compute in next_weekday (next_weekday saturday).

Example test_next_weekday :
  next_weekday (next_weekday saturday) = tuesday.
Proof.
  simpl. reflexivity.
Qed.

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

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

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

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

Definition xorb (a b : bool) : bool :=
  match a, b with
    | true, true => false
    | false, false => false
    |_, _ => true
  end.

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

Definition nandb (a b : bool) : bool :=
  match a, b with
    | true, true => false
    | _, _ => true
  end.

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

Definition andb3 (a b c : bool) : bool :=
  andb (andb a b) c.

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

Check true.
Check (negb true).
Check negb.

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

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

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

Check (S (S (S (S O)))).
Eval compute in (minustwo 4).

Check S.
Check pred.
Check minustwo.

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

Example test_oddb: oddb 10 = false.
Proof. auto. Qed.
Example test_evenb: evenb 10 = true.
Proof. reflexivity. Qed.

Module Playground2.
  Fixpoint plus (a b : nat) : nat :=
    match a with
      | O => b
      | S n' => S (plus n' b)
    end.

  Eval compute in (plus (S (S (S O))) (S (S O))).

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

  Example test_mult1: (mult 3 3) = 9.
  Proof. simpl. reflexivity. Qed.

  Fixpoint minus (n m : nat) : nat :=
    match n, m with
      | O, _ => O
      | _, O => n
      | S n', S m' => minus n' m'
    end.
  Eval compute in minus 7 8.
End Playground2.

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

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

Example fact_five: fact 4 = 24.
Proof. simpl. reflexivity. Qed.

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

Check ((0 + 1) + 1).

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

Eval compute in beq_nat 4 5.
Eval compute in beq_nat 5 4.
Eval compute in beq_nat 5 5.

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

Eval compute in ble_nat 4 5.
Eval compute in ble_nat 5 4.
Eval compute in ble_nat 5 5.

Example test_ble_nat1: (ble_nat 2 2) = true.
Proof. reflexivity. Qed.
Example test_ble_nat2: (ble_nat 2 4) = true.
Proof. reflexivity. Qed.
Example test_ble_nat3: (ble_nat 4 2) = false.
Proof. reflexivity. Qed.

Definition blt_nat (n m : nat) : bool :=
  andb (negb (beq_nat n m)) (ble_nat n m).

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

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

Theorem plus_n_O : forall n : nat, n + O = n.
Proof.
  intros n.
  induction n.

  reflexivity.

  simpl.
  rewrite IHn.
  reflexivity.
Qed.

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

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

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

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

Theorem mult_0_plus : forall n m : nat,
                        (0 + n) × m = n × m.
Proof.
  intros n m. eapply plus_O_n.
Qed.

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

Theorem plus_1_neq_0_firsttry : forall n : nat,
  beq_nat (n + 1) 0 = false.
Proof.
  intros n.
  simpl.
Abort.

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

  reflexivity.

  simpl. reflexivity.
Qed.

Theorem negb_involutive : forall b : bool,
  negb (negb b) = b.
Proof.
  intros b.
  induction b.

  reflexivity.

  reflexivity.
Qed.

Theorem zero_nbeq_plus_1 : forall n : nat,
  beq_nat 0 (n + 1) = false.
Proof.
  intros n.
  induction n.

  reflexivity.

  reflexivity.
Qed.

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

Lemma andb_true: forall b, andb true b = b.
Proof.
  induction b.

  reflexivity.

  reflexivity.
Qed.

Lemma orb_true : forall b, orb true b = true.
Proof.
   induction b.

   reflexivity.

   reflexivity.
Qed.

Theorem andb_eq_orb :
  forall (b c : bool),
  (andb b c = orb b c) ->
  b = c.
Proof.
   intros b c.
   induction b.

   simpl.
   intros H.
   rewrite H; reflexivity.

   simpl. intros H. assumption.
Qed.

Inductive bin :=
| Ob : bin (* zero *)
| Db : bin -> bin (* double *)
| Tb : bin -> bin. (*double + one *)

(*
zero = Ob
one = Tb Ob
two = Db Tb Ob
three = Tb Tb Ob
four = Db Db Tb Ob
five = Tb Db Tb Ob
six = Db three
seven = Tb three
 *)

Fixpoint incr (b : bin) : bin :=
  match b with
    | Ob => Tb Ob
    | Db n' => Tb n'
    | Tb n' => Db (incr n')
  end.

Eval compute in incr (Db (Tb Ob)).

Fixpoint bin_to_nat (b : bin) : nat :=
  match b with
    | Ob => O
    | Db n' => 2 * bin_to_nat n'
    | Tb n' => S (2 * bin_to_nat n')
  end.

Eval compute in bin_to_nat (Tb (Tb Ob)).


Module Logic.
Set Warnings "-notation-overridden,-parsing,-deprecated-hint-without-locality".
From LF Require Export Tactics.

Check (3 = 3) : Prop.
Check (forall n m : nat, n + m = m + n) : Prop.
Check (2 = 2) : Prop.
Check (3 = 2) : Prop.
Check (forall n : nat, n = 2) : Prop.

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

Definition plus_claim : Prop := 2 + 2 = 4.
Check plus_claim : Prop.

Theorem plus_claim_is_true : plus_claim.
Proof. reflexivity. Qed.

Definition is_three (n : nat) : Prop := n = 3.
Check is_three : nat -> Prop.

Definition injective {A B} (f : A -> B) := forall x y : A, (f x = f y) -> (x = y).
Lemma succ_inj : injective S.
Proof.
  intros n m H.
  assert (G : forall n, pred (S n) = n). {
    reflexivity.
  }
  rewrite <- (G n).
  rewrite -> H.
  simpl.
  reflexivity.
(*
  injection H as H1.
  apply H1.
*)
Qed.

(* eq is (=) *)
Check @eq : forall A : Type, A -> A -> Prop.

Example and_example : 3 + 4 = 7 /\ 2 * 2 = 4.
Proof.
  split.
  - (* 3 + 4 = 7 *) reflexivity.
  - (* 2 * 2 = 4 *) reflexivity.
Qed.

Lemma and_intro : forall A B : Prop, A -> B -> A /\ B.
Proof.
  intros A B HA HB.
  split.
  - apply HA.
  - apply HB.
Qed.

Example and_example' : 3 + 4 = 7 /\ 2 * 2 = 4.
Proof.
  apply and_intro.
  - (* 3 + 4 = 7 *) reflexivity.
  - (* 2 + 2 = 4 *) reflexivity.
Qed.

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

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

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

Lemma and_example2 :
  forall n m : nat, n = 0 /\ m = 0 -> n + m = 0.
Proof.
  intros n m H.
  destruct H as [Hn Hm].
  rewrite Hn. rewrite Hm.
  reflexivity.
Qed.

Lemma and_example2' :
  forall n m : nat, n = 0 /\ m = 0 -> n + m = 0.
Proof.
  intros n m [Hn Hm].
  rewrite Hn. rewrite Hm.
  reflexivity.
Qed.

Lemma and_example3 :
  forall n m : nat, n + m = 0 -> n * m = 0.
Proof.
  intros n m H.
  apply and_exercise in H.
  destruct H as [Hn Hm].
  rewrite Hn. reflexivity.
Qed.

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

Lemma proj2 : forall P Q : Prop, P /\ Q -> Q.
Proof.
  intros P Q [HP HQ].
  apply HQ.
Qed.

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

Theorem and_assoc : forall P Q R : Prop, P /\ (Q /\ R) -> (P /\ Q) /\ R.
Proof.
  intros P Q R [HP [HQ HR]].
  split.
  - split.
    + apply HP.
    + apply HQ.
  - apply HR.
Qed.

(* /\ notation for : *)
Check and : Prop -> Prop -> Prop.

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

Lemma factor_is_O':
  forall n m : nat, n = 0 \/ m = 0 -> n * m = 0.
Proof.
  intros n m H.
  destruct H as [ Hn | Hm ] eqn:E.
  - (* Here, n = 0 *)
    rewrite Hn. reflexivity.
  - (* Here, m = 0 *)
    rewrite Hm. rewrite <- mult_n_O.
    reflexivity.
Qed.

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

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

Lemma zero_or_succ :
  forall n : nat, n = 0 \/ n = S (pred n).
Proof.
  intros [|n'].
  - left. reflexivity.
  - right. reflexivity.
Qed.

Module MyNot.
Definition not (P: Prop) := P -> False.
Notation "~ x" := (not x) : type_scope.
Check not : Prop -> Prop.

Theorem tst: not (2 + 2 = 5).
Proof.
  intros H.
  simpl in H.
  discriminate H.
Qed.

Theorem tst': not (2 + 2 = 4).
Proof.
  intros H.
  simpl in H.
  (* discriminate H. *)
Abort.

End MyNot.

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

Fact not_implies_our_not : forall (P:Prop),
  ~ P -> (forall (Q:Prop), P -> Q).
Proof.
  intros P notP Q p.
  destruct (notP p) eqn:E.
Qed.

Theorem zero_not_one : 0 <> 1.
Proof.
  unfold not.
  intros contra.
  discriminate contra.
Qed.

Theorem not_False : ~ False.
Proof.
  unfold not. intros H. destruct H. Qed.

Theorem contradiction_implies_anything : forall P Q : Prop,
  (P /\ ~P) -> Q.
Proof.
  intros P Q [HP HNA].
  unfold not in HNA.
  apply HNA in HP.
  destruct HP.
Qed.

Theorem double_neg : forall P : Prop,
  P -> ~~P.
Proof.
  intros P H.
  unfold not.
  intros G.
  apply G.
  apply H.
Qed.

Theorem contrapositive : forall (P Q : Prop),
  (P -> Q) -> (~Q -> ~P).
Proof.
  intros P Q H.
  unfold not.
  intros negQ p.
  apply H in p.
  apply negQ in p.
  apply p.
Qed.

Theorem not_both_true_and_false : forall P : Prop,
  ~ (P /\ ~P).
Proof.
  intros P.
  unfold not.
  intros [ HP HnP ].
  apply HnP in HP.
  destruct HP.
Qed.

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

Theorem not_true_is_false' : forall b : bool,
  b <> true -> b = false.
Proof.
  intros [] H. (* note implicit destruct b here *)
  - (* b = true *)
    unfold not in H.
    exfalso. (* <=== replaces target with False *)
    apply H. reflexivity.
  - (* b = false *) reflexivity.
Qed.

(* Search (?X : True). *)

Lemma True_is_true : True.
Proof. apply I. Qed.

Definition disc_fn (n: nat) : Prop :=
  match n with
  | O => True
  | S _ => False
  end.

Theorem disc : forall n, ~ (O = S n).
Proof.
  intros n H1.
  assert (H2 : disc_fn O). { simpl. apply I. }
  rewrite H1 in H2. simpl in H2. apply H2.
Qed.

Module MyIff.
Definition iff (P Q : Prop) := (P -> Q) /\ (Q -> P).
Notation "P <-> Q" := (iff P Q)
                      (at level 95, no associativity)
                      : type_scope.
End MyIff.

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

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

Theorem or_distributes_over_and : forall P Q R : Prop,
  P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
Proof.
  intros P Q R.
  split.
  - intros H.
    destruct H as [ HP | [HQ HR] ] eqn:E.
    + split.
      * left. apply HP.
      * left. apply HP.
    + split.
      * right. apply HQ.
      * right. apply HR.
  - intros [HPQ HPR].
    destruct HPQ as [HP | HQ] eqn:E.
    + left. apply HP.
    + destruct HPR as [HP' | HR] eqn:E1.
      * left. apply HP'.
      * right.
        split.
        apply HQ.
        apply HR.
Qed.

From Coq Require Import Setoids.Setoid.

Theorem mult_is_O : forall n m, n * m = 0 -> n = 0 \/ m = 0.
Proof.
  intros [| n' ] [| m' ] H.
  - left. reflexivity.
  - left. reflexivity.
  - right. reflexivity.
  - simpl in H.
    discriminate H.
Qed.

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

Theorem or_assoc :
  forall P Q R : Prop, P \/ (Q \/ R) <-> (P \/ Q) \/ R.
Proof.
  intros P Q R. split.
  - intros [H | [H | H]].
    + left. left. apply H.
    + left. right. apply H.
    + right. apply H.
  - intros [[H | H] | H].
    + left. apply H.
    + right. left. apply H.
    + right. right. apply H.
Qed.

Lemma mul_eq_0_ternary :
  forall n m p, n * m * p = 0 <-> n = 0 \/ m = 0 \/ p = 0.
Proof.
  intros n m p.
  rewrite mul_eq_0. rewrite mul_eq_0. rewrite or_assoc.
  reflexivity.
Qed.

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

Fixpoint even (n : nat) : bool :=
  match n with
  | O => true
  | S O => false
  | S (S m) => even m
  end.
Definition odd (n : nat) := negb (even n).

(* Definition div2 (n: nat) (p: even n = true) : nat. *)

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

Lemma four_is_even : Even 4.
Proof.
  unfold Even.
  exists 2.
  reflexivity.
Qed.

Theorem tst_exists: forall (n: nat), even n = true -> exists (m : nat), double m = n.
Proof.
  intros n H.

Abort.

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

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

Theorem dist_exists_or : forall (X : Type) (P Q : X -> Prop),
  (exists x, P x \/ Q x) <-> (exists x, P x) \/ (exists x, Q x).
Proof.
  intros X P Q.
  split.
  - intros [x [Px | Qx]].
    + left. exists x. apply Px.
    + right. exists x. apply Qx.
  - intros [ [x Px] | [x Qx] ].
    + exists x. left. apply Px.
    + exists x. right. apply Qx.
Qed.

Fixpoint In {A : Type} (x : A) (l : list A) : Prop :=
  match l with
  | nil      => False
  | cons h t => h = x \/ In x t
  end.

Definition tst_list : list nat := cons 1 (cons 2 (cons 3 (cons 4 (cons 5 nil)))).

Example In_example_1 : @In nat 4 tst_list.
Proof.
  simpl. right. right. right. left. reflexivity.
Qed.

Example In_example_2 :
  forall n, In n (cons 2 (cons 4 nil)) ->
  exists n', n = 2 * n'.
Proof.
  intros n H.
  simpl in H.
  destruct H as [H'2 | [H'4 | H'n]].
  - exists 1.
    rewrite <- H'2.
    reflexivity.
  - exists 2.
    rewrite <- H'4.
    reflexivity.
  - destruct H'n.
Qed.

Fixpoint map {X Y : Type} (f : X -> Y) (l : list X) : list Y :=
  match l with
  | nil      => nil
  | cons h t => cons (f h) (map f t)
  end.

Theorem In_map :
  forall (A B : Type) (f : A -> B) (l : list A) (x : A),
         In x l ->
         In (f x) (map f l).
Proof.
  intros A B f l x H.
  induction l as [| hl tl Hl ].
  - simpl in H.
    simpl.
    apply H.
  - simpl in H.
    simpl.
    destruct H as [H'l | H'r].
    + rewrite -> H'l.
      left.
      reflexivity.
    + right.
      apply Hl.
      apply H'r.
Qed.

Theorem In_map_iff :
  forall (A B : Type) (f : A -> B) (l : list A) (y : B),
         In y (map f l) <->
         exists x, f x = y /\ In x l.
Proof.
  intros A B f l y.
  split.
  - induction l as [| hl tl Hl ].
    + simpl.
      intros F.
      destruct F.
    + simpl.
      intros [H'l | H'r].
      * exists hl.
        split.
        -- apply H'l.
        -- left. reflexivity.
      * destruct (Hl H'r) as [x [Hfxy HInxtl]].
        -- exists x.
           split.
            ++ apply Hfxy.
            ++ right. apply HInxtl.
  - intros [x [ Hfxy Hinxl ]].
    induction l as [| hl tl Hl ].
    + simpl.
      simpl in Hinxl.
      apply Hinxl.
    + simpl.
      simpl in Hinxl.
      destruct Hinxl as [Hhlx | Hinxtl].
      * rewrite <- Hhlx in Hfxy.
        left. apply Hfxy.
      * right.
        apply Hl.
        apply Hinxtl.
Qed.

Theorem In_app_iff : forall A l l' (a : A),
  In a (l ++ l') <-> In a l \/ In a l'.
Proof.
  intros A l.
  induction l as [| hl tl Hl ].
  - simpl.
    split.
    + intros H. right. apply H.
    + intros [FH | H].
      * destruct FH.
      * apply H.
  - simpl.
    intros l' a.
    rewrite -> (Hl l' a).
    apply or_assoc.
Qed.

Fixpoint All {T : Type} (P : T -> Prop) (l : list T) : Prop :=
  match l with
  | nil      => True
  | cons h t => P h /\ All P t
  end.

Theorem All_In : forall (T : Type) (P : T -> Prop) (l : list T),
    (forall x, In x l -> P x) <-> All P l.
Proof.
  intros T P l.
  induction l as [| hl tl Hl ].
  - simpl.
    split.
    + intros H. apply I.
    + intros H x FH. exfalso. apply FH.
  - simpl.
    split.
    + intros H.
      split.
      * apply H. left. reflexivity.
      * apply Hl. intros x H'. apply (H x). right. apply H'.
    + intros [Hphl Hallptl] x H.
      destruct Hl as [Hll Hlr].
      destruct H as [Hl | Hr].
      * rewrite <- Hl. apply Hphl.
      * apply Hlr. apply Hallptl. apply Hr.
Qed.

Definition combine_odd_even (Podd Peven : nat -> Prop) : nat -> Prop :=
  fun n => if odd n then Podd n else Peven n.

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

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

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

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

Lemma in_not_nil_42 :
  forall l : list nat, In 42 l -> l <> nil.
Proof.
  intros l H.
  Fail apply in_not_nil.
Abort.

Lemma in_not_nil_42_take2 :
  forall (l : list nat), In 42 l -> l <> nil.
Proof.
  intros l H.
  apply in_not_nil with (x := 42).
  apply H.
Qed.

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

Example lemma_application_ex :
  forall {n : nat} {ns : list nat},
    In n (map (fun m => m * 0) ns) ->
    n = 0.
Proof.
  intros n ns H.
  destruct (proj1 _ _ (In_map_iff _ _ _ _ _) H)
           as [m [Hm _]].
  rewrite mul_0_r in Hm. rewrite <- Hm. reflexivity.
Qed.

Example function_equality_ex1 :
  (fun x => 3 + x) = (fun x => (pred 4) + x).
Proof. reflexivity. Qed.

Example function_equality_ex2 :
  (fun x => plus x 1) = (fun x => plus 1 x).
Proof.
   (* Stuck *)
Abort.

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

Example function_equality_ex2 :
  (fun x => plus x 1) = (fun x => plus 1 x).
Proof.
  apply functional_extensionality.
  intros x.
  apply add_comm.
Qed.

Print Assumptions function_equality_ex2.

Fixpoint rev {X} (l : list X) : list X :=
  match l with
  | nil      => nil
  | cons h t => rev t ++ cons h nil
  end.

Fixpoint rev_append {X} (l1 l2 : list X) : list X :=
  match l1 with
  | nil      => l2
  | cons h t => rev_append t (cons h l2)
  end.
Definition tr_rev {X} (l : list X) : list X := rev_append l nil.

Lemma list_plus_nil : forall (X : Type) (l : list X),
  (l ++ nil = l)%list.
Proof.
  intros X l.
  induction l as [| hl tl Hl ].
  - reflexivity.
  - simpl.
    rewrite -> Hl.
    reflexivity.
Qed.

Lemma rev_append_t : forall (X : Type) (l1 l2 l3 : list X),
  ((@rev_append X l1 l2) ++ l3 = @rev_append X l1 (l2 ++ l3))%list.
Proof.
  intros X l1 l2 l3.
  induction l3 as [| hl tl Hl ].
  - simpl.
    rewrite -> list_plus_nil.
    rewrite -> list_plus_nil.
    reflexivity.
  - simpl.
Abort.

Lemma rev_append_t1 : forall (X : Type) (l1 l2 : list X),
  (rev_append l1 nil ++ l2 = rev_append l1 l2)%list.
Proof.
  intros X l1 l2.
  induction l1 as [| hl tl Hl ].
  - reflexivity.
  - Abort.

Lemma app_assoc : forall (X : Type) (l1 l2 l3 : list X),
  ((l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3))%list.
Proof.
  induction l1 as [| hl tl Hl ].
  - reflexivity.
  - simpl.
    intros l2 l3.
    rewrite <- Hl.
    reflexivity.
Qed.

Lemma rev_append_t3 : forall (X : Type) (l1 l2 : list X),
  (rev_append l1 l2 = (rev_append l1 nil) ++ l2)%list.
Proof.
  intros X l1.
  induction l1 as [| hl tl Hl ].
  - reflexivity.
  - simpl.
    intros l2.
    rewrite -> Hl.
    rewrite -> (Hl (cons hl nil)).
    rewrite -> app_assoc.
    simpl.
    reflexivity.
Qed.

Theorem tr_rev_correct : forall X, @tr_rev X = @rev X.
Proof.
  intros X.
  apply functional_extensionality.
  intros l.
  induction l as [| hl tl Hl ].
  - unfold tr_rev.
    reflexivity.
  - unfold tr_rev.
    simpl.
    rewrite <- Hl.
    unfold tr_rev.
    rewrite -> rev_append_t3.
    reflexivity.
Qed.

Example even_42_bool : even 42 = true.
Proof. reflexivity. Qed.

Example even_42_prop : Even 42.
Proof. unfold Even. exists 21. reflexivity. Qed.

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

Lemma even_S : forall n, even (S n) = negb (even n).
Proof.
  intros n.
  induction n as [| n' Hn ].
  - reflexivity.
  - rewrite -> Hn.
    simpl.
    destruct (even n').
    + reflexivity.
    + reflexivity.
Qed.

Lemma even_double_conv : forall n, exists k,
  n = if even n then double k else S (double k).
Proof.
  intros n.
  induction n as [| n' Hn ].
  - simpl.
    exists O.
    reflexivity.
  - rewrite -> even_S.
    destruct Hn as [k Hn'].
    destruct (even n').
    + simpl.
      exists k.
      rewrite -> Hn'.
      reflexivity.
    + simpl.
      rewrite -> Hn'.
      exists (S k).
      reflexivity.
Qed.

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

Theorem even_bool_prop : forall n,
  even n = true <-> Even n.
Proof.
  intros n.
  split.
  - intros H.
    unfold Even.
    destruct (even_double_conv n) as [k Hd].
    rewrite -> H in Hd.
    exists k.
    apply Hd.
  - unfold Even.
    intros [k H].
    rewrite -> H.
    apply even_double_true.
Qed.

Example even_1000 : Even 1000.
Proof. unfold Even. exists 500. reflexivity. Qed.

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

Example even_1000'' : Even 1000.
Proof. apply even_bool_prop. reflexivity. Qed.

Theorem andb_true_iff : forall (b1 b2 : bool),
  andb b1 b2 = true <-> b1 = true /\ b2 = true.
Proof.
  intros b1 b2.
  destruct b1 eqn:E1.
  - destruct b2 eqn:E2.
    + simpl.
      split.
      * intros H.
        split.
        -- reflexivity.
        -- reflexivity.
      * intros [H1 H2].
        reflexivity.
    + simpl.
      split.
      * intros H.
        split.
        -- reflexivity.
        -- apply H.
      * intros [H1 H2].
        apply H2.
  - simpl.
    split.
    + intros H.
      discriminate H.
    + intros [H1 H2].
      discriminate H1.
Qed.

Theorem orb_true_iff : forall (b1 b2 : bool),
  orb b1 b2 = true <-> b1 = true \/ b2 = true.
Proof.
  intros b1 b2.
  destruct b1 eqn:E.
  - simpl.
    split.
    + intros H. left. reflexivity.
    + intros H. reflexivity.
  - destruct b2.
    + simpl.
      split.
      * intros H. right. reflexivity.
      * intros H. reflexivity.
    + simpl.
      split.
      * intros H. discriminate H.
      * intros [H1|H2]. discriminate H1. discriminate H2.
Qed.

Fixpoint eqb (n m : nat) : bool :=
  match n, m with
  | O, O => true
  | S i, S j => eqb i j
  | _, _ => false
  end.
Fixpoint leb (n m : nat) : bool :=
  match n, m with
  | O, O => true
  | S i, S j => leb i j
  | O, S _ => true
  | _, _ => false
  end.
Notation "x <=? y" := (leb x y) (at level 70) : nat_scope.
Notation "x =? y" := (eqb x y) (at level 70) : nat_scope.

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

Theorem eqb_true : forall n m,
  n =? m = true -> n = m.
Proof.
  intros n.
  induction n as [| n' H].
  - intros m.
    destruct m as [| m'] eqn:E.
    + reflexivity.
    + simpl.
      intros G.
      discriminate G.
  - intros m.
    destruct m as [| m'] eqn:E.
    + simpl.
      intros G.
      discriminate G.
    + simpl.
      intros G.
      apply f_equal.
      apply H.
      apply G.
Qed.

Theorem eqb_neq : forall (x y : nat),
  x =? y = false <-> x <> y.
Proof.
  intros x y.
  split.
  - unfold not.
    intros H G.
    rewrite -> G in H.
    simpl in H.
    rewrite -> eqb_refl in H.
    discriminate H.
  - unfold not.
    intros H.
    destruct (x =? y) eqn:E.
    + destruct (H (eqb_true x y E)) eqn:G.
    + reflexivity.
Qed.

Fixpoint eqb_list {A : Type} (eqb : A -> A -> bool)
                  (l1 l2 : list A) : bool :=
  match l1, l2 with
  | nil, nil => true
  | (cons h1 t1), (cons h2 t2) => if eqb h1 h2 then eqb_list eqb t1 t2 else false
  | _, _ => false
  end.

Lemma eqb_list_refl : forall (A : Type) (eqb : A -> A -> bool) (l : list A),
  (forall a, eqb a a = true) ->
  eqb_list eqb l l = true.
Proof.
  intros A eqb l HEq.
  induction l as [| hl tl Hl ].
  - reflexivity.
  - simpl.
    rewrite -> HEq.
    apply Hl.
Qed.

Theorem eqb_list_true_iff :
  forall (A : Type) (eqb : A -> A -> bool),
    (forall a1 a2, eqb a1 a2 = true <-> a1 = a2) ->
    forall l1 l2, eqb_list eqb l1 l2 = true <-> l1 = l2.
Proof.
  intros A eqb H.
  split.
  - generalize dependent l2.
    induction l1 as [| hl tl Hl ].
    + simpl.
      destruct l2.
      * intros _. reflexivity.
      * intros F. discriminate F.
    + intros l2 Heqlist.
      simpl in Heqlist.
      destruct l2 as [|hl2 tl2 ] eqn:E.
      * discriminate Heqlist.
      * destruct (eqb hl hl2) eqn:Ehla.
        -- destruct (H hl hl2) as [H' _].
           destruct (H' Ehla).
           destruct (Hl tl2 Heqlist).
           reflexivity.
        -- discriminate Heqlist.
  - intros HLEq.
    rewrite -> HLEq.
    apply eqb_list_refl.
    intros a.
    destruct (H a a) as [_ H'].
    apply H'.
    reflexivity.
Qed.

Fixpoint forallb {X : Type} (test : X -> bool) (l : list X) : bool :=
  match l with
  | nil      => true
  | cons h t => andb (test h) (forallb test t)
  end.

Lemma andb_split : forall (a b : bool), andb a b = true -> a = true /\ b = true.
Proof.
  intros a b.
  destruct a eqn:EA.
  - destruct b eqn:EB.
    + simpl. intros H. split. reflexivity. reflexivity.
    + simpl. intros H. discriminate H.
  - simpl. intros H. discriminate H.
Qed.

Theorem forallb_true_iff : forall X test (l : list X),
  forallb test l = true <-> All (fun x => test x = true) l.
Proof.
  intros X test l.
  split.
  - intros H.
    induction l as [| hl tl Hl ].
    + reflexivity.
    + simpl. simpl in H.
      destruct (andb_split (test hl) (forallb test tl) H) as [H1 H2].
      split.
      * apply H1.
      * apply Hl. apply H2.
  - intros H.
    induction l as [| hl tl Hl ].
    + reflexivity.
    + simpl. simpl in H.
      destruct H as [H1 H2].
      rewrite -> (Hl H2).
      rewrite -> H1.
      reflexivity.
Qed.

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

(*
Theorem excluded_middle_irrefutable: forall (P:Prop),
  ~ ~ (P \/ ~ P).
Proof.
  unfold not. intros P H.

  assert (G: forall b, b = true \/ ~ (b = true)). {
    intros b.
    destruct b.
    - left. reflexivity.
    - right. unfold not. intros H'. discriminate H'.
  }

  destruct (H (G true)).

  apply H.
  apply G.
*)

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

Theorem not_exists_dist :
  excluded_middle ->
  forall (X : Type) (P : X -> Prop),
    ~(exists x, ~ P x) -> (forall x, P x).
Proof.
  intros ExclMid X P.
  intros H x.
  unfold not in H.
  destruct (ExclMid (P x)) as [HPx | HNPx].
  - apply HPx.
  - assert(E: (exists x : X, P x -> False)). {
      exists x.
      apply HNPx.
    }
    destruct (H E).
Qed.

Definition peirce := forall P Q: Prop, ((P -> Q) -> P) -> P.
Definition double_negation_elimination := forall P:Prop, ~~P -> P.
Definition de_morgan_not_and_not := forall P Q:Prop, ~(~P /\ ~Q) -> P \/ Q.
Definition implies_to_or := forall P Q:Prop, (P -> Q) -> (~P \/ Q).

(* Coq'Art book by Bertot and Casteran (p. 123). *)
(*
Theorem th1 : excluded_middle <-> peirce.
Theorem th2 : peirce <-> double_negation_elimination.
Theorem th3 : double_negation_elimination <-> de_morgan_not_and_not.
Theorem th4 : de_morgan_not_and_not <-> implies_to_or.
Theorem th5 : implies_to_or <-> excluded_middle.
*)
End Logic.


Require Export NArith.
Require Export ZArith.
Open Scope N_scope.

Definition pos_log2 (p:positive) : N :=
N.log2 (Npos p).

(** Write a function that given any positive number p, returns a pair
   of type (n, q) : N * positive such that p = 2^n * q

*)
Check 33.
Check (33%nat).

Check (S (S (S (S 0)))).

(* Open Scope nat_scope. *)
Unset Printing Notations.
Check 4.
Set Printing Notations.
Check (5*(5-4)*7).

(* Open Scope Z_scope.
Print Scope Z_scope.
Check (Z.opp (Z.mul 3 (Z.sub (-5)(-8)))).
Check (plus 3%nat).
Check (fun a b c : Z => (b*b-4*a*c)%Z).
Check (fun f x => Z.abs_nat (f x x)). *)
(* Check (fun x => x x). *)

Parameter max_int : N.
Definition min_int := 1-max_int.
Print min_int.

Section binomial_def.
Variables a b:Z.
Definition binomial z:Z := a*z + b.
Section trinomial_def.
Variable c : Z.
Definition trinomial z:Z := (binomial z)*z + c.
End trinomial_def.
End binomial_def.

Fixpoint decompose2 (p:positive) : N * positive :=
match p with xH => (0,xH)
           | xI q => (0, p)
           | xO q => let d := decompose2 q in (fst d + 1, snd d)
end.

Compute decompose2 (88%positive).
Compute decompose2 (1024%positive).

(** binary exponentiation *)

Definition sqr_pos (p:positive) := (p * p)%positive.

Fixpoint binary_pow_aux (x:N)(a:N)(p:positive) : N :=
 match p with xH => a * x
            | xO q  => binary_pow_aux (x * x) a q
            | xI q  => binary_pow_aux (x * x)  (a * x ) q

end.

Definition pow  (x:N) (n : N) :=
  match n with 0 => 1
             | Npos 1 => x
             | Npos p => binary_pow_aux x x (Pos.pred p)
 end.

Compute pow 2 5.
Compute pow 2 10.

(** Comparison with N.pow *)

Time Compute 1 ^ 55556666.

Time Compute pow 1 55556666.

Definition pow_test (x n:N) :=
  N.eqb (pow x n) (N.pow x n).

Compute pow_test 2  555.

Fixpoint exp2_pos  (p:positive) : positive :=
(match p with 1 => 2
           | p~0 => sqr_pos (exp2_pos p)
           | p~1 => (sqr_pos (exp2_pos p))~0
 end)%positive.

Definition exp2 (n:N) : positive :=
match n with N0 => xH
           | Npos p =>  (exp2_pos p)
end.

Compute exp2 10.

Compute exp2 7.

Compute pos_log2 63%positive.
Compute pos_log2 1023%positive.

Definition test_exp2 (p:positive) := N.eqb (Npos p)  (pos_log2 (exp2 (Npos p))).
Compute test_exp2 45%positive.


(* Intuitionistic logic is extended to classical logic
   by assuming a classical axiom. There are different
   possibilities for the choice of a classical axiom.
   In this practical work we show the logical equivalence
   of three different classical axioms. *)

(* The following are three classical axioms *)

Definition excluded_middle := forall A:Prop, A \/ ~A.
Definition peirce := forall A B:Prop, ((A -> B)-> A) -> A.
Definition double_negation := forall A:Prop, ~~A -> A.

(* To show that these are equivalent,
   we need to prove (at least) three implications.
   As an example, the implication
   excluded_middle implies peirce is given. *)

Lemma one : excluded_middle -> peirce.
Proof.
unfold excluded_middle.
unfold peirce.
unfold not.
intro EM.
intro A.
intro B.
elim (EM A).

intro x.
intro y.
assumption.

intro x.
intro y.
apply y.
intro z.
elimtype False.
apply x.
assumption.
Qed.

(* There is a new element in the syntax:
   a universal quantification over propositions.
   So in fact these formulas are second-order;
   we come back to that later in the course. *)

(* How to work with these universal quantifications ?
   With "intro" and "apply". Explanation by example:

   If the current goal is "forall A:Prop, A -> A",
   then by doing "intro A" the new goal is A -> A
   and a new hypothesis "A:Prop" appears.

   If the current goal is "C" and there is a hypothesis
   "x: forall A:Prop, B -> A"
   then by "apply x" the current goal is transformed into "B".
   The universally quantified A is instantiated by C.

   Now suppose that the current goal is "C" and
   there is a hypothesis "x: forall A B:Prop, B -> A".
   Then "apply x" does not work because from the
   current goal we can see how to instantiate A
   (namely with C) but not how to instantiate B.
   Therefore we should say "apply x with something."
   choosing something appropriately. *)

(* exercise; you need the "apply with". *)
Lemma two : peirce -> double_negation.
Proof.
unfold peirce.
unfold double_negation.
unfold not.
intro PE.
intro A.
intro.
apply PE with False.
intro.
elimtype False.
apply H.
assumption.

Qed.

(* exercise *)
Lemma three : double_negation -> excluded_middle.
Proof.
unfold double_negation.
unfold excluded_middle.
unfold not.
intro DN.
intro.
apply DN.
intro.
apply H.
right.
intro.
apply H.
left.
exact H0.

Qed.

(* exercise *)
Lemma four : excluded_middle -> double_negation.
Proof.
unfold excluded_middle.
unfold double_negation.
unfold not.
intro EM.
intro A.
intro x.
elim (EM A).
intro.
exact H.

intro.
elimtype False.
apply x.
exact H.

Qed.

(* exercise *)
Lemma everything_related :
  excluded_middle -> forall A B : Prop , (A -> B) \/ (B -> A).
Proof.
unfold excluded_middle.
unfold not.
intro EM.
intros A B.
elim EM with (A := B).
intro.
left.
intro.
assumption.
intro.
right.
intro.
elimtype False.
apply H.
assumption.
Qed.

Lemma de_morgan :
  excluded_middle -> forall A B : Prop , ~(~A/\~B) -> A\/B.
Proof.
unfold excluded_middle.
unfold not.
intro EM.
intro A.
intro B.
intro H.
elim EM with (A := A).
intro.
left.
assumption.
intro H0.
elim EM with (A := B).
intro.
right.
assumption.
intro H1.
elimtype False.
apply H.
split.
assumption.
assumption.
Qed.

(* exercise
   note that this lemma is true intuitionistically *)
Lemma about_implication : forall A B : Prop , (~A \/ B) -> (A -> B).
Proof.
intro A.
intro B.
unfold not.
intro.
intro.
elim H.
intro.
elimtype False.
apply H1.
assumption.
intro.
assumption.
Qed.

(* exercise
   for the converse of the previous lemma we need a classical axiom *)
Lemma classical_implication :
  excluded_middle -> forall A B : Prop , (A -> B) -> (~A \/ B).
Proof.
unfold excluded_middle.
unfold not.
intro EM.
intros A B.
intro x.
elim EM with (A:=B).
intro.
right.
assumption.
intro.

left.
elim EM with (A := B).
intros.
apply H.
assumption.
intros.
apply H0.
apply x.
assumption.

Qed.

(* exercise *)
Lemma about_classical_implication :
  excluded_middle -> forall A B : Prop , ~B \/ (A ->B).
Proof.
unfold excluded_middle.
unfold not.
intro EM.
intros A B.
elim EM with (A:=B).
right.
intro.
elim EM with (A:=A).
intro.
assumption.
intro.
assumption.
left.
assumption.

Qed.
(*
vim: filetype=coq
*)


Require Import Arith Lia Nat.
From Undecidability.Synthetic Require Import DecidabilityFacts.
From FOL.Tennenbaum Require Import SyntheticInType MoreDecidabilityFacts.
Notation dec_eq_nat := Nat.eq_dec.

Definition iffT (x y : Type) := prod (x->y) (y->x).

Lemma lt_rect f :
  (forall x, (forall y, y < x -> f y) -> f x) -> forall x, f x.
Proof.
  intros H x. apply H.
  induction x.
  - intros; lia.
  - intros y Hy. apply H.
    intros z Hz. apply IHx. lia.
Defined.

(** * Division with Rest *)

Definition Euclid d x :
  { q & { r &  x = q*d + r  /\  (0 < d -> r < d)  }}.
Proof.
  destruct d as [|d].
  exists 0, x. repeat split; lia.
  induction x as [|x IH].
  - exists 0, 0. repeat split; lia.
  - destruct IH as (q&r&[]).
    specialize (dec_eq_nat d r) as [].
    + exists (S q), 0. split; lia.
    + exists q, (S r). split; lia.
Defined.

(* Div y x gives the number of times y can be substracted from x *)
Definition Div y x := projT1 (Euclid y x).
(* Mod y x gives the remainder of x after division by y *)
Definition Mod y x := projT1 (projT2 (Euclid y x)).

Fact Factor y x :
  x = (Div y x)*y + Mod y x.
Proof.
  apply (projT2 (projT2 (Euclid _ _))).
Qed.

Fact Mod_bound y x :
  0 < y -> Mod y x < y.
Proof.
  apply (projT2 (projT2 (Euclid _ _))).
Qed.

Fact Mod_lt y x :
  0 < y <= x -> Mod y x < x.
Proof.
  intros [H ].
  apply (Mod_bound _ x) in H. lia.
Qed.

Lemma Div_lt y x :
  0 < y <= x -> 0 < Div y x.
Proof.
  intros [H1 H2].
  rewrite (Factor y x) in H2 at 1.
  specialize ((Mod_bound y x) H1) as H3.
  enough (Div y x <> 0) by lia.
  intros E. rewrite E in *; cbn in *.
  lia.
Qed.

(** Uniqueness *)

Section Uniqueness.
  Variable m : nat.

  Lemma Fac_unique a1 b1 a2 b2 : b1 < m -> b2 < m ->
    a1*m + b1 = a2*m + b2 -> a1 = a2 /\ b1 = b2.
  Proof.
    intros.
    destruct (Nat.lt_trichotomy a1 a2) as [ |[]]; nia.
  Qed.

  Theorem unique x a b : b < m ->
    x = a*m + b <-> Div m x = a /\ Mod m x = b.
  Proof.
    split.
    - rewrite (Factor m x) at 1. intros.
      specialize (Mod_bound m x) as ?.
      apply Fac_unique; lia.
    - intros [<- <-]. apply Factor.
  Qed.

  Corollary Fac_eq a b : b < m ->
      Div m (a*m + b) = a /\ Mod m (a*m + b) = b.
  Proof. intros. now apply (unique _). Qed.
End Uniqueness.

Lemma lt_nat_equiv x y :
  x < y <-> exists k, S x + k = y.
Proof.
  split.
  induction y in x |-*. lia.
  destruct x; intros. exists y; lia.
  destruct (IHy x) as [k <-]. lia.
  exists k; lia.
  intros []. lia.
Qed.

Lemma Mod_divides y x :
  iffT (Mod y x = 0) ({ k & x = k*y }).
Proof.
  split.
  - intros H. exists (Div y x). rewrite plus_n_O. rewrite <- H. apply Factor.
  - intros [k ->]. destruct y. cbn. lia.
    assert (0 < S y) as [? H]%(Fac_eq _ k) by lia. now rewrite <- plus_n_O in H.
Qed.

Lemma Mod_le x N :
  N > 0 -> Mod x N = 0 -> x <= N.
Proof.
  intros ? [k ?]%Mod_divides. assert (k > 0) by lia. nia.
Qed.

Fact Mod_id m x : x < m -> Mod m x = x.
Proof.
  intros H.
  apply (Fac_eq m 0 x H).
Qed.

(** Homomorphism property of the modulus. *)

Section Homomorphism.
  Variable m : nat.
  Local Notation "'M' x" := (Mod m x) (at level 10).
  Local Notation "'D' x" := (Div m x) (at level 10).

  Lemma Mod_plus_multiple d r :
    M (d*m + r) = M r.
  Proof.
    assert (m = 0 \/ 0 < m) as [->|] by lia; cbn. lia.
    eapply (Fac_unique m _ _ (d + D r)).
    all: try now apply Mod_bound.
    rewrite <-Factor.
    rewrite (Factor m r) at 1. lia.
  Qed.

  Theorem Mod_add_hom x y:
    M (x + y) = M (M x + M y).
  Proof.
    symmetry.
    rewrite <-(Mod_plus_multiple (D x + D y)).
    rewrite (Factor m x), (Factor m y) at 3.
    f_equal. lia.
  Qed.

  Lemma Mod_mult_hom_l x y :
    M (x * y) = M (M x * y).
  Proof.
    symmetry.
    erewrite <-(Mod_plus_multiple (D x * y)).
    rewrite (Factor m x) at 3.
    f_equal. lia.
  Qed.

  Theorem Mod_mult_hom x y:
    M (x * y) = M (M x * M y).
  Proof.
    symmetry.
    erewrite <-(Mod_plus_multiple (D x * D y * m + D x * M y + D y * M x )).
    rewrite (Factor m x), (Factor m y) at 5.
    f_equal. lia.
  Qed.

  Fact Mod0_is_0 : M 0 = 0.
  Proof. destruct m; reflexivity. Qed.

  Corollary ModMod_is_Mod x :
    M (M x) = M x.
  Proof.
    change (M x) with (0 + M x) at 1.
    now rewrite <-Mod0_is_0, <-Mod_add_hom.
  Qed.
End Homomorphism.

(** * Prime Numbers *)

Section PrimeDec.

  (** Irreducible Numbers *)
  Definition irred' p := p > 1 /\ forall n, Mod n p = 0 -> (n = 1) \/ (n = p).

  Lemma irred_bounded p : (p > 1 /\ forall n, n < p -> Mod n p = 0 -> (n = 1) \/ (n = p) ) <-> irred' p.
  Proof.
    split.
    - intros [? H]. split. assumption.
      intros. enough (n < p \/ n = p) as [ | ->].
      apply H. all : auto.
      enough (n <= p) by lia.
      apply Mod_le; lia.
    - unfold irred'. intuition.
  Qed.

  Definition irred p := p > 1 /\ forall n, n < p -> Mod n p = 0 -> n = 1.

  Goal forall p, irred p <-> irred' p.
  Proof.
    unfold irred, irred'.
    setoid_rewrite <-irred_bounded.
    intuition. destruct (H1 _ H H2).
    auto. lia.
  Qed.

  (** It is decidable whether a number is irreducible. *)
  Lemma Dec_sigT_irred :
    Dec_sigT (irred).
  Proof.
    intros n. unfold irred. apply Dec.and_dec. apply lt_dec.
    apply dec_lt_bounded_forall.
    intros x. apply impl_dec; apply dec_eq_nat.
  Defined.

  Lemma dec_help_1 P Q : dec P -> dec Q -> ~(P /\ Q) -> ~P \/ ~Q.
  Proof.
    intros H1 H2 H3.
    destruct H1, H2; tauto.
  Qed.

  Lemma dec_help_2 P Q : dec P -> dec Q -> ~(P -> Q) -> P /\ ~Q.
  Proof.
    intros H1 H2 H3.
    destruct H1, H2; tauto.
  Qed.

  Lemma irred1 N :
    irred N + (N > 1 -> {x & x < N /\ Mod x N = 0 /\ x <> 1}).
  Proof.
    destruct (Dec_sigT_irred N) as [|H]; auto.
    right. intros HN. apply Witnessing_nat.
    intros x. repeat apply and_dec; try apply not_dec; try eapply dec_eq_nat. apply lt_dec.
    unfold irred in *.
    apply dec_help_1 in H.
    - destruct H. tauto.
      apply neg_lt_bounded_forall in H.
      destruct H as [n []].
      exists n. split. tauto.
      apply dec_help_2 in H0; eauto; try eapply dec_eq_nat. intros x.
      apply impl_dec; apply dec_eq_nat.
    - apply lt_dec.
    - apply dec_lt_bounded_forall.
      intros n. apply impl_dec; eapply dec_eq_nat.
  Qed.

  Lemma dec_irred_factor N :
    irred N + (N > 1 -> {x & {y & 1 < x < N  /\ x*y = N }} ).
  Proof.
    destruct (irred1 N) as [| H]; auto.
    right. intros [x Hx]%H.
    destruct Hx as (?&[y Hy]%Mod_divides&?).
    exists x, y. nia.
  Qed.

  (** Every number > 1 has an irreducible factor. *)

  Lemma irred_factor n :
    n > 1 -> { k | irred k /\ Mod k n = 0}.
  Proof.
    pattern n. apply lt_rect. intros N IH HN.
    destruct (dec_irred_factor N) as [|H].
    - exists N. split. auto.
      apply Mod_divides. exists 1; lia.
    - destruct (H HN) as [x [y ((H1&H2)&H3) ]].
      assert (x > 1) by nia.
      destruct (IH x H2 H1) as [k Hk].
      exists k. split. tauto.
      rewrite <-H3. rewrite Mod_mult_hom, (proj2 Hk).
      apply Mod0_is_0.
  Qed.

  Lemma irred_Mod_eq m x :
    irred x -> m > 1 -> Mod m x = 0 -> m = x.
  Proof.
    intros Hx Hm Eq.
    enough (m < x \/ m = x) as []; auto.
    apply Hx in H; intuition lia.
    apply Mod_le in Eq; try lia.
    unfold irred in *; lia.
  Qed.

  Lemma irred_integral_domain n a b :
    irred n -> Mod n (a*b) = 0 -> Mod n a = 0 \/ Mod n b = 0.
  Proof.
    intros irred_n.
    induction a as [a Hrec] using lt_rect.
    intros Eq.
    assert (n <= a \/ a < n) as [] by lia.
    - rewrite <-ModMod_is_Mod.
      apply Hrec. apply Mod_lt. split.
      enough (n > 1) by lia. apply irred_n.
      lia. now rewrite <-Mod_mult_hom_l.
    - assert (a = 0 \/ a > 0) as [-> |] by lia.
      rewrite Mod0_is_0; auto.
      edestruct (Hrec (Mod a n)).
      now apply Mod_bound.
      3 : right; apply H1.
      cut (Mod n (n * b) = 0).
      rewrite (Factor a n) at 2.
      rewrite Nat.mul_add_distr_r.
      rewrite Mod_add_hom, <- Nat.mul_assoc, Mod_mult_hom.
      now rewrite Eq, Nat.mul_0_r, <- Mod_add_hom.
      rewrite Nat.mul_comm, <-(Nat.add_0_r (_ * _)).
      now rewrite Mod_plus_multiple, Mod0_is_0.
      enough (Mod a n = 0) as E.
      apply irred_n in E.
      rewrite E, Nat.mul_1_l in Eq. all: auto.
      rewrite Mod_id in H1. auto.
      apply Mod_lt. lia.
  Qed.

  Definition prime p := p > 1 /\
    forall a b, Mod p (a*b) = 0 -> Mod p a = 0 \/ Mod p b = 0.

  (** Prime and irreducible are equivalent *)

  Lemma prime_irred_equiv p : irred p <-> prime p.
  Proof.
    split; intros [? H]; split; auto.
    - intros a b Hab. apply irred_integral_domain.
      unfold irred; auto. assumption.
    - intros n H1 H2.
      destruct (fst (Mod_divides _ _) H2) as [k Hk].
      destruct (H k n).
      + rewrite <-Hk. apply Mod_divides. exists 1. now cbn.
      + destruct (fst (Mod_divides _ _) H3) as [? ->].
        assert (p*(x*n) = p*1) as ?%Nat.mul_cancel_l by lia.
        apply Nat.mul_eq_1 in H4. all: lia.
      + apply Mod_le in H3. all: lia.
  Qed.

  Corollary Dec_sigT_prime :
    Dec_sigT (prime).
  Proof.
    refine (Dec_sigT_transport _ _ Dec_sigT_irred prime_irred_equiv).
  Qed.

End PrimeDec.

Section PrimeInf.
  Fixpoint faktorial n :=
    match n with
    | 0 => 1
    | S x => (faktorial x)*n
    end.

  Notation "x !" := (faktorial x) (at level 2).

  Fact fac1 : forall n, 0 < n!.
  Proof. induction n; cbn; lia. Qed.

  Fact fac2 : forall n, 0 < n -> Mod n (n !) = 0.
  Proof.
    intros n H. destruct n; try lia.
    apply Mod_divides. exists (n !).
    reflexivity.
  Qed.

  Lemma fac3 : forall x y, 0 < y <= x -> Mod y (x!) = 0.
  Proof.
    intros x y H.
    induction x in y, H |-*.
    - lia.
    - assert (y = S x \/ y <= x) as [<-|] by lia; cbn.
      now apply fac2.
      rewrite Mod_mult_hom, IHx.
      apply Mod0_is_0. lia.
  Qed.

  (** There are infinitely many irreducible numbers. *)
  Lemma infty_irred : forall N, { p & N < p /\ irred p}.
  Proof.
    intros n.
    destruct (irred_factor (n! + 1)) as [k [[] ]].
    specialize(fac1 n). lia.
    exists k. split.
    - rewrite Mod_add_hom in *.
      assert (n < k <-> ~ (k <= n)) as G by lia.
      apply G. intros ?.
      enough (1 = 0) by lia.
      rewrite <-H1 at 2.
      rewrite fac3. 2: lia.
      cbn; rewrite ModMod_is_Mod.
      symmetry. refine ( proj2 (Fac_eq _ 0 _ _)); lia.
    - unfold irred. tauto.
  Defined.

  (** An injective function producing infinitely many irreducible numbers. *)
  Fixpoint Irred n := match n with
                      | 0 => projT1 (infty_irred 0)
                      | S x => projT1 (infty_irred (Irred x))
                      end.

  Lemma mono_inj f :
    (forall x,  f x < f (S x)) -> inj f.
  Proof.
    intros Hf.
    assert (H : forall n x, x < n -> f x < f n).
    induction n.
    - lia.
    - intros x.
      assert (x < S n <-> x < n \/ x = n) as -> by lia.
      intros [| ->].
      + specialize (Hf n). specialize (IHn _ H). lia.
      + apply Hf.
    - intros x y eq.
      destruct (dec_eq_nat x y); auto.
      assert (x < y \/ y < x) as [G|G] by lia.
      all: specialize (H _ _ G); lia.
  Qed.

  Lemma inj_Irred : inj Irred.
  Proof.
    apply mono_inj. intros x.
    apply (proj1 (projT2 (infty_irred (Irred x)))).
  Qed.

  Lemma irred_Irred x : irred (Irred x).
  Proof.
    destruct x; apply (projT2 (infty_irred _)).
  Qed.

End PrimeInf.


Require Import Omega.
Require Import Setoid.

(*
=============================================================================
****************** SECTION 1: PRELIMINARIES *********************************
=============================================================================
*)

(*
 * This file contains recurrently useful results and definitions
 * that are used throughout the subsequent files.
 *)

(* ****** LEMMAS ABOUT NAT  ****** *)

Lemma le_S_n_m : forall n m : nat, n <= m <-> S n <= S m.
Proof. intros. omega. Qed.

Lemma not_lt: forall n m : nat, n <= m <-> ~ m < n.
Proof. intros. omega. Qed.

Lemma not_le: forall n m : nat, ~ n <= m <-> m < n.
Proof. intros. omega. Qed.

Lemma le_lt_S: forall n m : nat, S n <= m <-> n < m.
Proof. intros. omega. Qed.

Lemma lt_S_le: forall n m : nat, n <= m <-> n < S m.
Proof. intros. omega. Qed.

(* ****** LEMMAS ABOUT REPEATED APPLICATION ****** *)

Fixpoint repeat (f: nat -> nat) (rep n : nat) : nat :=
  match rep with
  | 0 => n
  | S rep' => f (repeat f rep' n)
  end.

Theorem repeat_S_comm :
  forall f k n, repeat f (S k) n = repeat f k (f n).
Proof.
  induction k; [trivial|].
  intro. simpl in *. rewrite IHk. trivial.
Qed.

Theorem repeat_plus :
  forall f k l n, repeat f (k + l) n =
                  repeat f k (repeat f l n).
Proof.
  induction k; [trivial|].
  simpl; intros; rewrite IHk; trivial.
Qed.


From Equations Require Import Equations.
Require Import List ZArith Lia.
Import ListNotations.

Equations neg (b : bool) : bool :=
neg true := false;
neg false := true.
Compute neg true.   (* false : bool *)
Compute neg false.  (* true : bool *)

Equations bin (n : nat) : list bool by wf n lt :=
bin O := List.nil;
bin n := (if (Nat.eqb (Nat.modulo n 2) 0) then false else true)  :: bin (Nat.div n 2).
Next Obligation.
  change (S n0 / 2 < S n0).
  apply Nat.div_lt; lia.
Qed.
Compute bin 11.
(*
= [true; true; false; true]
     : list bool
*)


Lemma not_none_is_some : forall {A:Type} (o: option A),
  o <> None <-> exists x:A, o = Some x.
Proof.
  intros A o. split. elim o. intros a H. exists a. reflexivity.
  intro H. apply False_ind. apply H. reflexivity.
  intro H. elim H. intros x Hx. rewrite Hx. intros. discriminate.
Qed.

Lemma none_or_not_none : forall {A:Type} (o:option A),
  o = None \/ o <> None.
Proof.
  intros A o. elim o. intro a. right. intro H. discriminate.
  left. reflexivity.
Qed.


From Hammer Require Import Hammer.

Require Import PeanoNat Even.

Local Open Scope nat_scope.

Implicit Type n : nat.

Notation div2 := Nat.div2.

Lemma ind_0_1_SS :
forall P:nat -> Prop,
P 0 -> P 1 -> (forall n, P n -> P (S (S n))) -> forall n, P n.
Proof. hammer_hook "Div2" "Div2.ind_0_1_SS".
intros P H0 H1 H2.
fix 1.
destruct n as [|[|n]].
- exact H0.
- exact H1.
- apply H2, ind_0_1_SS.
Qed.

Lemma lt_div2 n : 0 < n -> div2 n < n.
Proof. hammer_hook "Div2" "Div2.lt_div2".   apply Nat.lt_div2. Qed.

Hint Resolve lt_div2: arith.

Lemma even_div2 n : even n -> div2 n = div2 (S n).
Proof. hammer_hook "Div2" "Div2.even_div2".
rewrite Even.even_equiv. intros (p,->).
rewrite Nat.div2_succ_double. apply Nat.div2_double.
Qed.

Lemma odd_div2 n : odd n -> S (div2 n) = div2 (S n).
Proof. hammer_hook "Div2" "Div2.odd_div2".
rewrite Even.odd_equiv. intros (p,->).
rewrite Nat.add_1_r, Nat.div2_succ_double.
simpl. f_equal. symmetry. apply Nat.div2_double.
Qed.

Lemma div2_even n : div2 n = div2 (S n) -> even n.
Proof. hammer_hook "Div2" "Div2.div2_even".
destruct (even_or_odd n) as [Ev|Od]; trivial.
apply odd_div2 in Od. rewrite <- Od. intro Od'.
elim (n_Sn _ Od').
Qed.

Lemma div2_odd n : S (div2 n) = div2 (S n) -> odd n.
Proof. hammer_hook "Div2" "Div2.div2_odd".
destruct (even_or_odd n) as [Ev|Od]; trivial.
apply even_div2 in Ev. rewrite <- Ev. intro Ev'.
symmetry in Ev'. elim (n_Sn _ Ev').
Qed.

Hint Resolve even_div2 div2_even odd_div2 div2_odd: arith.

Lemma even_odd_div2 n :
(even n <-> div2 n = div2 (S n)) /\
(odd n <-> S (div2 n) = div2 (S n)).
Proof. hammer_hook "Div2" "Div2.even_odd_div2".
split; split; auto using div2_odd, div2_even, odd_div2, even_div2.
Qed.

Notation double := Nat.double.

Hint Unfold double Nat.double: arith.

Lemma double_S n : double (S n) = S (S (double n)).
Proof. hammer_hook "Div2" "Div2.double_S".
apply Nat.add_succ_r.
Qed.

Lemma double_plus n m : double (n + m) = double n + double m.
Proof. hammer_hook "Div2" "Div2.double_plus".
apply Nat.add_shuffle1.
Qed.

Hint Resolve double_S: arith.

Lemma even_odd_double n :
(even n <-> n = double (div2 n)) /\ (odd n <-> n = S (double (div2 n))).
Proof. hammer_hook "Div2" "Div2.even_odd_double".
revert n. fix 1. destruct n as [|[|n]].
-
split; split; auto with arith. inversion 1.
-
split; split; auto with arith. inversion_clear 1. inversion H0.
-
destruct (even_odd_double n) as ((Ev,Ev'),(Od,Od')).
split; split; simpl div2; rewrite ?double_S.
+ inversion_clear 1. inversion_clear H0. auto.
+ injection 1. auto with arith.
+ inversion_clear 1. inversion_clear H0. auto.
+ injection 1. auto with arith.
Qed.

Lemma even_double n : even n -> n = double (div2 n).
Proof. hammer_hook "Div2" "Div2.even_double".  exact (proj1 (proj1 (even_odd_double n))). Qed.

Lemma double_even n : n = double (div2 n) -> even n.
Proof. hammer_hook "Div2" "Div2.double_even".  exact (proj2 (proj1 (even_odd_double n))). Qed.

Lemma odd_double n : odd n -> n = S (double (div2 n)).
Proof. hammer_hook "Div2" "Div2.odd_double".  exact (proj1 (proj2 (even_odd_double n))). Qed.

Lemma double_odd n : n = S (double (div2 n)) -> odd n.
Proof. hammer_hook "Div2" "Div2.double_odd".  exact (proj2 (proj2 (even_odd_double n))). Qed.

Hint Resolve even_double double_even odd_double double_odd: arith.

Lemma even_2n : forall n, even n -> {p : nat | n = double p}.
Proof. hammer_hook "Div2" "Div2.even_2n".
intros n H. exists (div2 n). auto with arith.
Defined.

Lemma odd_S2n : forall n, odd n -> {p : nat | n = S (double p)}.
Proof. hammer_hook "Div2" "Div2.odd_S2n".
intros n H. exists (div2 n). auto with arith.
Defined.

Lemma div2_double n : div2 (2*n) = n.
Proof. hammer_hook "Div2" "Div2.div2_double".   apply Nat.div2_double. Qed.

Lemma div2_double_plus_one n : div2 (S (2*n)) = n.
Proof. hammer_hook "Div2" "Div2.div2_double_plus_one".   apply Nat.div2_succ_double. Qed.


(*Prove que |rev(l)| = |l|, qualquer que seja a lista l.*)

Require Import List.
Require Import Lia.

Fixpoint concat (l1 l2 : list nat) : list nat :=
  match l1 with
    | nil => l2
    | cons h l' => cons h (concat l' l2)
  end.

Fixpoint rev (l : list nat) : list nat :=
  match l with
    | nil => l
    | cons h l' => concat (rev l') (cons h nil)
  end.

Fixpoint len (l : list nat) : nat :=
  match l with
    | nil => 0
    | cons h l' => 1 + len l'
  end.

Lemma concat_nil_commutative: forall l : list nat, concat l nil = l.
Proof.
  induction l.
  - simpl concat.
    reflexivity.
  - simpl concat.
    rewrite IHl.
    reflexivity.
Qed.

Lemma concat_sum_len : forall l1 l2, len (concat l1 l2) = len l1 + len l2.
Proof.
  induction l1, l2.
  - simpl concat.
    simpl len.
    reflexivity.
  - simpl concat.
    simpl (len nil).
    reflexivity.
  - simpl (len nil).
    assert (concat l1 nil = l1).
    -- apply concat_nil_commutative.
    -- simpl concat.
       rewrite H.
       lia.
  - simpl len.
    rewrite IHl1.
    simpl len.
    reflexivity.
Qed.

Lemma reverse_list_size : forall l, len (rev l) = len l.
Proof.
  induction l.
  - simpl rev.
    reflexivity.
  - simpl rev.
    assert (len (concat (rev l) (a :: nil)) = len (rev l) + len (a :: nil)).
    -- apply concat_sum_len.
    -- rewrite H.
       rewrite IHl.
       simpl.
       lia.
Qed.


(* Exercise 1 *)
Theorem identity_fn_applied_twice :
  forall f : bool -> bool,
  (forall x : bool, f x = x) ->
  forall b : bool, f (f b) = b.
Proof.
  intros f f_id b.
  rewrite f_id.
  rewrite f_id.
  reflexivity.
Qed.

(* Exercise 2 *)
Theorem andb_eq_orb :
  forall b c : bool,
  (andb b c = orb b c) ->
  b = c.
Proof.
  intros b c H.
  destruct b.
    (* true, true *)
    destruct c.
    reflexivity.
    (* true, false *)
    simpl in H.
    discriminate.
    (* false, true *)
    destruct c.
    simpl in H.
    discriminate.
    (* false, false *)
    simpl in H.
    exact H.
Qed.

(* Exercise 3 *)
Inductive bin : Type :=
  | bZ : bin
  | bE : bin -> bin
  | bO : bin -> bin.

Fixpoint incr (b:bin) : bin :=
  match b with
  | bZ   => bO bZ
  | bE x => bO x
  | bO x => bE (incr x)
  end.

Fixpoint bin_to_nat (b:bin) : nat :=
  match b with
  | bZ    => O
  | bE x  => 2 * (bin_to_nat x)
  | bO x  => 2 * (bin_to_nat x) + 1
  end.

Lemma add_id_right : forall n : nat, n + 0 = n.
Proof.
  intro n.
  induction n.
    simpl. reflexivity.
    simpl. rewrite IHn. reflexivity.
Qed.

Lemma add_associativity : forall m n o : nat, m + (n + o) = m + n + o.
Proof.
  intros m n o.
  induction m. induction n. induction o.
    simpl. reflexivity.
    simpl. reflexivity.
    simpl. reflexivity.
    simpl. rewrite IHm. reflexivity.
Qed.

Lemma add_commutativity :
  forall a b c d : nat,
  a + b + c + d = a + c + b + d.
Admitted.

Theorem incr_correct : forall b, bin_to_nat (incr b) = bin_to_nat b + 1.
Proof.
  intro b.
  induction b.
    (* bZ *)
    simpl. reflexivity.
    (* bE *)
    simpl. rewrite add_id_right. reflexivity.
    (* bO *)
    simpl. rewrite add_id_right.
    rewrite IHb. rewrite add_id_right.
    rewrite add_associativity.
    rewrite add_commutativity.
    reflexivity.
Qed.


(* ejercicio 1:(PUNTOS: 2 )
  Probar las siguientes proposiciones sin hacer uso de Tauto ni de Auto: *)

Lemma distr_impl : (A,B,C:Prop)(A->(B->C))->(A->B)->(A->C).
Intros.
Apply H.
Assumption.

Apply H0.
Assumption.
Defined.

Section ej1.
Variables p,q:Prop.
Hypothesis premisa1: ~p \/ q.

Lemma ejemplo1 : p -> q.
Intro.
Elim premisa1.
Intro.
Absurd p.
Assumption.

Assumption.

Intro.
Assumption.
Defined.
End ej1.

Section Regla_MT.

Variables A,B:Prop.
Hypothesis prem1 : A->B.
Hypothesis prem2 : ~B.

Theorem MT : ~A.
Intro.
Generalize (prem1 H).
Intro.
Absurd B.
Assumption.

Assumption.
Defined.
End Regla_MT.

Print distr_impl.
Print ejemplo1.
Print MT.

(* En logica intuicionista de segundo orden, los conectivos
"falso", "o" e "y" pueden ser definidos en funcion de "para todo" y
la implicacion *)

(* definicion de falso *)

Definition new_false := (a:Prop)a .

(* ejercicio 2:(PUNTOS: 2 )
   probar dos teoremas que juntos prueben la equivalencia de
   new_false y False *)

Theorem equiv_false1:(new_false)->(False).
Intro.
Apply H.
Defined.

Theorem equiv_false2:
(False)->new_false.
Intro.
Contradiction.
Defined.
Print equiv_false1.
Print equiv_false2.

(* definicion de "y":
a "y" b es verdad si todo lo que se puede derivar del conjunto
{a,b} es verdad *)

Definition new_and := [a,b:Prop](c:Prop)((a -> b -> c) -> c) .

(* ejercicio 3:(PUNTOS: 3 )
   probar dos teoremas que juntos demuestren
   la equivalencia de new_and y /\ *)
Theorem equiv_and1:(a,b:Prop)(new_and a b)->(a/\b) .
Intro.
Intros.
Apply H.
Intros.
Split.
Assumption.
Assumption.
Defined.

Theorem equiv_and2:(a,b:Prop)(a/\b)->(new_and a b) .
Intros.
Unfold new_and.
Intros.
Apply H0.
Elim H.
Intros.
Assumption.
Elim H.
Intros.
Assumption.
Defined.

Print equiv_and1.
Print equiv_and2.

(* usando polimorfismo podemos definir tipos de datos como
   numeros naturales y booleanos aunque
   Coq use definiciones inductivas porque resulta
   mas eficiente *)

(* numeros naturales *)

Definition new_nat := (a:Set)(a->(a->a)->a).

 1
(* numeros polimorficos de Church *)

Definition zero := [a:Set][z:a][s:a->a] z.
Definition one  := [a:Set][z:a][s:a->a] (s z).
Definition two  := [a:Set][z:a][s:a->a] (s (s z)).

(* ejercicio 4 : (PUNTOS 3 )
   Dar una definicion de sucesor y chequearla con
   al menos dos entradas diferentes. Por ejemplo, comprobar
   que el sucesor de zero es one y el sucesor de one es two *)

Definition sucesor[x:Set;z:x;s:x->x;]:=(s ).

Print sucesor.


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

(** An inductive type for lists. Uses the familiar x1 :: x2 :: ...
    :: xn :: Nil approach. *)
Inductive natlist : Type :=
   | nil : natlist
   | cons : nat -> natlist -> natlist.

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

(** Some helpful notation for lists, using [::] as an infix cons
    operator. *)
Notation "x :: y" := (cons x y) (at level 60, right associativity).
Notation "[ ]" := nil.
Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..).

(**********)
(* REPEAT *)
(**********)

(** Takes a number [n] and a [count] and returns a length of [count] where
    every element is [n] *)
Fixpoint repeat (n count : nat) : natlist :=
   match count with
   | O => nil
   | S count' => n :: (repeat n count')
   end.

(** Test *)
Eval compute in (repeat 3 6).

(**********)
(* LENGTH *)
(**********)

(** The [length] function calculates the length of a list *)
Fixpoint length (l : natlist) : nat :=
   match l with
   | nil => 0
   | h :: t => 1 + (length t)
   end.

(** Test *)
Eval compute in (length [1;2;3;4;5;2]).

(**********)
(* APPEND *)
(**********)

(** [app]end two lists together *)
Fixpoint app (l1 l2 : natlist) : natlist :=
   match l1 with
   | nil => l2
   | h :: t => h :: (app t l2)
   end.

(** Some convenient [app]-related notation. We use the haskell [++]
    append infixr *)
Notation "x ++ y" := (app x y) (right associativity, at level 60).

(** Some [app] tests *)
Example test_app1: [1;2;3] ++ [2;3] = [1;2;3;2;3].
Proof. reflexivity. Qed.
Example test_app2: [1;2;3] ++ nil = [1;2;3].
Proof. reflexivity. Qed.
Example test_app3: [] ++ [1;2;3] = [1;2;3].
Proof. reflexivity. Qed.

(*****************)
(* HEAD and TAIL *)
(*****************)

(** The haskell [head] function, but with a default value that is
    returned when the function is passed a [nil] [natlist]. *)
Definition hd (default : nat) (l : natlist) : nat :=
   match l with
   | nil => default
   | h :: t => h
   end.

(** Return every list element except for the head *)
Definition tl (l : natlist) : natlist :=
   match l with
   | nil => nil
   | h :: t => t
   end.

(** EXERCISE [**]: Complete the definitions of [nonzeros], [oddmembers],
    and [countoddmembers] below. *)

(** [nonzeros] removes all instances of [0] from the list *)
Fixpoint nonzeros (l : natlist) : natlist :=
   match l with
   | nil => nil
   | h :: t => match h with
               | O => nonzeros t
               | S h' => h :: (nonzeros t)
               end
   end.

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

(** [oddmembers] filters all even elements out of a list *)
Fixpoint oddmembers (l : natlist) : natlist :=
   match l with
   | nil => nil
   | h :: t => if oddb h
               then h :: (oddmembers t)
               else (oddmembers t)
   end.

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

(** [countoddmembers] counts the number of oddmembers in the list *)
Fixpoint countoddmembers (l : natlist) : nat :=
   match l with
   | nil => 0
   | h :: t => if oddb h
               then 1 + (countoddmembers t)
               else (countoddmembers t)
   end.

(* Tests *)
Example test_countoddmembers1: countoddmembers [1;0;3;1;4;5] = 4.
Proof. reflexivity. Qed.
Example test_countoddmembers2: countoddmembers [2;4;6;10] = 0.
Proof. reflexivity. Qed.
Example test_countoddmembers3: countoddmembers nil = 0.
Proof. reflexivity. Qed.

(** EXERCISE [***]: Define [alternate], a function that zips up the
    elements of two lists *)
Fixpoint alternate (l1 l2 : natlist) : natlist :=
   match l1 with
   | nil => l2
   | h1 :: t1 => match l2 with
                 | nil => l1
                 | h2 :: t2 => h1 :: h2 :: (alternate t1 t2)
                 end
   end.

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

(******************)
(* BAGS VIA LISTS *)
(******************)

(** A [bag] is a synonym for a [multiset] *)
Definition bag := natlist.

(** EXERCISE [***]: Define the functions [count], [add], and
    [member] *)

(** [count n xs] determines the number of [n]'s in bag [xs] *)
Fixpoint count (v : nat) (s : bag) :=
   match s with
   | [] => 0
   | h :: t => if beq_nat h v
               then 1 + (count v t)
               else (count v t)
   end.

(* Tests *)
Example test_count1: count 1 [1;2;3;1;2] = 2.
Proof. reflexivity. Qed.
Example test_count2: count 5 [1;2;3;4;8] = 0.
Proof. reflexivity. Qed.

(** [sum xs ys] combines the contents of two bags *)
Definition sum : bag -> bag -> bag :=
   app.

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

(** [add n xs] prepends the element n to the bag xs *)
Definition add (v:nat) (s:bag) : bag :=
   v :: s.

(* Tests *)
Example test_add1: count 1 (add 1 [1;4;3;1]) = 3.
Proof. reflexivity. Qed.
Example test_add2: count 1 (add 3 [1;4;2;1]) = 2.
Proof. reflexivity. Qed.

(** [member n xs] determines whether n is a member of the bag xs *)
Definition member (v:nat) (s:bag) : bool :=
   if beq_nat (count v s) 0
   then false
   else true.

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

(** EXERCISE [***]: More bag functions: [remove_one], [remove_all], and
    [subset] *)

(** Remove the first instances of a value [v] from a bag [s] *)
Fixpoint remove_one (v:nat) (s:bag) : bag :=
   match s with
   | [] => s
   | h :: t => if beq_nat 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: remove_one 5 [2;1;5;4;5;2] = [2;1;4;5;2].
Proof. reflexivity. Qed.

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

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

(* [subset s1 s2] determines if bag s1 is a subset of bag s2 *)
Fixpoint subset (s1:bag) (s2:bag) : bool :=
   match s1 with
   | [] => true
   | h :: t => if (member h s2)
               then (subset t (remove_one h s2))
               else false
   end.

(* Test *)
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.

(** Rewriting this cuz i need it below, and some import technicalities
    are preventing me from getting it *)
Theorem beq_nat_refl : forall (n : nat),
   beq_nat n n = true.

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

(** EXERCISE [***]: Prove something interesting about the functions
    [count] and [add] on bags *)
Theorem bag_theorem : forall (n : nat) (s : bag),
   count n (add n s) = 1 + (count n s).

Proof.
   intros n s.
   assert (H: (add n s) = n :: s).
      reflexivity.
   rewrite -> H. simpl. rewrite -> beq_nat_refl. reflexivity. Qed.


Require Import MathClasses.theory.rings.
Require Import MathClasses.interfaces.abstract_algebra.
Require Import MCMisc.tactics.
Require Import Ring.
(*less annoying than ^2 which multiplies by 1 as well*)
Definition sqr `{Mult A} (a:A) := a*a.

Section RingMisc.

(**some miscelleneous convenience props about rings.
The ring tactic can prove these. However, to use that tactic,
one has to manually assert the statement, which can
sometimes contain bulky terms, which may need to be updated
when a proof or statement changes slightly.
These lemmas can often help avoid those manual assertions.
*)
Context `{Ring A}.
Add Ring tempRing : (stdlib_ring_theory A).

Lemma RingShiftMinus  : forall
  a b c : A,
  a - b  = c <-> a = b + c.
Proof using All.
  intros ? ? ?; split; intros Hh.
  (**the ring tactic does not seem to look at hyps*)
  - rewrite <- Hh. ring.
  - rewrite Hh. ring.
Qed.

Lemma RingProp2  : forall
  a b  : A,
  a + b - b  =a.
Proof using All.
  intros ? ?. ring.
Qed.

Lemma RingProp3  : forall
  a   : A,
  a + a   = 2 * a.
Proof using All.
  intros ? . ring.
Qed.

Lemma RingProp4  : forall
  a b c  : A,
  -a * (b-c)   = a * (c-b).
Proof using All.
  intros ? ? ? . ring.
Qed.

Lemma MultShuffle3l:
∀ a b c : A,
 a * (b * c) = b * a * c.
Proof using All.
  intros.
  ring.
Qed.

Lemma PlusShuffle3l:
∀ a b c : A,
 a + (b + c) = b + a + c.
Proof using All.
  intros.
  ring.
Qed.

Lemma MultShuffle3r:
∀ a b c : A,
 a * b * c = a * c * b.
Proof using All.
  intros.
  ring.
Qed.

Lemma PlusShuffle3r:
∀ a b c : A,
 a + b + c = a + c + b.
Proof using All.
  intros.
  ring.
Qed.

Lemma MultSqrMix:
∀ a b c d : A,
 (a * b * c * d = (a * c) * (b * d)).
Proof using All.
  intros.
  ring.
Qed.

(*
 Lemma X:
 forall
(X Y X0 Y0 xy cc X1 Y1 s c : A),

((X * (c * c) + xy * s * c + Y * (s * s)) * (X1 * X1) +
(Y * (c * c) - xy * s * c + X * (s * s)) * (Y1 * Y1) +
((X0 * c + Y0 * s) * X1 + (Y0 * c + - X0 * s) * Y1 +
 (xy * (1 - 2 * (s * s)) + (Y - X) * (2 * s * c)) * X1 *
 Y1 + cc))  =
X * ((X1 * c - Y1 * s) * (X1 * c - Y1 * s)) +
Y * ((Y1 * c + X1 * s) * (Y1 * c + X1 * s)) +
(X0 * (X1 * c - Y1 * s) + Y0 * (Y1 * c + X1 * s) +
 xy * (X1 * c - Y1 * s) * (Y1 * c + X1 * s) + cc)
.
 Proof.
 intros.
 ring_simplify.
*)

Section Le.
Require Export MathClasses.orders.rings.
Context `{Le A}
    `{@orders.SemiRingOrder A equiv plus mult zero one le}.

Lemma RingLeProp1  : forall
  a  b : A,
  0 ≤ b
  ->a ≤ b + a.
Proof using All.
  intros ? ? Hh.
  apply flip_le_minus_l. rewrite plus_negate_r.
  assumption.
Qed.

Lemma RingLeProp1l  : forall
  a  b : A,
  0 ≤ b
  ->a ≤  a + b.
Proof using All.
  intros ? ? Hh.
  rewrite commutativity.
  apply RingLeProp1.
  assumption.
Qed.

(** Proof is the dual of MathClasses.orders.rings.ge_1_mult_le_compat_r*)
Lemma le_1_mult_le_compat_r x y z : z ≤ 1 → 0 ≤ x → x ≤ y → x * z ≤ y .
  Proof.
    intros.
    transitivity x;[| easy].
    rewrite <-(mult_1_r x) at 2.
    now apply (order_preserving_nonneg (.*.) x).
  Qed.

Lemma RingLeProp2  : forall
  a : A,
  0 ≤ a
  ->a ≤ 2*a.
Proof using All.
  intros ? Hh.
  rewrite <- RingProp3.
  apply RingLeProp1.
  assumption.
Qed.

Lemma RingLeProp3  : forall
  a : A,
  0 ≤ a
  ->0 ≤ 2*a.
Proof using All.
  intros ? Hh.
  rewrite <- RingProp3.
  apply nonneg_plus_compat; assumption.
Qed.

Require Import MathClasses.interfaces.orders.

Context `{Lt A} `{Apart A} {FPSRO:@FullPseudoSemiRingOrder A
equiv apart plus mult zero one le lt}.

Set Suggest Proof Using.
Lemma RingLeIfSqrLe  : forall
  (a b : A),
  0 < b + a
  → sqr a ≤ sqr b
  → a ≤  b.
Proof using All.
  intros ? ? Hp Hs.
  apply flip_nonneg_minus in Hs.
  assert (sqr b - sqr a = (b-a)*(b+a)) as Heq by (unfold sqr;ring).
  rewrite Heq in Hs. clear Heq.
  apply flip_nonneg_minus.
  eapply nonneg_mult_rev_l; eauto.
Qed.

Lemma RingPosNnegCompatPlus  : forall
  (a b : A),
  0 < b
  →0 ≤ a
  → 0 < b + a.
Proof using All.
  intros ? ? Hlt hlt. eapply lt_le_trans; eauto.
  rewrite commutativity.
  apply RingLeProp1.
  assumption.
Qed.

Lemma RingLeSqr1  : forall
  (a b : A),
  0 ≤ b
  → 0 ≤ a
  → sqr a + sqr b ≤ sqr (b + a).
Proof using All.
  intros ? ? Ha Hb.
  unfold sqr.
  apply flip_nonneg_minus.
  ring_simplify.
  rewrite <- (@simple_associativity _ _ mult _ _).
  apply RingLeProp3.
  apply nonneg_mult_compat; assumption.
Qed.

Lemma RingLeMultIff  : forall
  (a b k : A),
  0 < k
  → (a ≤ b ↔ k*a ≤ k*b).
Proof.
  intros ? ? ? Hk.
  split; intro h.
- apply (order_preserving (mult k));
  eauto with typeclass_instances.

- apply (order_reflecting) in h;
  eauto with typeclass_instances.
  (* k needs to be positive in this case *)

Qed.

Lemma RingLtMultIff  : forall
  (a b k : A),
  0 < k
  → (a < b ↔ k*a < k*b).
Proof.
  intros ? ? ? Hk.
  split; intro h.
- apply (strictly_order_preserving);
  eauto with typeclass_instances.

- apply (strictly_order_reflecting) in h;
  eauto with typeclass_instances.
Qed.

(** why is this needed? without it, rewrite Hki in [RingLeRecipMultIff]
below fails *)

Local Instance ProperLt :
Proper (equiv ==> equiv ==> iff) lt.
Proof.
eauto with typeclass_instances.
Qed.

(** there is a version for for fields, where the hypothesis H10 is not needed. *)
Lemma RingLeRecipMultIff {H10 :PropHolds (1 ≶ 0)} : forall
  (a b k kinv : A),
  0 < k
  → kinv*k =1
  → (k*a ≤ b ↔ a ≤ kinv*b).
Proof.
  intros ? ? ? ? Hk Hki.
  rewrite RingLeMultIff with (k:=kinv);[|].
- ring_simplify [Hki] (kinv * (k * a)) .
  reflexivity.
- eapply pos_mult_rev_l;[| apply Hk].
  rewrite Hki. apply lt_0_1.
Qed.

End Le.

End RingMisc.