Require Import Logic.FunctionalExtensionality.
Require Import Logic.ProofIrrelevance.

Record Group := {
      G : Type;
      mult : G -> G -> G;
      id : G;
      inverse : G -> G;

      associative : forall (x y z : G),
      mult x (mult y z) = mult (mult x y) z;
      id_exists : forall (x : G),
      mult id x = x /\ mult x id = x;
      inverses_exist : forall (x : G),
      mult x (inverse x) = id /\ mult (inverse x) x = id;
}.

Fact inverse_is_unique (G: Group) : forall x y z,
mult G x y = id G /\ mult G x z = id G -> y = z.
Proof. intros. destruct H. rewrite <- H in H0.
assert (mult G (inverse G x) (mult G x z) =
mult G (inverse G x) (mult G x y) ).
{  rewrite H0. reflexivity. }
rewrite associative in H1. rewrite associative in H1.
assert (mult G (inverse G x) x = id G).
{ apply inverses_exist. }
rewrite H2 in H1.
assert (mult G (id G) z = z /\ mult G (id G) y = y).
{ split.
+ apply id_exists.
+ apply id_exists. }
destruct H3. rewrite H3 in H1. rewrite H4 in H1. auto.
Qed.

Fact mult_inverse (G: Group) : forall g g',
mult G (inverse G g') (inverse G g) = inverse G (mult G g g').
Proof. intros.
assert (mult G (mult G g g') (mult G (inverse G g') (inverse G g)) = id G /\
mult G (mult G g g') (inverse G (mult G g g')) = id G).
{ assert (mult G (mult G g g') (inverse G (mult G g g')) = id G).
{ apply inverses_exist. }
assert (mult G (mult G g g') (mult G (inverse G g') (inverse G g)) = id G).
{ rewrite associative.
assert (mult G (mult G g g') (inverse G g') = g).
{ rewrite <- associative.
assert (mult G g' (inverse G g') = id G).
{ apply inverses_exist. }
rewrite H0. apply id_exists.
  }
rewrite H0. apply inverses_exist.
 }
rewrite H. rewrite H0. auto.
} apply inverse_is_unique with (G0:=G) (x:=mult G g g')
(y:=mult G (inverse G g') (inverse G g)) (z:=inverse G (mult G g g')).
auto.
Qed.

Fact inverse_id_is_id (G: Group) : inverse G (id G) = id G.
Proof. apply inverse_is_unique with (G0:=G) (x:=id G)
(y:= inverse G (id G)) (z:=id G).
split.
+ apply inverses_exist.
+ apply id_exists.
Qed.

Definition trivial_group : Group.
refine({|
          G := unit;
          mult a b := tt;
          id := tt
      |}).
Proof.
- auto.
- auto.
- intros. destruct x. auto.
- auto.
Defined.

Definition product_group (X Y : Group) : Group.
refine ({|
        G := (G X) * (G Y);
        mult m n := (mult _ (fst m) (fst n), mult _ (snd m) (snd n));
        id := (id _, id _);
        inverse m := (inverse _ (fst m), inverse _ (snd m))
       |}).
Proof.
- intros. destruct x. destruct y. destruct z. simpl.
rewrite associative. rewrite associative. reflexivity.
- intros. destruct x. simpl.
assert (mult _ (id _) g = g /\ mult _ g (id _) = g).
{ apply id_exists. }
assert (mult _ (id _) g0 = g0 /\ mult _ g0 (id _) = g0).
{ apply id_exists. }
destruct H0. destruct H. rewrite H. rewrite H1. rewrite H0. rewrite H2. auto.
- intros. destruct x. simpl.
assert (mult _ g (inverse _ g) = id _ /\ mult _ (inverse _ g) g = id _).
{ apply inverses_exist. }
assert (mult _ g0 (inverse _ g0) = id _ /\ mult _ (inverse _ g0) g0 = id _).
{ apply inverses_exist. }
destruct H. destruct H0. rewrite H. rewrite H1. rewrite H0. rewrite H2. auto.
Defined.

Definition opposite_group (X : Group) : Group.
refine ({|
        G := (G X) ;
        mult m n := mult X n m;
        id := id X;
        inverse m := inverse X m
       |}).
Proof.
- intros. rewrite associative. auto.
- intros. split.
+ apply id_exists.
+ apply id_exists.
- intros. split.
+ apply inverses_exist.
+ apply inverses_exist.
Defined.

Fact opposite_involutive (X : Group) :
opposite_group (opposite_group X) = X.
Proof. unfold opposite_group. simpl. destruct X. simpl.
f_equal; apply proof_irrelevance.
Qed.

Definition indexed_product_group (X : Group) (I : Type) : Group.
refine ({|
        G := I -> (G X);
        mult f g := (fun i => mult X (f i) (g i));
        id := (fun i => id X);
        inverse f := (fun i => inverse X (f i));
       |}).
Proof.
- intros. apply functional_extensionality. intros. apply associative.
- intros.
assert ((fun i : I => mult X (id X) (x i)) = (fun i : I => x i)).
{apply functional_extensionality. intros. apply id_exists. }
assert ((fun i : I => mult X (x i) (id X)) = (fun i : I => x i)).
{apply functional_extensionality. intros. apply id_exists. }
rewrite H. rewrite H0. auto.
- intros.
assert ((fun i : I => mult X (x i) (inverse X (x i))) = (fun i : I => id X)).
{apply functional_extensionality. intros. apply inverses_exist. }
assert ((fun i : I => mult X (inverse X (x i)) (x i)) = (fun i : I => id X)).
{apply functional_extensionality. intros. apply inverses_exist. }
rewrite H. rewrite H0. auto.
Defined.

Definition bijective A (f : (A -> A) * (A -> A)) :=
(forall a, (fst f) ((snd f) a) = a /\ (snd f) ((fst f) a) = a).

Fact bijections_compose : forall A (f g : (A -> A) * (A -> A)),
bijective A f -> bijective A g->
bijective A ((fun x => (fst g) ((fst f) x)), (fun x => (snd f) ((snd g) x))).
Proof. intros. unfold bijective in *. destruct f. destruct g. simpl in *.
simpl. unfold bijective. split.
+ intros. assert (a (a0 (a2 a3)) = a2 a3). {apply H. }
rewrite H1. apply H0.
+ intros. assert (a2 (a1 (a a3)) = a a3). {apply H0. }
rewrite H1. apply H.
Qed.

Fact identity_is_bijective : forall A,
bijective A ((fun x => x), (fun x => x)).
Proof. intros. unfold bijective. auto.
Qed.

Fact inverse_is_bijective : forall A (f : ((A -> A) * (A -> A))),
bijective A f -> bijective A (snd f, fst f).
Proof. intros. destruct f. unfold bijective. unfold bijective in H.
simpl. simpl in *. split; apply H.
Qed.

Definition permutation_group (A : Type) : Group.
refine ({|
        G := {f : ((A -> A) * (A -> A)) | bijective A f};
        mult m n := let (f, p) := m in
                    let (g, p') := n in
                    exist (bijective A)
                    ((fun x => (fst g) ((fst f) x)),
                    (fun x => (snd f) ((snd g) x)))
                    (bijections_compose A f g p p');
        id := exist (bijective A) ((fun x => x), (fun x => x))
             (identity_is_bijective A);
        inverse m := let (f, p) := m in
                     exist (bijective A) (snd f, fst f)
                     (inverse_is_bijective A f p);
       |}).
Proof.
- intros. destruct x. destruct y. destruct z. destruct x.
destruct x0. destruct x1. simpl in *. simpl.
apply subset_eq_compat. auto.
- intros. destruct x. destruct x. simpl. split.
+ apply subset_eq_compat. auto.
+ apply subset_eq_compat. auto.
- intros. destruct x. destruct x. simpl. split.
+ apply subset_eq_compat. unfold bijective in b. simpl in *.
assert ((fun x : A => a0 (a x) ) = (fun x : A => x) ).
{apply functional_extensionality. intros. apply b. }
rewrite H. auto.
+ apply subset_eq_compat. unfold bijective in b. simpl in *.
assert ((fun x : A => a (a0 x) ) = (fun x : A => x) ).
{apply functional_extensionality. intros. apply b. }
rewrite H. auto.
Defined.

Definition left_action (H : Group) (X : Type) (act : (G H) -> X -> X) :=
(forall x, act (id H) x = x) /\
(forall g h x, act g (act h x) = act (mult H g h) x).

Definition right_action (H : Group) (X : Type) (act : X -> (G H) -> X) :=
(forall x, act x (id H) = x) /\
(forall g h x, act (act x g) h = act x (mult H g h)).

Fact permutation_group_acts_on_index : forall A H,
left_action (permutation_group A)
(G (indexed_product_group H A))
(fun p f => match p with
| exist _ (pi, _) b => (fun x => f (pi x))
end).
Proof. intros. unfold left_action. split.
- intros. simpl. auto.
- intros. destruct g. destruct h. destruct x0. destruct x1.
apply functional_extensionality. intros. simpl.  auto.
Qed.

Definition wreath_product (X : Group) : Group.
refine ({|
        G := (G (indexed_product_group X nat)) * (G (permutation_group nat));
        mult m n := let (gs, bij) := m in
                    let (f, p) := bij in
                    let (pi, _) := f in
                    let (gs', bij') := n in
                    let (f', p') := bij' in
                    let (pi', _) := f' in
                    let new_gs := (fun i => mult _  (gs i) (gs' (pi i)) ) in
                    let new_bij := exist _
                    ((fun x => (fst f') ((fst f) x)),
                    (fun x => (snd f) ((snd f') x)))
                    (bijections_compose _ f f' p p') in (new_gs, new_bij);
        id := ((fun _ => id X), exist _ ((fun n => n), (fun n => n)) (identity_is_bijective _));
        inverse m := let (gs, bij) := m in
                    let (f, p) := bij in
                    let (pi, pi_inv) := f in
                    let new_bij := inverse _ bij in
                    let new_f := (fun n => inverse _ (gs (pi_inv n))) in
                    (new_f, new_bij)
       |}).
Proof.
- intros. destruct x. destruct y. destruct z. destruct g0. destruct x.
destruct g2. destruct x. destruct g4. destruct x. simpl. f_equal.
+ apply functional_extensionality. intros. rewrite associative. auto.
+ apply subset_eq_compat. auto.
- intros. destruct x. destruct g0. destruct x. simpl. split.
+ f_equal.
++ apply functional_extensionality. intros. apply id_exists.
++ apply subset_eq_compat. auto.
+ f_equal.
++ apply functional_extensionality. intros. apply id_exists.
++ apply subset_eq_compat. auto.
- intros. destruct x. destruct g0. destruct x. simpl. split.
+ f_equal.
++ apply functional_extensionality. intros. unfold bijective in b.
simpl in b. assert (n0 (n x) = x). {apply b. } rewrite H.
apply inverses_exist.
++ apply subset_eq_compat. unfold bijective in b. simpl in b. f_equal.
+++ apply functional_extensionality. intros. apply b.
+++ apply functional_extensionality. intros. apply b.
+ f_equal.
++ apply functional_extensionality. intros. unfold bijective in b.
simpl in b. apply inverses_exist.
++ apply subset_eq_compat. unfold bijective in b. simpl in b. f_equal.
+++ apply functional_extensionality. intros. apply b.
+++ apply functional_extensionality. intros. apply b.
Defined.


Add LoadPath "$COQ_PROOFS" as Path.
Load unit_5_tactics.

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. inversion H. reflexivity.
Qed.

Example and_example : (3 + 4 = 7) /\ (2 * 2 = 4).
Proof.
  (* WORKED IN CLASS *)
  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 plus_is_O :
  forall n m : nat, n + m = 0 -> n = 0 /\ m = 0.
Proof.
  assert (forall (n m: nat), n + m = m + n).
  {
    intros.
    induction n.
    - simpl. induction m. reflexivity. simpl. rewrite <- IHm. reflexivity.
    - simpl. rewrite IHn. rewrite plus_n_Sm.  reflexivity.
  }
  split.
  - induction n.
    * reflexivity.
    * inversion H0.
  - induction m.
    * reflexivity.
    * rewrite H in H0. inversion H0.
Qed.

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

Lemma and_example3 :
  forall n m : nat, n + m = 0 -> n * m = 0.
Proof.
  (* WORKED IN CLASS *)
  intros n m H.
  assert (H' : n = 0 /\ m = 0).
  { apply plus_is_O. apply 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.

Lemma or_example :
  forall n m : nat, n = 0 \/ m = 0 -> n * m = 0.
Proof.
  (* This pattern implicitly does case analysis on
     n = 0 ∨ m = 0 *)
  intros n m [Hn | Hm].
  - (* Here, n = 0 *)
    rewrite Hn. reflexivity.
  - (* Here, m = 0 *)
    rewrite Hm. rewrite <- mult_n_O.
    reflexivity.
Qed.

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

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

Module MyNot.
Definition not (P:Prop) := P -> False.
Notation "¬ x" := (not x) (at level 60, right associativity): type_scope .
Check not.
(* ===> Prop -> Prop *)
End MyNot.

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

Fact not_implies_our_not : forall (P:Prop),
  not P -> (forall (Q:Prop), P -> Q).
Proof.
  intros.
  destruct H. apply H0.
Qed.

Theorem zero_not_one : ~(0 = 1).
Proof.
  intros contra. inversion contra.
Qed.

Check (0 <> 1).

Theorem zero_not_one' : 0 <> 1.
Proof.
  intros H. inversion H.
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.
  (* WORKED IN CLASS *)
  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.
  (* WORKED IN CLASS *)
  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 PQ NQ HP.
  apply NQ.
  apply PQ.
  apply HP.
Qed.

Theorem not_both_true_and_false : forall P : Prop,
  ~ (P /\ ~P).
Proof.
  intros P A.
  unfold not in A.
  destruct A. apply H0. apply H.
Qed.

Theorem not_true_is_false : forall b : bool,
  b <> true -> b = false.
Proof.
  intros [] H.
  - (* 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.
  - (* b = false *)
    unfold not in H.
    exfalso. (* <=== *)
    apply H. reflexivity.
  - (* b = true *) reflexivity.
Qed.

Lemma True_is_true : True.
Proof. reflexivity. 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.
  (* WORKED IN CLASS *)
  intros P Q [HAB HBA].
  split.
  - (* -> *) apply HBA.
  - (* <- *) apply HAB. Qed.

Lemma not_true_iff_false : forall b,
  b <> true <-> b = false.
Proof.
  (* WORKED IN CLASS *)
  intros b. split.
  - (* -> *) apply not_true_is_false.
  - (* <- *)
    intros H. rewrite H. intros H'. inversion 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 [HP|[HQ HR]]. split.
    + left. apply HP.
    + left. apply HP.
    + split.
      * right. apply HQ.
      * right. apply HR.
  - intros [[HP | HQ] [HP' | HR]].
    + left. apply HP.
    + left. apply HP.
    + left. apply HP'.
    + right. split.
      * apply HQ.
      * apply HR.
Qed.

Require Import Coq.Setoids.Setoid.

Lemma mult_eq_0 :
  forall n m, n * m = 0 -> n = 0 \/ m = 0.
Proof.
  intros.
  destruct n as [|n'].
  - left. reflexivity.
  - right. simpl in H.
    destruct m as [|m'].
    + reflexivity.
    + inversion H.
Qed.

Lemma mult_0 : forall n m, n * m = 0 <-> n = 0 \/ m = 0.
Proof.
  intros.
  split.
  - intros. apply mult_eq_0. apply H.
  - intros [HN | HM].
    + inversion HN. reflexivity.
    + inversion HM. rewrite n_times_m_comm. reflexivity.
Qed.

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

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

Lemma apply_iff_example :
  forall n m : nat, n * m = 0 -> n = 0 \/ m = 0.
Proof.
  intros n m H. apply mult_0. apply H.
Qed.

Lemma four_is_even : exists n : nat, 4 = n + n.
Proof.
  exists 2. reflexivity.
Qed.

Theorem exists_example_2 : forall n,
  (exists m, n = 4 + m) ->
  (exists o, n = 2 + o).
Proof.
  (* WORKED IN CLASS *)
  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.
  unfold not.
  intros X P A J.
  destruct J.
  apply H. apply A.
Qed.


(** * Prop: Propositions and Evidence *)

Require Export Logic.

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

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

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

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

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

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

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

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

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

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

Theorem double_even : forall n,
  ev (double n).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

(** **** Exercise: 2 stars (b_times2)  *)
Theorem b_times2: forall n, beautiful n -> beautiful (2*n).
Proof.
    (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars (b_timesm)  *)
Theorem b_timesm: forall n m, beautiful n -> beautiful (m*n).
Proof.
   (* FILL IN HERE *) Admitted.
(** [] *)

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

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

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

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

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

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

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

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

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

(* FILL IN HERE *)
[]
*)

(** **** Exercise: 1 star (gorgeous_plus13)  *)
Theorem gorgeous_plus13: forall n,
  gorgeous n -> gorgeous (13+n).
Proof.
   (* FILL IN HERE *) Admitted.
(** [] *)

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

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

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

(** *** *)

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

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

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

(** **** Exercise: 2 stars (gorgeous_sum)  *)
Theorem gorgeous_sum : forall n m,
  gorgeous n -> gorgeous m -> gorgeous (n + m).
Proof.
 (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars, advanced (beautiful__gorgeous)  *)
Theorem beautiful__gorgeous : forall n, beautiful n -> gorgeous n.
Proof.
 (* FILL IN HERE *) Admitted.
(** [] *)

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

Lemma helper_g_times2 : forall x y z, x + (z + y) = z + x + y.
Proof.
   (* FILL IN HERE *) Admitted.

Theorem g_times2: forall n, gorgeous n -> gorgeous (2*n).
Proof.
   intros n H. simpl.
   induction H.
   (* FILL IN HERE *) Admitted.
(** [] *)

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

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

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

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

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

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

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

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

Theorem ev_sum : forall n m,
   ev n -> ev m -> ev (n+m).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

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

 *)

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

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

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

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

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

(** ** The Inversion Tactic Revisited *)

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

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

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

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

(** **** Exercise: 1 star (inversion_practice)  *)
Theorem SSSSev__even : forall n,
  ev (S (S (S (S n)))) -> ev n.
Proof.
  (* FILL IN HERE *) Admitted.

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

Theorem even5_nonsense :
  ev 5 -> 2 + 2 = 9.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

Theorem ev_ev__ev : forall n m,
  ev (n+m) -> ev n -> ev m.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

Theorem ev_plus_plus : forall n m p,
  ev (n+m) -> ev (n+p) -> ev (m+p).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Module LeModule.

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

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

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

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

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

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

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

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

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

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

End LeModule.

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

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

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

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

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

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

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

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

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

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

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

Lemma le_trans : forall m n o, m <= n -> n <= o -> m <= o.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem O_le_n : forall n,
  0 <= n.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem n_le_m__Sn_le_Sm : forall n m,
  n <= m -> S n <= S m.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem Sn_le_Sm__n_le_m : forall n m,
  S n <= S m -> n <= m.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem le_plus_l : forall a b,
  a <= a + b.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem plus_lt : forall n1 n2 m,
  n1 + n2 < m ->
  n1 < m /\ n2 < m.
Proof.
 unfold lt.
 (* FILL IN HERE *) Admitted.

Theorem lt_S : forall n m,
  n < m ->
  n < S m.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem ble_nat_true : forall n m,
  ble_nat n m = true -> n <= m.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem le_ble_nat : forall n m,
  n <= m ->
  ble_nat n m = true.
Proof.
  (* Hint: This may be easiest to prove by induction on [m]. *)
  (* FILL IN HERE *) Admitted.

Theorem ble_nat_true_trans : forall n m o,
  ble_nat n m = true -> ble_nat m o = true -> ble_nat n o = true.
Proof.
  (* Hint: This theorem can be easily proved without using [induction]. *)
  (* FILL IN HERE *) Admitted.

(** **** Exercise: 2 stars, optional (ble_nat_false)  *)
Theorem ble_nat_false : forall n m,
  ble_nat n m = false -> ~(n <= m).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

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

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

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

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

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

(* FILL IN HERE *)
[]
*)

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

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

End R.

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

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

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

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

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

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

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

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

(** [] *)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Theorem plus_fact_is_true :
  plus_fact.
Proof. reflexivity.  Qed.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Definition combine_odd_even (Podd Peven : nat -> Prop) : nat -> Prop :=
  (* FILL IN HERE *) admit.

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

Theorem combine_odd_even_intro :
  forall (Podd Peven : nat -> Prop) (n : nat),
    (oddb n = true -> Podd n) ->
    (oddb n = false -> Peven n) ->
    combine_odd_even Podd Peven n.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem combine_odd_even_elim_odd :
  forall (Podd Peven : nat -> Prop) (n : nat),
    combine_odd_even Podd Peven n ->
    oddb n = true ->
    Podd n.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem combine_odd_even_elim_even :
  forall (Podd Peven : nat -> Prop) (n : nat),
    combine_odd_even Podd Peven n ->
    oddb n = false ->
    Peven n.
Proof.
  (* FILL IN HERE *) Admitted.

(** [] *)

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

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

(*
Fixpoint true_upto_n__true_everywhere
(* FILL IN HERE *)

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

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


Inductive B:Type :=
|Bt
|Bf
|Bcom : B -> B -> B.

Inductive Br:B->B->Prop:=
|Brf (B1 :B): Br (Bcom Bf B1) B1
|Brt (B1 :B): Br (Bcom Bt B1) Bt.

Module NatPlayground.

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

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

End NatPlayground.

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

Compute minustwo 3.

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

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

Module NatPlayground2.

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

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

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

  End NatPlayground2.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  Theorem andb_true_elim2 : forall b c:bool,
      andb b c = true -> c = true.
  Proof.
    intros [] [] H.
    - reflexivity.
      Admitted.

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

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

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

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


Require Import Arith.

Theorem AdditiveAssociativity : forall n m k : nat, n + (m + k) = (n + m) + k.
Proof.
  intros n m k.
  induction n.
  simpl. reflexivity.
  simpl. rewrite <- IHn. reflexivity.
Qed.

Theorem AdditiveCommutativity : forall n m : nat, n + m = m + n.
Proof.
  induction n. induction m. reflexivity.
  simpl. rewrite <- IHm. simpl. reflexivity.
  simpl. induction m. rewrite -> IHn. simpl. reflexivity.
  simpl. rewrite -> IHn. simpl. rewrite <- IHm. rewrite IHn. reflexivity.
Qed.

Theorem IdAdd : forall n : nat, n + 0 = n.
Proof.
  intros n. rewrite AdditiveCommutativity. simpl. reflexivity.
Qed.

Lemma l0 : forall n m : nat, n + m = n -> m = 0.
Proof.
  induction n. simpl. trivial. simpl. auto.
  Qed.

Lemma l2 : forall n m k : nat, n + m + k = n + (m + k).
Proof.
  intros n m k.
  rewrite AdditiveAssociativity. reflexivity.
Qed.

Lemma l3 : forall n m k j : nat, n + m + k + j = n + (m + k) + j.
Proof.
  intros n m j k.
  rewrite AdditiveAssociativity. reflexivity.
Qed.

Theorem Distributive : forall n m k : nat, n * (m + k) = n * m + n * k.
Proof.
  intros n m k.
  induction n. simpl. reflexivity.
  simpl. rewrite -> IHn. simpl. rewrite AdditiveAssociativity. rewrite AdditiveAssociativity.
  rewrite l3. rewrite l3. rewrite (AdditiveCommutativity k (n*m)).
  rewrite AdditiveAssociativity. reflexivity.
Qed.

Theorem MultiplicativeCommutativity : forall n m : nat, n * m = m * n.
Proof.
  induction n.
  induction m. reflexivity. simpl. rewrite <- IHm. simpl. reflexivity.
  induction m. simpl. rewrite IHn. simpl. reflexivity.
  simpl. rewrite <- IHm. simpl. rewrite IHn. simpl. rewrite AdditiveAssociativity.
  rewrite AdditiveAssociativity. rewrite IHn. rewrite (AdditiveCommutativity m n).
  reflexivity.
Qed.

Theorem LeftCancelAddFwd : forall n m k : nat, n + m = n + k -> m = k.
Proof.
  intros n m k.
  induction n. simpl. trivial. auto.
Qed.

Theorem LeftCancelAddBack : forall n m k : nat, m = k -> n + m = n + k.
Proof.
  intros n m k.
  induction n. simpl. trivial. simpl. auto.
Qed.

Theorem LeftCancelAdd : forall n m k : nat, m = k <-> n + m = n + k.
Proof.
  split.
  induction n. simpl. trivial. simpl. auto.
  induction n. simpl. trivial. auto.
Qed.

Theorem MultiplicativeAssociativity : forall n m k : nat, n * (m * k) = (n *m ) * k.
Proof.
  intros n m k.
  induction n. simpl. reflexivity.
  simpl. rewrite -> IHn. rewrite (MultiplicativeCommutativity (m + n*m) k).
  rewrite Distributive. rewrite <- IHn.
  rewrite (MultiplicativeCommutativity m k). rewrite <- LeftCancelAdd.
  rewrite (MultiplicativeCommutativity k m). rewrite IHn. rewrite MultiplicativeCommutativity.
  reflexivity.
Qed.


Require Import Arith.

Inductive even : nat -> Prop :=
  | O_even : even 0
  | plus_2_even : forall n:nat, even n -> even (S (S n)).

Hint Resolve O_even plus_2_even.

Fixpoint mult2 (n:nat) : nat :=
  match n with
  | O => 0
  | S p => S (S (mult2 p))
  end.

Lemma mult2_even : forall n:nat, even (mult2 n).
Proof.
 induction n; simpl; auto.
Qed.

Theorem sum_even : forall n p:nat, even n -> even p -> even (n + p).
Proof.
 intros n p Heven_n; elim Heven_n; simpl; auto.
Qed.

Hint Resolve sum_even.

Lemma square_even : forall n:nat, even n -> even (n * n).
Proof.
 intros n Hn; elim Hn; simpl; auto.
 Check mult_comm.
 intros n0 H0 H1; rewrite (mult_comm n0 (S (S n0))).
 simpl.
 auto.
 right.
 apply sum_even; auto.
Qed.

Lemma even_mult2 : forall n:nat, even n -> (exists p, n = mult2 p).
Proof.
 induction 1.
 exists 0;simpl;auto.
 case IHeven; intros p Hp.
 exists (S p); simpl; auto.
Qed.


Require Import Coq.Relations.Relations.
From Coq.Classes Require Import RelationClasses Morphisms.
From algebra Require Import Semigroups Monoids.

Section Groups.
Context {Carrier: Type}.
Context (equiv: relation Carrier).
Context {R_equiv: Equivalence equiv}.
Context (op: Carrier -> Carrier -> Carrier).
Context {op_proper: Proper (equiv ==> equiv ==> equiv) op}.
Context (ident: Carrier).
Context (inv: Carrier -> Carrier).
Context {inv_proper: Proper (equiv ==> equiv) inv}.

Infix "==" := equiv (at level 60, no associativity).
Infix "<o>" := op (at level 40, left associativity).

Class Group := {
  group_monoid :> Monoid equiv op ident;
  group_inv_l:
    forall (a: Carrier), inv a <o> a == ident;
  group_inv_r:
    forall (a: Carrier), a <o> inv a == ident;
}.

Context {group: Group}.

Definition group_assoc :=
  semigroup_assoc equiv op.
Definition group_op_l :=
  semigroup_op_l equiv op.
Definition group_op_l_solo :=
  monoid_op_l_solo equiv op ident.
Definition group_op_r :=
  semigroup_op_r equiv op.
Definition group_op_r_solo :=
  monoid_op_r_solo equiv op ident.
Definition group_ident_l :=
  monoid_ident_l equiv op ident.
Definition group_ident_r :=
  monoid_ident_r equiv op ident.

Lemma group_cancel_l (a b c: Carrier):
  c <o> a == c <o> b -> a == b.
Proof.
  intros H.
  apply group_op_l with (c := inv c) in H.
  setoid_rewrite <- (monoid_ident_l equiv op ident).
  setoid_rewrite <- (group_inv_l c).
  setoid_rewrite (semigroup_assoc equiv op).
  assumption.
Qed.

Lemma group_cancel_r (a b c: Carrier):
  a <o> c == b <o> c -> a == b.
Proof.
  intros H.
  apply group_op_r with (c := inv c) in H.
  setoid_rewrite <- (monoid_ident_r equiv op ident).
  setoid_rewrite <- (group_inv_r c).
  setoid_rewrite <- (semigroup_assoc equiv op).
  assumption.
Qed.

Lemma group_move_l (a b c: Carrier):
  a <o> b == c -> b == inv a <o> c.
Proof.
  intros H.
  apply group_cancel_l with (a).
  setoid_rewrite <- (semigroup_assoc equiv op).
  setoid_rewrite group_inv_r.
  setoid_rewrite (monoid_ident_l equiv op ident).
  assumption.
Qed.

Lemma group_move_r (a b c: Carrier):
  a <o> b == c -> a == c <o> inv b.
Proof.
  intros H.
  apply group_cancel_r with (b).
  setoid_rewrite (semigroup_assoc equiv op).
  setoid_rewrite group_inv_l.
  setoid_rewrite (monoid_ident_r equiv op ident).
  assumption.
Qed.

Theorem group_idemp_ident (a: Carrier):
  a <o> a == a ->
  a == ident.
Proof.
  intros H.
  apply group_cancel_r with (a).
  setoid_rewrite (monoid_ident_l equiv op ident).
  assumption.
Qed.

Theorem group_inv_l_unique (a aInv: Carrier):
  aInv <o> a == ident ->
  aInv == inv a.
Proof.
  intros H.
  apply group_cancel_r with (a).
  setoid_rewrite group_inv_l.
  assumption.
Qed.

Theorem group_inv_r_unique (a aInv: Carrier):
  a <o> aInv == ident ->
  aInv == inv a.
Proof.
  intros H.
  apply group_cancel_l with (a).
  setoid_rewrite group_inv_r.
  assumption.
Qed.

Theorem group_inv_involute (a: Carrier):
  inv (inv a) == a.
Proof.
  symmetry.
  apply group_inv_r_unique.
  apply group_inv_l.
Qed.

Theorem group_inv_op (a b: Carrier):
  inv (a <o> b) == inv b <o> inv a.
Proof.
  symmetry.
  apply group_inv_r_unique.
  setoid_rewrite <- (semigroup_assoc equiv op).
  symmetry.
  apply group_move_r.
  setoid_rewrite (monoid_ident_l equiv op ident).
  apply group_move_r.
  reflexivity.
Qed.

Theorem group_solution_r (a b: Carrier):
  (exists (x: Carrier), x <o> a == b) /\
  (forall (x: Carrier),
    x <o> a == b -> x == b <o> inv a).
Proof.
  split.
  { exists (b <o> inv a).
    setoid_rewrite (semigroup_assoc equiv op).
    apply (monoid_op_l_solo equiv op ident).
    apply group_inv_l. }
  { intros x.
    apply group_move_r. }
Qed.

Theorem group_solution_l (a b: Carrier):
  (exists (x: Carrier), a <o> x == b) /\
  (forall (x: Carrier),
    a <o> x == b -> x == inv a <o> b).
Proof.
  split.
  { exists (inv a <o> b).
    setoid_rewrite <- (semigroup_assoc equiv op).
    apply (monoid_op_r_solo equiv op ident).
    apply group_inv_r. }
  { intros x.
    apply group_move_l. }
Qed.

Theorem group_inv_ident:
  inv ident == ident.
Proof.
  symmetry.
  apply group_inv_r_unique.
  apply group_ident_r.
Qed.

Section Subgroups.
Context (P: Carrier -> Prop).
Context (P_proper: Proper (equiv ==> iff) P).

Lemma subset_op_inv_closed_ident:
  (exists (x: Carrier), P x) ->
  (forall (a b: Carrier),
    P a -> P b -> P (a <o> inv b)) ->
  P ident.
Proof.
  intros [x HPx] Hop_inv.
  specialize (Hop_inv x x HPx HPx).
  assert (x <o> inv x == ident) by apply group_inv_r.
  apply P_proper in H.
  apply H.
  assumption.
Qed.

Lemma subset_op_inv_closed_inv_closed:
  (exists (x: Carrier), P x) ->
  (forall (a b: Carrier),
    P a -> P b -> P (a <o> inv b)) ->
  (forall (a: Carrier), P a -> P (inv a)).
Proof.
  intros Hx Hop_inv a HPa.
  assert (P ident)
    as HPident
    by apply (subset_op_inv_closed_ident Hx Hop_inv).
  specialize (Hop_inv ident a HPident HPa).
  assert (ident <o> inv a == inv a)
    by apply (monoid_ident_l equiv op ident).
  apply P_proper in H.
  apply H.
  assumption.
Qed.

Lemma subset_op_inv_closed_op_closed:
  (exists (x: Carrier), P x) ->
  (forall (a b: Carrier),
    P a -> P b -> P (a <o> inv b)) ->
  (forall (a b: Carrier), P a -> P b -> P (a <o> b)).
Proof.
  intros Hx Hop_inv a b HPa HPb.
  assert (P (inv b))
    as HPb'
    by apply (subset_op_inv_closed_inv_closed Hx Hop_inv b HPb).
  specialize (Hop_inv a (inv b) HPa HPb').
  assert (a <o> inv (inv b) == a <o> b)
    by (apply (semigroup_op_l equiv op); apply group_inv_involute).
  apply P_proper in H.
  apply H.
  assumption.
Qed.

Class Subgroup := {
  subgroup_op_closed:
    forall (a b: Carrier), P a -> P b -> P (a <o> b);
  subgroup_inv_closed:
    forall (a: Carrier), P a -> P (inv a);
  subgroup_ident: P ident;
}.

Theorem subset_op_inv_closed_subgroup:
  (exists (x: Carrier), P x) ->
  (forall (a b: Carrier),
    P a -> P b -> P (a <o> inv b)) ->
  Subgroup.
Proof.
  intros Hx Hop_inv.
  constructor.
  { apply subset_op_inv_closed_op_closed;
    assumption. }
  { apply subset_op_inv_closed_inv_closed;
    assumption. }
  { apply subset_op_inv_closed_ident;
    assumption. }
Qed.

Context {subgroup: Subgroup}.

Lemma subgroup_inv_inv_closed (a: Carrier):
  P (inv a) -> P a.
Proof.
  intros HPa'.
  apply subgroup_inv_closed in HPa'.
  assert (inv (inv a) == a)
    by apply group_inv_involute.
  apply P_proper in H.
  apply H.
  assumption.
Qed.

Definition left_congru (a b: Carrier) :=
  P (inv a <o> b).
Definition right_congru (a b: Carrier) :=
  P (a <o> inv b).

Theorem left_congru_proper:
  Proper (equiv ==> equiv ==> iff) left_congru.
Proof.
  intros a0 a1 Ha b0 b1 Hb.
  unfold left_congru.
  split;
    intros HPa'b;
  assert (inv a0 <o> b0 == inv a1 <o> b1);
    try (apply op_proper;
      [apply inv_proper |];
      assumption);
  apply P_proper in H;
  apply H;
  assumption.
Qed.

Theorem right_congru_proper:
  Proper (equiv ==> equiv ==> iff) right_congru.
Proof.
  intros a0 a1 Ha b0 b1 Hb.
  unfold right_congru.
  split;
    intros Hab';
  assert (a0 <o> inv b0 == a1 <o> inv b1);
    try (apply op_proper;
      [| apply inv_proper];
      assumption);
  apply P_proper in H;
  apply H;
  assumption.
Qed.

Lemma left_congru_reflexive (a: Carrier):
  left_congru a a.
Proof.
  unfold left_congru.
  assert (inv a <o> a == ident)
    by apply group_inv_l.
  apply P_proper in H.
  apply H.
  apply subgroup_ident.
Qed.

Lemma left_congru_symmetric (a b: Carrier):
  left_congru a b -> left_congru b a.
Proof.
  unfold left_congru.
  intros HPa'b.
  apply subgroup_inv_closed in HPa'b.
  assert (inv (inv a <o> b) == inv b <o> a).
  { setoid_rewrite group_inv_op.
    setoid_rewrite group_inv_involute.
    reflexivity. }
  { apply P_proper in H.
    apply H.
    assumption. }
Qed.

Lemma left_congru_transitive (a b c: Carrier):
  left_congru a b ->
  left_congru b c ->
  left_congru a c.
Proof.
  unfold left_congru.
  intros HPa'b HPb'c.
  assert (inv a <o> b <o> (inv b <o> c) == inv a <o> c).
  { setoid_rewrite <- (semigroup_assoc equiv op).
    apply (semigroup_op_r equiv op).
    setoid_rewrite (semigroup_assoc equiv op).
    apply (monoid_op_l_solo equiv op ident).
    apply group_inv_r. }
  { apply P_proper in H.
    apply H.
    apply subgroup_op_closed;
      assumption. }
Qed.

#[global]
Instance left_congru_equiv: Equivalence left_congru := {
  Equivalence_Reflexive := left_congru_reflexive;
  Equivalence_Symmetric := left_congru_symmetric;
  Equivalence_Transitive := left_congru_transitive;
}.

Lemma right_congru_reflexive (a: Carrier):
  right_congru a a.
Proof.
  unfold right_congru.
  assert (a <o> inv a == ident)
    by apply group_inv_r.
  apply P_proper in H.
  apply H.
  apply subgroup_ident.
Qed.

Lemma right_congru_symmetric (a b: Carrier):
  right_congru a b -> right_congru b a.
Proof.
  unfold right_congru.
  intros HPab'.
  apply subgroup_inv_closed in HPab'.
  assert (inv (a <o> inv b) == b <o> inv a).
  { setoid_rewrite group_inv_op.
    setoid_rewrite group_inv_involute.
    reflexivity. }
  { apply P_proper in H.
    apply H.
    assumption. }
Qed.

Lemma right_congru_transitive (a b c: Carrier):
  right_congru a b ->
  right_congru b c ->
  right_congru a c.
Proof.
  unfold right_congru.
  intros HPab' HPbc'.
  assert (a <o> inv b <o> (b <o> inv c) == a <o> inv c).
  { setoid_rewrite <- (semigroup_assoc equiv op).
    apply (semigroup_op_r equiv op).
    setoid_rewrite (semigroup_assoc equiv op).
    apply (monoid_op_l_solo equiv op ident).
    apply group_inv_l. }
  { apply P_proper in H.
    apply H.
    apply subgroup_op_closed;
      assumption. }
Qed.

#[global]
Instance right_congru_equiv: Equivalence right_congru := {
  Equivalence_Reflexive := right_congru_reflexive;
  Equivalence_Symmetric := right_congru_symmetric;
  Equivalence_Transitive := right_congru_transitive;
}.

Definition left_cosets_eq (a b: Carrier) :=
  forall (m: Carrier),
    P m ->
    exists (n: Carrier), P n /\ a <o> m == b <o> n.

Lemma subgroup_equiv_left_congru_cosets_eq (a b: Carrier):
  left_congru a b <-> left_cosets_eq a b.
Proof.
  unfold left_congru, left_cosets_eq.
  split;
    [intros HPa'b m HPm | intros Hcoset].
  { exists (inv b <o> (a <o> m)).
    split.
    { apply subgroup_inv_closed in HPa'b.
      assert (inv (inv a <o> b) <o> m == inv b <o> (a <o> m)).
      { setoid_rewrite group_inv_op.
        setoid_rewrite group_inv_involute.
        apply (semigroup_assoc equiv op). }
      { apply P_proper in H.
        apply H.
        apply subgroup_op_closed;
          assumption. } }
    { setoid_rewrite <- (semigroup_assoc equiv op).
      symmetry.
      apply (monoid_op_r_solo equiv op ident).
      apply group_inv_r. } }
  { specialize (Hcoset ident subgroup_ident).
    inversion_clear Hcoset as [n [HPn H]].
    setoid_rewrite (monoid_ident_r equiv op ident) in H.
    symmetry in H.
    apply group_move_l in H.
    assert (inv n == inv a <o> b).
    { setoid_rewrite H.
      setoid_rewrite group_inv_op.
      setoid_rewrite group_inv_involute.
      reflexivity. }
    { apply P_proper in H0.
      apply H0.
      apply subgroup_inv_closed.
      assumption. } }
Qed.

Definition right_cosets_eq (a b: Carrier) :=
  forall (m: Carrier),
    P m ->
    exists (n: Carrier), P n /\ m <o> a == n <o> b.

Lemma subgroup_equiv_right_congru_cosets_eq (a b: Carrier):
  right_congru a b <-> right_cosets_eq a b.
Proof.
  unfold right_congru, right_cosets_eq.
  split;
    [intros HPab' m HPm | intros Hcoset].
  { exists (m <o> (a <o> inv b)).
    split;
      [apply subgroup_op_closed; assumption |].
    setoid_rewrite <- (semigroup_assoc equiv op).
    setoid_rewrite (semigroup_assoc equiv op).
    symmetry.
    apply (monoid_op_l_solo equiv op ident).
    apply group_inv_l. }
  { specialize (Hcoset ident subgroup_ident).
    inversion_clear Hcoset as [n [HPn H]].
    setoid_rewrite (monoid_ident_l equiv op ident) in H.
    symmetry in H.
    apply group_move_r in H.
    setoid_rewrite <- H.
    assumption. }
Qed.

Let normal_subgroup_congru_coincide := (* 1 *)
  forall (a b: Carrier),
    left_congru a b <-> right_congru a b.
Let normal_subgroup_cosets_eq_coincide := (* 2 *)
  forall (a b: Carrier),
    left_cosets_eq a b <-> right_cosets_eq a b.
Let normal_subgroup_cosets_coincide := (* 3 *)
  forall (m: Carrier),
    P m ->
    forall (a: Carrier),
      exists (n: Carrier),
        P n /\ a <o> m == n <o> a.
Let normal_subgroup_conj_closed := (* 4 *)
  forall (n: Carrier),
    P n ->
    forall (a: Carrier), P (a <o> n <o> inv a).
Let normal_subgroup_conj_closed_exact := (* 5 *)
  forall (n a: Carrier),
    P n <-> P (a <o> n <o> inv a).

Theorem normal_subgroup_equiv_congru_cosets_eq:
  normal_subgroup_congru_coincide <->
  normal_subgroup_cosets_eq_coincide.
Proof.
  split;
    [intros Hcongru a b | intros Hcosets a b].
  { specialize (Hcongru a b).
    split;
      [intros Hlcoset | intros Hrcoset].
    { apply subgroup_equiv_right_congru_cosets_eq.
      apply Hcongru.
      apply subgroup_equiv_left_congru_cosets_eq.
      assumption. }
    { apply subgroup_equiv_left_congru_cosets_eq.
      apply Hcongru.
      apply subgroup_equiv_right_congru_cosets_eq.
      assumption. } }
  { specialize (Hcosets a b).
    split;
      [intros Hlcongru | intros Hrcongru].
    { apply subgroup_equiv_right_congru_cosets_eq.
      apply Hcosets.
      apply subgroup_equiv_left_congru_cosets_eq.
      assumption. }
    { apply subgroup_equiv_left_congru_cosets_eq.
      apply Hcosets.
      apply subgroup_equiv_right_congru_cosets_eq.
      assumption. } }
Qed.

Theorem normal_subgroup_equiv_cosets_conj:
  normal_subgroup_cosets_coincide <->
  normal_subgroup_conj_closed.
Proof.
  split;
    [intros Hcosets | intros Hconj].
  { intros n HPn a.
    specialize (Hcosets n HPn a).
    inversion_clear Hcosets as [m [HPm H]].
    symmetry in H.
    apply group_move_r in H.
    setoid_rewrite <- H.
    assumption. }
  { intros m HPm a.
    exists (a <o> m <o> inv a).
    split.
    { apply Hconj.
      assumption. }
    { setoid_rewrite (semigroup_assoc equiv op).
      symmetry.
      apply (monoid_op_l_solo equiv op ident).
      apply group_inv_l. } }
Qed.

Theorem normal_subgroup_equiv_conj_closed:
  normal_subgroup_conj_closed <->
  normal_subgroup_conj_closed_exact.
Proof.
  split;
    [intros H | intros Hexact].
  { intros n a.
    split;
      [intros HPn | intros Hconj_n].
    { apply H.
      assumption. }
    { apply H in Hconj_n.
      specialize (Hconj_n (inv a)).
      repeat setoid_rewrite <- (semigroup_assoc equiv op) in Hconj_n.
      setoid_rewrite (group_inv_l a) in Hconj_n.
      setoid_rewrite (monoid_ident_l equiv op ident) in Hconj_n.
      setoid_rewrite (semigroup_assoc equiv op) in Hconj_n.
      setoid_rewrite (group_inv_r (inv a)) in Hconj_n.
      setoid_rewrite (monoid_ident_r equiv op ident) in Hconj_n.
      assumption. } }
  { intros n HPn a.
    apply Hexact.
    assumption. }
Qed.

Theorem normal_subgroup_equiv_congru_conj:
  normal_subgroup_congru_coincide <->
  normal_subgroup_conj_closed.
Proof.
  split;
    [intros Hcongru | intros Hconj].
  { intros n HPn a.
    assert (a <o> n <o> inv a == a <o> inv (a <o> inv n)).
    { setoid_rewrite group_inv_op.
      setoid_rewrite group_inv_involute.
      apply (semigroup_assoc equiv op). }
    { apply P_proper in H.
      apply H.
      apply Hcongru.
      assert (inv a <o> (a <o> inv n) == inv n).
      { setoid_rewrite <- (semigroup_assoc equiv op).
        apply (monoid_op_r_solo equiv op ident).
        apply group_inv_l. }
      { apply P_proper in H0.
        apply H0.
        apply subgroup_inv_closed.
        assumption. } } }
  { intros a b.
    split;
      [intros Hlcongru | intros Hrcongru].
    { specialize (Hconj (inv a <o> b) Hlcongru b).
      assert (b <o> (inv a <o> b) <o> inv b == b <o> inv a).
      { setoid_rewrite (semigroup_assoc equiv op).
        apply (semigroup_op_l equiv op).
        setoid_rewrite (semigroup_assoc equiv op).
        apply (monoid_op_l_solo equiv op ident).
        apply group_inv_r. }
      { apply P_proper in H.
        symmetry.
        apply H.
        assumption. } }
    { specialize (Hconj (a <o> inv b) Hrcongru (inv b)).
      assert (inv b <o> (a <o> inv b) <o> inv (inv b) == inv b <o> a).
      { setoid_rewrite (semigroup_assoc equiv op).
        apply (semigroup_op_l equiv op).
        setoid_rewrite (semigroup_assoc equiv op).
        apply (monoid_op_l_solo equiv op ident).
        apply group_inv_r. }
      { apply P_proper in H.
        symmetry.
        apply H.
        assumption. } } }
Qed.

Corollary normal_subgroup_equiv_congru_cosets:
  normal_subgroup_congru_coincide <->
  normal_subgroup_cosets_coincide.
Proof.
  split;
    [intros Hcongru | intros Hcosets].
  { apply normal_subgroup_equiv_cosets_conj.
    apply normal_subgroup_equiv_congru_conj.
    assumption. }
  { apply normal_subgroup_equiv_congru_conj.
    apply normal_subgroup_equiv_cosets_conj.
    assumption. }
Qed.

Corollary normal_subgroup_equiv_congru_conj_exact:
  normal_subgroup_congru_coincide <->
  normal_subgroup_conj_closed_exact.
Proof.
  split;
    [intros Hcongr | intros Hconj].
  { apply normal_subgroup_equiv_conj_closed.
    apply normal_subgroup_equiv_congru_conj.
    assumption. }
  { apply normal_subgroup_equiv_congru_conj.
    apply normal_subgroup_equiv_conj_closed.
    assumption. }
Qed.

Corollary normal_subgroup_equiv_cosets_eq_cosets:
  normal_subgroup_cosets_eq_coincide <->
  normal_subgroup_cosets_coincide.
Proof.
  split;
    [intros Hcoset_eq | intros Hcosets].
  { apply normal_subgroup_equiv_congru_cosets.
    apply normal_subgroup_equiv_congru_cosets_eq.
    assumption. }
  { apply normal_subgroup_equiv_congru_cosets_eq.
    apply normal_subgroup_equiv_congru_cosets.
    assumption. }
Qed.

Corollary normal_subgroup_equiv_cosets_eq_conj:
  normal_subgroup_cosets_eq_coincide <->
  normal_subgroup_conj_closed.
Proof.
  split;
    [intros Hcoset_eq | intros Hconj].
  { apply normal_subgroup_equiv_congru_conj.
    apply normal_subgroup_equiv_congru_cosets_eq.
    assumption. }
  { apply normal_subgroup_equiv_congru_cosets_eq.
    apply normal_subgroup_equiv_congru_conj.
    assumption. }
Qed.

Corollary normal_subgroup_equiv_cosets_eq_conj_exact:
  normal_subgroup_cosets_eq_coincide <->
  normal_subgroup_conj_closed_exact.
Proof.
  split;
    [intros Hcoset_eq | intros Hconj_exact].
  { apply normal_subgroup_equiv_conj_closed.
    apply normal_subgroup_equiv_cosets_eq_conj.
    assumption. }
  { apply normal_subgroup_equiv_cosets_eq_conj.
    apply normal_subgroup_equiv_conj_closed.
    assumption. }
Qed.

Corollary normal_subgroup_equiv_cosets_conj_exact:
  normal_subgroup_cosets_coincide <->
  normal_subgroup_conj_closed_exact.
Proof.
  split;
    [intros Hcosets | intros Hconj_exact].
  { apply normal_subgroup_equiv_conj_closed.
    apply normal_subgroup_equiv_cosets_conj.
    assumption. }
  { apply normal_subgroup_equiv_cosets_conj.
    apply normal_subgroup_equiv_conj_closed.
    assumption. }
Qed.

Section NormalSubgroups.
Lemma quotient_op_proper:
  normal_subgroup_congru_coincide ->
  Proper (left_congru ==> left_congru ==> left_congru) op.
Proof.
  intros congru_coincide a0 a1 Ha b0 b1 Hb.
  assert (inv (a0 <o> b0) <o> (a1 <o> b1) == inv b0 <o> (inv a0 <o> a1 <o> b1)).
  { setoid_rewrite group_inv_op.
    setoid_rewrite (semigroup_assoc equiv op).
    reflexivity. }
  { apply P_proper in H.
    apply H; clear H.
    apply congru_coincide.
    assert (b0 <o> inv (inv a0 <o> a1 <o> b1) == b0 <o> inv b1 <o>
      inv (inv a0 <o> a1)).
    { repeat setoid_rewrite group_inv_op.
      setoid_rewrite (semigroup_assoc equiv op).
      reflexivity. }
    { apply P_proper in H.
      apply H; clear H.
      apply subgroup_op_closed;
        [apply congru_coincide | apply subgroup_inv_closed];
        assumption. } }
Qed.

Lemma quotient_inv_proper:
  normal_subgroup_congru_coincide ->
  Proper (left_congru ==> left_congru) inv.
Proof.
  intros congru_coincide a0 a1 Ha.
  assert (inv (inv a0) <o> inv a1 == a0 <o> inv a1).
  { apply group_op_r.
    apply group_inv_involute. }
  { apply P_proper in H.
    apply H.
    apply congru_coincide.
    assumption. }
Qed.

Lemma quotient_semigroup:
  normal_subgroup_congru_coincide ->
  Semigroup left_congru op.
Proof.
  intros congru_coincide.
  constructor.
  intros a b c.
  assert (inv (a <o> b <o> c) <o> (a <o> (b <o> c)) == ident);
    [| apply P_proper in H; apply H; apply subgroup_ident].
  symmetry.
  apply group_move_l.
  setoid_rewrite (monoid_ident_r equiv op ident).
  apply (semigroup_assoc equiv op).
Qed.

Lemma quotient_monoid:
  normal_subgroup_congru_coincide ->
  Monoid left_congru op ident.
Proof.
  intros congru_coincide.
  constructor;
    [ apply quotient_semigroup;
      apply congru_coincide | |];
    intros a.
  { assert (inv (ident <o> a) <o> a == ident).
    { symmetry.
      apply group_move_l.
      setoid_rewrite (monoid_ident_r equiv op ident).
      apply (monoid_ident_l equiv op ident). }
    { apply P_proper in H.
      apply H.
      apply subgroup_ident. } }
  { assert (inv (a <o> ident) <o> a == ident).
    { symmetry.
      apply group_move_l.
      repeat setoid_rewrite (monoid_ident_r equiv op ident).
      reflexivity. }
    { apply P_proper in H.
      apply H.
      apply subgroup_ident. } }
Qed.
End NormalSubgroups.
End Subgroups.
End Groups.

Section NormalSubgroups.
Context {Carrier: Type}.
Context (equiv: relation Carrier).
Context {R_equiv: Equivalence equiv}.
Context (op: Carrier -> Carrier -> Carrier).
Context {op_proper: Proper (equiv ==> equiv ==> equiv) op}.
Context (ident: Carrier).
Context (inv: Carrier -> Carrier).
Context {inv_proper: Proper (equiv ==> equiv) inv}.
Context {group: Group equiv op ident inv}.
Context (P: Carrier -> Prop).
Context {P_proper: Proper (equiv ==> iff) P}.
Context {subgroup: Subgroup op ident inv P}.

Infix "==" := equiv (at level 60, no associativity).
Infix "<o>" := op (at level 40, left associativity).

Let normal_subgroup_congru_coincide :=
  forall (a b: Carrier),
    left_congru op inv P a b <->
    right_congru op inv P a b.

Theorem quotient_normal_subgroup_group:
  normal_subgroup_congru_coincide ->
  Group (left_congru op inv P) op ident inv.
Proof.
  intros congru_coincide.
  constructor;
    [apply (quotient_monoid equiv op ident inv P P_proper);
      apply congru_coincide | |];
    intros a.
  { assert (inv (inv a <o> a) <o> ident == ident).
    { symmetry.
      apply (group_move_l equiv op ident inv).
      setoid_rewrite (monoid_ident_r equiv op ident).
      apply (group_inv_l equiv op ident inv). }
    { apply P_proper in H.
      apply H.
      apply (subgroup_ident op ident inv P). } }
  { assert (inv (a <o> inv a) <o> ident == ident).
    { symmetry.
      apply (group_move_l equiv op ident inv).
      setoid_rewrite (monoid_ident_r equiv op ident).
      apply (group_inv_r equiv op ident inv). }
    { apply P_proper in H.
      apply H.
      apply (subgroup_ident op ident inv P). } }
Qed.
End NormalSubgroups.


(****** Formalizing certain properties from combinatorics ***************)
Require Import Reals Psatz.
Require Import Omega Init.Nat Arith.EqNat.
Require Import Coq.Arith.PeanoNat Coq.Structures.Equalities.

Open Scope R_scope.

Definition nchoosek (n k: nat) : R := INR (fact n) / (INR (fact k) * INR (fact (n-k))).

Lemma nplus1cr: forall (r n :nat), (r <=n)%nat -> nchoosek (n+1) r = (INR (n+1) * (/ INR (n-r+1))) * nchoosek n r.
Proof.
intros.
unfold nchoosek.
assert ( fact (n+1)= ((n+1)%nat * fact n)%nat).
{ assert (S n = (n+1)%nat). { omega. }rewrite <-H0. apply fact_simpl. } rewrite H0.
assert ( fact (n + 1 - r)= ((n-r+1)%nat * fact (n-r))%nat).
{ assert ((n + 1 - r)%nat = S (n-r)). { omega. } rewrite H1.
  assert ((n - r + 1)%nat = S (n-r)). { omega. } rewrite H2. apply fact_simpl.
} rewrite H1.
assert (INR ((n + 1) * fact n) = INR (n+1) * INR (fact n)). { apply mult_INR. } rewrite H2.
assert (INR ((n - r + 1) * fact (n - r))= INR (n-r+1) * INR (fact (n-r))). { apply mult_INR. } rewrite H3.
assert (INR (fact n) / (INR (fact r) * INR (fact (n - r)))= INR (fact n) * (/ INR (fact r)) * (/INR (fact (n - r)))).
{ assert (/ (INR (fact r) * INR (fact (n - r)))=(/ INR (fact r)) * (/INR (fact (n - r)))).
  { apply Rinv_mult_distr. apply INR_fact_neq_0. apply INR_fact_neq_0. }
  assert (INR (fact n) / (INR (fact r) * INR (fact (n - r)))= INR (fact n) * (/ (INR (fact r) * INR (fact (n - r))))). { nra. } rewrite H5.
  rewrite H4. nra.
} rewrite H4.
assert (INR (n + 1) * / INR (n - r + 1) * (INR (fact n) * / INR (fact r) * / INR (fact (n - r)))=
          (INR (n + 1) * INR (fact n) ) * (/ INR (fact r) *  / INR (n - r + 1) * / INR (fact (n - r)))). { nra. } rewrite H5.
assert (INR (n + 1) * INR (fact n) / (INR (fact r) * (INR (n - r + 1) * INR (fact (n - r))))=
          (INR (n + 1) * INR (fact n)) * (/ (INR (fact r) * (INR (n - r + 1) * INR (fact (n - r)))))). { nra. } rewrite H6.
assert (/ (INR (fact r) * (INR (n - r + 1) * INR (fact (n - r))))=(/ INR (fact r) * / INR (n - r + 1) * / INR (fact (n - r)))).
{ assert (/ (INR (fact r) * (INR (n - r + 1) * INR (fact (n - r)))) = (/INR (fact r)) * (/ (INR (n - r + 1) * INR (fact (n - r))))).
  { apply Rinv_mult_distr. apply INR_fact_neq_0. rewrite <-H3. rewrite <-H1. apply INR_fact_neq_0. } rewrite H7.
  assert ( / (INR (n - r + 1) * INR (fact (n - r))) = (/ INR (n - r + 1) ) * (/  INR (fact (n - r)))).
  { apply Rinv_mult_distr.
    assert ( 0< INR (n - r + 1) -> INR (n - r + 1) <> 0). { nra. } apply H8. apply lt_0_INR. omega. apply INR_fact_neq_0. } rewrite H8. nra.
} rewrite H7. nra.
Qed.

Lemma comb_prop_1: forall (n:nat), nchoosek n 0%nat= 1.
Proof.
intros.
assert (n=0%nat \/ (0<n)%nat). { omega. } destruct H.
+ rewrite H.
  unfold nchoosek.
  assert ( (0-0)%nat = 0%nat). { omega. } rewrite H0.
  assert (fact 0=1%nat). { auto. } rewrite H1.
  assert (INR 1=1). { reflexivity. }rewrite H2. nra.
+ unfold nchoosek.
  assert ((n - 0)%nat=n). { omega. } rewrite H0.
  assert (fact 0=1%nat). { auto. }rewrite H1.
  assert (INR 1=1). { reflexivity. }rewrite H2.
  assert ((1 * INR (fact n))=INR (fact n)). { nra. } rewrite H3.
  assert (INR (fact n) / INR (fact n)= INR (fact n) * (/ INR (fact n))). { nra. }rewrite H4.
  apply Rinv_r. assert ( 0< INR (fact n) -> INR (fact n) <> 0). { nra. }  apply H5.
  apply lt_0_INR. apply lt_O_fact.
Qed.

Lemma comb_prop_2: forall (n:nat), (1<=n)%nat -> nchoosek n 1%nat=INR n.
Proof.
intros.
unfold nchoosek.
assert ((fact 1)=1%nat). { auto. } rewrite H0. assert (INR 1=1). { reflexivity. }rewrite H1.
assert (1 * INR (fact (n - 1))= INR (fact (n - 1))). { nra. } rewrite H2.
assert ( fact n = (n* fact (n-1))%nat).
{ induction n.
  + contradict H1. omega.
  + assert ((S n - 1)%nat = n). { omega. }rewrite H3.
    auto.
} rewrite H3.
assert (INR (n * fact (n - 1))= INR n * INR (fact(n-1)) ). { apply mult_INR. } rewrite H4.
assert (INR n * INR (fact (n - 1)) / INR (fact (n - 1))= INR n * (INR (fact (n - 1)) * (/INR (fact (n - 1))))). { nra. }rewrite H5.
assert ((INR (fact (n - 1)) * / INR (fact (n - 1)))=1). { apply Rinv_r. assert ( 0< INR (fact (n - 1)) -> INR (fact (n - 1)) <> 0). { nra. } apply H6.
apply lt_0_INR. apply lt_O_fact. } rewrite H6. nra.
Qed.


From Coq Require Export List NArith.
From Coq Require Import Lia.

Import ListNotations.

#[global] Open Scope N_scope.

Notation "'input' x .. y" := (cons x .. (cons y nil) ..) (at level 200, x at level 0, only parsing).

Definition example : list N := input
199
200
208
210
200
207
240
269
260
263
.

(* Part 1 *)

(* Count the number of consecutive increasing pairs *)
Fixpoint count_increases_ (xs : list N) (acc : N) : N :=
  match xs with
  | [] | _ :: [] => acc
  | x :: (y :: _) as xs =>
    count_increases_ xs (if x <? y then 1 + acc else acc)
  end.

Definition count_increases (xs : list N) : N := count_increases_ xs 0.

Definition solve : list N -> N := count_increases.

(* Compute solve example.  (* 7 *) *)

(* Seems as simple as could be. *)

(* Part 2 *)

(* Count the number of consecutive increasing sums in a sliding window of length 3 *)
Fixpoint count_increases2_ (xs : list N) (acc : N) : N :=
  match xs with
  | x :: (_ :: _ :: y :: _) as xs =>
    count_increases2_ xs (if x <? y then 1 + acc else acc)
  | _ => acc
  end.

Definition count_increases2 (xs : list N) : N := count_increases2_ xs 0.

Definition solve2 : list N -> N := count_increases2.

(* Compute solve2 example. (* 5 *) *)

Definition solve12 (i : list N) : N * N := (solve i, solve2 i).

(* This solution avoids computing the sums. We can prove that it's equivalent to a more literal
   solution that does the sums. *)

Fixpoint sum3 (xs : list N) : list N :=
  match xs with
  | x :: (y :: z :: _) as xs => (x + y + z) :: sum3 xs
  | _ => []
  end.

Theorem count_increases2_correct xs : count_increases (sum3 xs) = count_increases2 xs.
Proof.
  unfold count_increases, count_increases2. generalize 0.
  induction xs as [ | x xs IH]; cbn [sum3]; intros n; [ reflexivity | ].
  destruct xs as [ | y [ | z [ | t xs_ ] ] ]; [ reflexivity .. | ].
  change
    ( count_increases_ (sum3 (y :: z :: t :: xs_)) (if x + y + z <? y + z + t then 1 + n else n)
    = count_increases2_ (y :: z :: t :: xs_) (if x <? t then 1 + n else n)).
  destruct (N.ltb_spec x t);
  destruct (N.ltb_spec (x + y + z) (y + z + t)); [ apply IH | lia | lia | apply IH ].
Qed.


(** * ProofObjects: The Curry-Howard Correspondence *)

Set Warnings "-notation-overridden,-parsing".
From LF Require Export IndProp.

Print even.
(* ==>
  Inductive even : nat -> Prop :=
    | ev_0 : even 0
    | ev_SS : forall n, even n -> even (S (S n)).
*)
(*柯里-霍华德同构：既在类型层面表达具有什么类型，又在命题层面上表示式什么的证明*)

Check ev_SS.
(* ===> ev_SS : forall n,
                  even n ->
                  even (S (S n)) *)
(*ev_SS构造子表示接受两个参数-数字n以及命题ev n的证明，产生ev(S (S n))的证明*)

Theorem ev_4 : even 4.
Proof.
  apply ev_SS. apply ev_SS. apply ev_0. Qed.

Print ev_4.

(** Indeed, we can also write down this proof object _directly_,
    without the need for a separate proof script: *)

Check (ev_SS 2 (ev_SS 0 ev_0)).

Theorem ev_4': even 4.
Proof.
  apply (ev_SS 2 (ev_SS 0 ev_0)).
Qed.

(* ################################################################# *)
(** * Proof Scripts *)

Theorem ev_4'' : even 4.
Proof.
  Show Proof.
  apply ev_SS.
  Show Proof.
  apply ev_SS.
  Show Proof.
  apply ev_0.
  Show Proof.
Qed.

(*策略证明并不是必要的，可手动构造想要的证据，通过Definition直接给证据一个全局名称*)
Definition ev_4''' : even 4 :=
  ev_SS 2 (ev_SS 0 ev_0).

(**构造方式虽然不同，但是存储在全局环境中的证明是一致的*)

Print ev_4.
(* ===> ev_4    =   ev_SS 2 (ev_SS 0 ev_0) : even 4 *)
Print ev_4'.
(* ===> ev_4'   =   ev_SS 2 (ev_SS 0 ev_0) : even 4 *)
Print ev_4''.
(* ===> ev_4''  =   ev_SS 2 (ev_SS 0 ev_0) : even 4 *)
Print ev_4'''.
(* ===> ev_4''' =   ev_SS 2 (ev_SS 0 ev_0) : even 4 *)

(** **** Exercise: 2 stars, standard (eight_is_even)

    Give a tactic proof and a proof object showing that [even 8]. *)

Theorem ev_8 : even 8.
Proof.
  apply (ev_SS 6 (ev_SS 4 (ev_SS 2 (ev_SS 0 ev_0)))).
Qed.

Definition ev_8' : even 8 :=
  (ev_SS 6 (ev_SS 4 (ev_SS 2 (ev_SS 0 ev_0)))).
(** [] *)

(* ################################################################# *)
Theorem ev_plus4 : forall n, even n -> even (4 + n).
Proof.
  intros n H. simpl.
  apply ev_SS.
  apply ev_SS.
  apply H.
Qed.

Definition ev_plus4' : forall n, even n -> even (4 + n) :=
  fun (n : nat) => fun (H : even n) =>
    ev_SS (S (S n)) (ev_SS n H).

Definition ev_plus4'' (n : nat) (H : even n)
                    : even (4 + n) :=
  ev_SS (S (S n)) (ev_SS n H).

Check ev_plus4''.
(* ===>
     : forall n : nat, even n -> even (4 + n) *)

Definition ev_plus2 : Prop :=
  forall n, forall (E : even n), even (n + 2).
(*该例子中，forall时并没有依赖，可以简写成->，我们没有必要给箭头左边的类型一个名字*)

Definition ev_plus2' : Prop :=
  forall n, forall (_ : even n), even (n + 2).

(** Or, equivalently, we can write it in more familiar notation: *)

Definition ev_plus2'' : Prop :=
  forall n, even n -> even (n + 2).

(** In general, "[P -> Q]" is just syntactic sugar for
    "[forall (_:P), Q]". *)

(* ################################################################# *)
(** * Programming with Tactics *)

Definition add1 : nat -> nat.
intro n.
Show Proof.
apply S.
Show Proof.
apply n. Defined.
(*使用Defined而不是Qed来终止证明，它可以在计算中就像正常定义的函数一样被使用,而通过Qed定义的对象
在计算中是不透明的*)

Print add1.
(* ==>
    add1 = fun n : nat => S n
         : nat -> nat
*)

Compute add1 2.
(* ==> 3 : nat *)

(* ################################################################# *)
(** * Logical Connectives as Inductive Types *)

Module Props.

Module And.

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

End And.

Print prod.
(* ===>
   Inductive prod (X Y : Type) : Type :=
   | pair : X -> Y -> X * Y. *)

Lemma and_comm : forall P Q : Prop, P /\ Q <-> Q /\ P.
Proof.
  intros P Q. split.
  - intros [HP HQ]. split.
    + apply HQ.
    + apply HP.
  - intros [HP HQ]. split.
    + apply HQ.
    + apply HP.
Qed.
(*split策略能用于所有只有一个构造子*)

Definition and_comm'_aux P Q (H : P /\ Q) : Q /\ P :=
  match H with
  | conj HP HQ => conj HQ HP
  end.

Definition and_comm' P Q : P /\ Q <-> Q /\ P :=
  conj (and_comm'_aux P Q) (and_comm'_aux Q P).

(** **** Exercise: 2 stars, standard, optional (conj_fact) *)

Definition conj_fact : forall P Q R, P /\ Q -> Q /\ R -> P /\ R :=
  fun( P Q R:Prop) => fun(H1 : P/\Q) => fun(H2 :Q/\R) =>
  match H1,H2 with
  |conj p q,conj q' r => conj p r
  end.
(** [] *)

Module Or.

Inductive or (P Q : Prop) : Prop :=
| or_introl : P -> or P Q
| or_intror : Q -> or P Q.

End Or.

(** **** Exercise: 2 stars, standard, optional (or_commut'') *)

Definition or_comm : forall P Q, P \/ Q -> Q \/ P :=
  fun(P Q:Prop) => fun(H: P\/Q) =>
  match H with
  |or_introl P=> or_intror P
  |or_intror Q=> or_introl Q
end.
(** [] *)

(* ================================================================= *)
(** ** Existential Quantification *)

(** To give evidence for an existential quantifier, we package a
    witness [x] together with a proof that [x] satisfies the property
    [P]: *)

Module Ex.

Inductive ex {A : Type} (P : A -> Prop) : Prop :=
| ex_intro : forall x : A, P x -> ex P.

End Ex.

Check ex (fun n => even n).
(* ===> exists n : nat, even n
        : Prop *)

Definition some_nat_is_even : exists n, even n :=
  ex_intro even 4 (ev_SS 2 (ev_SS 0 ev_0)).

(** **** Exercise: 2 stars, standard, optional (ex_ev_Sn) *)

Definition ex_ev_Sn : ex (fun n => even (S n)) :=
  ex_intro (fun n => even (S n)) 1 (ev_SS 0 (ev_0)).
(** [] *)

Inductive True : Prop :=
  | I : True.

Inductive False : Prop := .

End Props.

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

Module MyEquality.

Inductive eq {X:Type} : X -> X -> Prop :=
| eq_refl : forall x, eq x x.

Notation "x == y" := (eq x y)
                    (at level 70, no associativity)
                    : type_scope.

Lemma four: 2 + 2 == 1 + 3.
Proof.
  apply eq_refl.
Qed.

Definition four' : 2 + 2 == 1 + 3 :=
  eq_refl 4.

Definition singleton : forall (X:Type) (x:X), []++[x] == x::[]  :=
  fun (X:Type) (x:X) => eq_refl [x].

(** **** Exercise: 2 stars, standard (equality__leibniz_equality) *)
(*相等的归纳定义蕴含了Leibniez相等关系*)
Lemma equality__leibniz_equality : forall (X : Type) (x y: X),
  x == y -> forall P:X->Prop, P x -> P y.
Proof.
  intros.
  inversion H.
  rewrite H2 in H0.
  apply H0.
Qed.
(** [] *)

(** **** Exercise: 5 stars, standard, optional (leibniz_equality__equality)  *)
Lemma leibniz_equality__equality : forall (X : Type) (x y: X),
  (forall P:X->Prop, P x -> P y) -> x == y.
Proof.
  intros.
  assert(H1: x=x -> x=y). {apply H. }
  assert(H2: x=x). {reflexivity. }
  assert(H3: x=y). {apply H1 in H2. apply H2. }
  subst.
  apply eq_refl.
Qed.
(** [] *)

End MyEquality.


Module CustomInteger.

(** Peano arithmetic of natural numbers *)
Inductive nat : Type :=
  | O: nat  (** Zero value *)
  | S: nat -> nat. (** Successor *)

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

(** Check whether n is even. Introduce concept of recursive definition. *)
Fixpoint evenb (n: nat) : bool :=
  match n with
  | O => true
  | S O => false
  | S (S n') => evenb n'
  end.

End CustomInteger.

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

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

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

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

(** TODO: div, gcd, comparison *)