From Coq Require Import Arith.Arith.
From Coq Require Import Init.Nat.
From Coq Require Import Arith.EqNat.
From Coq Require Import omega.Omega.
From Coq Require Import Lists.List.
From Coq Require Import Strings.String.
From Coq Require Import QArith.QArith_base.
From Coq Require Import QArith.Qabs.
From Coq Require Import QArith.Qminmax.
From Coq Require Import QArith.Qround.
From Coq Require Import Logic.Classical.
From Coq Require Import Classes.Equivalence.
From Coq Require Import Classes.Morphisms.
From Coq Require Export Field.
From CReal.Cauchy Require Import RBase.
From CReal Require Import QArith_ext.QArith_base_ext.

(*Next, define the plus operation *)
Definition CauchySeqPlus (A B: nat -> Q -> Prop): (nat -> Q -> Prop) :=
  fun (n:nat) (q:Q) =>
     forall (q1 q2:Q), A n q1 -> B n q2 -> q == q1 + q2.

Theorem Cauchy_Plus_Cauchy: forall A B, Cauchy A -> Cauchy B
  -> Cauchy (CauchySeqPlus A B).
Proof. intros A B HA HB. split.
- unfold CauchySeqPlus. intros. destruct (Cauchy_exists _ HA n) as [qa Hqa].
  destruct (Cauchy_exists _ HB n) as [qb Hqb].
  exists (qa + qb). intros q1 q2 HqA HqB.
  assert (E1:qa == q1). { apply (Cauchy_unique _ HA n qa q1). apply Hqa. apply HqA. }
  assert (E2:qb == q2). { apply (Cauchy_unique _ HB n qb q2). apply Hqb. apply HqB. }
  rewrite E1. rewrite E2. reflexivity.
- unfold CauchySeqPlus. intros n q1 q2 H1 H2.
  destruct (Cauchy_exists _ HA n) as [qa Hqa]. destruct (Cauchy_exists _ HB n) as [qb Hqb].
  assert (E1: q1 == qa + qb). { auto. }
  assert (E2: q2 == qa + qb). { auto. }
  rewrite E1. rewrite E2. reflexivity.
- intros. hnf in H0. hnf. intros. rewrite <- H. auto.
- unfold CauchySeqPlus. intros eps Heps.
  destruct ((Cauchy_def _ HA) _ (eps_divide_2_positive eps Heps)) as [n1 HAC].
  destruct ((Cauchy_def _ HB) _ (eps_divide_2_positive eps Heps)) as [n2 HBC].
  assert (H2: eps == eps *(1#2) + eps *(1#2)) by ring.

assert (Hn: le n1 n2 \/ ~ (le n1 n2)). { apply classic. } destruct Hn.
  * exists n2. intros m1 m2 Hm1n2 Hm2n2 q1 q2 Hq1 Hq2.
    destruct (Cauchy_exists _ HA m1) as [qa1 Hqa1], (Cauchy_exists _ HA m2) as [qa2 Hqa2].
    destruct (Cauchy_exists _ HB m1) as [qb1 Hqb1], (Cauchy_exists _ HB m2) as [qb2 Hqb2].
    rewrite (Hq1 qa1 qb1 Hqa1 Hqb1). rewrite (Hq2 qa2 qb2 Hqa2 Hqb2).
    assert (Et: qa1 + qb1 - (qa2 + qb2) == (qa1 - qa2) + (qb1 - qb2)) by ring.
    rewrite Et. rewrite H2.
    apply (Qle_lt_trans _ _ _ (Qabs_triangle (qa1 - qa2) (qb1 - qb2))).
    apply Qplus_lt_le_compat.
    assert (Hm1n1: (m1 > n1)%nat) by omega. assert (Hm2n1: (m2>n1)%nat) by omega.
    apply (HAC m1 m2 Hm1n1 Hm2n1 qa1 qa2 Hqa1 Hqa2).
    apply Qlt_le_weak. apply (HBC m1 m2 Hm1n2 Hm2n2 qb1 qb2 Hqb1 Hqb2).

  * exists n1. apply not_le in H. intros m1 m2 Hm1n1 Hm2n1 q1 q2 Hq1 Hq2.
    destruct (Cauchy_exists _ HA m1) as [qa1 Hqa1], (Cauchy_exists _ HA m2) as [qa2 Hqa2].
    destruct (Cauchy_exists _ HB m1) as [qb1 Hqb1], (Cauchy_exists _ HB m2) as [qb2 Hqb2].
    rewrite (Hq1 qa1 qb1 Hqa1 Hqb1). rewrite (Hq2 qa2 qb2 Hqa2 Hqb2).
    assert (Et: qa1 + qb1 - (qa2 + qb2) == (qa1 - qa2) + (qb1 - qb2)) by ring.
    rewrite Et. rewrite H2.
    apply (Qle_lt_trans _ _ _ (Qabs_triangle (qa1 - qa2) (qb1 - qb2))).
    apply Qplus_lt_le_compat.
    apply (HAC m1 m2 Hm1n1 Hm2n1 qa1 qa2 Hqa1 Hqa2).
    assert (Hm1n2: (m1 > n2)%nat) by omega. assert (Hm2n2: (m2>n2)%nat) by omega.
    apply Qlt_le_weak. apply (HBC m1 m2 Hm1n2 Hm2n2 qb1 qb2 Hqb1 Hqb2).
Qed.

Definition Rplus(a b : Real) : Real :=
  match a with
    | (Real_intro A HA) => match b with
                            | (Real_intro B HB) =>
                               Real_intro (CauchySeqPlus A B) (Cauchy_Plus_Cauchy A B HA HB)
                          end
  end.

Infix "+" := Rplus : Real_scope.

Definition Rzero:Real :=
 Real_intro (fun (n:nat) => (fun x => x == 0)) (Real_has_Q 0).

Notation " 0 " := Rzero : Real_scope.

Theorem Cauchy_Plus_equiv: forall (A1 A2 B1 B2: Real),
  (A1 == A2)%R -> (B1 == B2)%R ->
  ((Rplus A1 B1) == (Rplus A2 B2))%R.
Proof. intros A1 A2 B1 B2 HeqA HeqB. unfold Real_equiv in *.
  destruct A1 as [a1 Ha1], B1 as [b1 Hb1].
  destruct A2 as [a2 Ha2], B2 as [b2 Hb2].
  unfold Rplus. intros eps Heps.
  destruct (HeqA _ (eps_divide_2_positive _ Heps)) as [n1 Heqa].
  destruct (HeqB _ (eps_divide_2_positive _ Heps)) as [n2 Heqb].
  clear HeqA. clear HeqB.
  assert (Heps': eps == eps *(1#2) + eps *(1#2)) by ring.
assert (Hn: le n1 n2 \/ ~ (le n1 n2)). { apply classic. } destruct Hn as [Hn |Hn].
  * exists n2. intros m Hn2. assert (Hn1: (m > n1)%nat) by omega.
    unfold CauchySeqPlus. intros q1 q2 H1 H2.
    destruct (Cauchy_exists _ Ha1 m) as [qa1 Hqa1].
    destruct (Cauchy_exists _ Ha2 m) as [qa2 Hqa2].
    destruct (Cauchy_exists _ Hb1 m) as [qb1 Hqb1].
    destruct (Cauchy_exists _ Hb2 m) as [qb2 Hqb2].
    rewrite (H1 qa1 qb1 Hqa1 Hqb1). rewrite (H2 qa2 qb2 Hqa2 Hqb2).
    assert (H': qa1 + qb1 - (qa2 + qb2) == qa1 - qa2 + (qb1 - qb2)) by ring.
    rewrite H'. rewrite Heps'.
    apply (Qle_lt_trans _ _ _ (Qabs_triangle (qa1 - qa2) (qb1 - qb2))).
    apply Qplus_lt_le_compat.
    apply (Heqa m Hn1 _ _ Hqa1 Hqa2).
    apply Qlt_le_weak. apply (Heqb m Hn2 _ _ Hqb1 Hqb2).

  * exists n1. intros m Hn1. assert (Hn2: (m > n2)%nat) by omega.
    unfold CauchySeqPlus. intros q1 q2 H1 H2.
    destruct (Cauchy_exists _ Ha1 m) as [qa1 Hqa1].
    destruct (Cauchy_exists _ Ha2 m) as [qa2 Hqa2].
    destruct (Cauchy_exists _ Hb1 m) as [qb1 Hqb1].
    destruct (Cauchy_exists _ Hb2 m) as [qb2 Hqb2].
    rewrite (H1 qa1 qb1 Hqa1 Hqb1). rewrite (H2 qa2 qb2 Hqa2 Hqb2).
    assert (H': qa1 + qb1 - (qa2 + qb2) == qa1 - qa2 + (qb1 - qb2)) by ring.
    rewrite H'. rewrite Heps'.
    apply (Qle_lt_trans _ _ _ (Qabs_triangle (qa1 - qa2) (qb1 - qb2))).
    apply Qplus_lt_le_compat.
    apply (Heqa m Hn1 _ _ Hqa1 Hqa2).
    apply Qlt_le_weak. apply (Heqb m Hn2 _ _ Hqb1 Hqb2).
Qed.

Theorem Rplus_comm : forall (A B: Real),
  (A + B == B + A)%R.
Proof. intros. unfold Real_equiv. destruct A as [A HA], B as [B HB].
  unfold Rplus. intros eps Heps. exists O. intros m Hm q1 q2 H1 H2.
  unfold CauchySeqPlus in *.
  destruct (Cauchy_exists _ HA m) as [qa Hqa]. destruct (Cauchy_exists _ HB m) as [qb Hqb].
  assert (E1: q1 == qa + qb). { apply H1. apply Hqa. apply Hqb. }
  assert (E2: q2 == qb + qa). { apply H2. apply Hqb. apply Hqa. }
  rewrite E1. rewrite E2. assert (E:qa + qb - (qb + qa) == 0) by ring.
  rewrite E. apply Heps.
Qed.

Theorem Rplus_assoc: forall (A B C: Real),
  (A + B + C == A + (B + C))%R.
Proof. intros. unfold Real_equiv. destruct A as [A HA], B as [B HB], C as [C HC].
  unfold Rplus. intros eps Heps. exists O. intros m Hm q1 q2 H1 H2.
  unfold CauchySeqPlus in *. destruct (Cauchy_exists _ HA m) as [qa Hqa].
  destruct (Cauchy_exists _ HB m) as [qb Hqb]. destruct (Cauchy_exists _ HC  m) as [qc Hqc].
  assert (E1: q1 == qa + qb + qc). {
    apply (H1 (qa+qb)%Q qc). intros qa' qb' Hqa' Hqb'.
      assert (Ea':qa' == qa). { apply (Cauchy_unique _ HA m). apply Hqa'. apply Hqa. }
      assert (Eb':qb' == qb). { apply (Cauchy_unique _ HB m). apply Hqb'. apply Hqb. }
    rewrite Ea',Eb'. reflexivity. apply Hqc. }
  assert (E2: q2 == qa + (qb + qc)). {
    apply (H2 qa (qb+qc)%Q). apply Hqa. intros qb' qc' Hqb' Hqc'.
      assert (Ec':qc' == qc). { apply (Cauchy_unique _ HC m). apply Hqc'. apply Hqc. }
      assert (Eb':qb' == qb). { apply (Cauchy_unique _ HB m). apply Hqb'. apply Hqb. }
    rewrite Ec',Eb'. reflexivity. }
  rewrite E1,E2. rewrite Qplus_assoc. unfold Qminus. rewrite Qplus_opp_r.
  apply Heps.
Qed.

Theorem Rplus_Zero: forall (A : Real),
  (A + Rzero == A)%R.
Proof. intros. destruct A as [A Ha]. unfold Rzero. unfold Rplus.
  unfold Real_equiv. intros eps Heps. unfold CauchySeqPlus.
  exists O. intros m Hm q1 q2 H1 H2.
  assert (E:0 == 0) by reflexivity.
  rewrite (H1 q2 0 H2 E). rewrite Qplus_0_r. unfold Qminus.
  rewrite Qplus_opp_r. apply Heps.
Qed.

Definition Cauchy_opp (A : nat -> Q -> Prop): (nat -> Q -> Prop) :=
    fun (n:nat) (q:Q) =>
     forall (q1:Q), (A n q1) -> q == - q1.

Theorem Cauchy_opp_Cauchy: forall A, Cauchy A
  -> Cauchy (Cauchy_opp A).
Proof. intros. unfold Cauchy_opp. split.
  - intros. destruct (Cauchy_exists _ H n) as [q Hq]. exists (- q).
    intros. rewrite (Cauchy_unique _ H n q q1 Hq H0). reflexivity.
  - intros n q1 q2 H1 H2. destruct (Cauchy_exists _ H n) as [q Hq].
    assert (E1: q1 == - q) by (apply (H1 q Hq)).
    assert (E2: q2 == - q) by (apply (H2 q Hq)).
    rewrite E1,E2. reflexivity.
  - intros. rewrite <- H0. auto.
  - intros. apply (Cauchy_def _ H) in H0. destruct H0 as [n H0].
    exists n. intros.
    destruct (Cauchy_exists _ H m1) as [qa Hqa], (Cauchy_exists _ H m2) as [qb Hqb].
    rewrite (H3 qa Hqa). rewrite (H4 qb Hqb).
    assert (Eq: - qa - - qb == qb - qa) by ring.
    rewrite Eq. rewrite Qabs_Qminus. apply (H0 m1 m2 H1 H2 qa qb Hqa Hqb).
Qed.

Fixpoint Ropp(a : Real) : Real :=
  match a with
    | (Real_intro A HA) => Real_intro (Cauchy_opp A) (Cauchy_opp_Cauchy A HA)
  end.
Notation "- x" := (Ropp x) : Real_scope.

Definition Rminus (a b:Real) := Rplus a (Ropp b).

Infix "-" := Rminus : Real_scope.

Theorem Rplus_opp_r : forall (A:Real), Real_equiv (A + (Ropp A))  Rzero.
Proof. intros. destruct A as [A Ha]. unfold Rzero. unfold Rplus.
  unfold Real_equiv. intros eps Heps. exists O. unfold Cauchy_opp. unfold CauchySeqPlus.
  intros m Hm q1 q2 H1 H2.
  destruct (Cauchy_exists _ Ha m) as [qa Hqa].
  assert (q1 == qa + (- qa)). { apply H1. apply Hqa. intros.
    assert (E: qa == q0). { apply (Cauchy_unique _ Ha m _ _ Hqa H). }
    rewrite E. reflexivity. }
  rewrite H. rewrite Qplus_opp_r. rewrite H2. apply Heps.
Qed.

(*Then define multiplication *)

Definition CauchySeqMult (A B: nat -> Q -> Prop): (nat -> Q -> Prop) :=
  fun (n:nat) (q:Q) =>
     forall (q1 q2:Q), A n q1 -> B n q2 -> q == q1 * q2.

Lemma CauchySeqBounded_weak: forall A, Cauchy A -> exists (N:nat),
  exists (M:Q), forall (n:nat) (q:Q),(n>N)%nat -> A n q -> (Qabs q) < M.
Proof. intros. assert (E: Qlt 0 1) by reflexivity.
  apply (Cauchy_def _ H 1) in E. destruct E as [n Hn].
  exists n. destruct (Cauchy_exists _ H (S n)). exists (1 + (Qabs x))%Q.
  intros n' q Hn' Hq.
  assert (E: Qabs q <= (Qabs (q - x)) + (Qabs x)).
    { assert (E': q == (q - x) + x) by ring.
      remember (q-x) as q'. rewrite E'. rewrite Heqq'. apply (Qabs_triangle (q - x) x). }
      apply (Qle_lt_trans _ _ _ E). apply (Qplus_lt_le_compat (Qabs (q-x)) 1 (Qabs x)).
      * apply (Hn n' (S n)). auto. auto. auto. auto.
      * apply Qle_refl.
Qed.

Lemma FiniteSeqBounded: forall (A:nat->Q->Prop) (N:nat), Cauchy A ->
  exists (M:Q), forall (n:nat)(q:Q), (n < N)%nat -> A n q -> Qabs q < M.
Proof. intros. induction N.
  - exists 0. intros. inversion H0.
  - destruct IHN as [M IH]. destruct (Cauchy_exists _ H N) as [xN HxN].
    assert (Hq: Qlt (Qabs xN) M \/ ~ (Qlt (Qabs xN) M)). { apply classic. } destruct Hq as [Hq | Hq].
    + exists M. intros. unfold lt in H0. apply le_S_n in H0. apply Nat.le_lteq in H0. destruct H0.
      * apply (IH n). auto. auto.
      * rewrite <- H0 in HxN. assert (E: xN == q). { apply (Cauchy_unique _ H n _ _ HxN H1). }
        rewrite <- E. apply Hq.
    + exists (1+(Qabs xN))%Q. apply Qnot_lt_le in Hq. intros.
      unfold lt in H0. apply le_S_n in H0. apply Nat.le_lteq in H0. destruct H0.
      * rewrite <- Qplus_0_l. apply Qplus_lt_le_compat. reflexivity.
        apply (Qle_trans _ M). apply Qlt_le_weak. apply (IH n). apply H0. apply H1. apply Hq.
      * rewrite <- Qplus_0_l. apply Qplus_lt_le_compat. reflexivity.
        rewrite <- H0 in HxN.
        assert (E: xN == q). { apply (Cauchy_unique _ H n _ _ HxN H1). }
        rewrite <- E. apply Qle_lteq. right. reflexivity.
Qed.

Lemma CauchySeqBounded: forall A, Cauchy A ->
  exists (M:Q), 0 < M /\forall (n:nat) (q:Q), A n q -> (Qabs q) < M.
Proof. intros. destruct (CauchySeqBounded_weak _ H) as [N [M1 HM1]].
  destruct (FiniteSeqBounded _ (S N) H) as [M2 HM2].
  assert (HM: Qle M1 M2 \/ ~ (Qle M1 M2)). { apply classic. } destruct HM as [HM | HM].
- exists M2. split.
  { destruct (Cauchy_exists _ H O). assert (E: (0 < S N)%nat) by omega.
    apply (HM2 _ _ E) in H0. apply (Qle_lt_trans _ _ _ (Qabs_nonneg x)). auto. }
  { intros. assert (Hn: (n > N)%nat \/ ~ (n>N)%nat). { apply classic. } destruct Hn as [Hn|Hn].
  + apply (Qlt_le_trans _ M1). apply (HM1 n). auto. auto. auto.
  + apply (HM2 n). apply not_lt in Hn. unfold ge in Hn. apply le_lt_n_Sm. auto. auto. }
- exists M1. split.
  { destruct (Cauchy_exists _ H (S N)). assert (E: (S N > N)%nat) by omega.
    apply (HM1 _ _ E) in H0. apply (Qle_lt_trans _ _ _ (Qabs_nonneg x)). auto. }
  { intros. assert (Hn: (n > N)%nat \/ ~ (n>N)%nat). { apply classic. } destruct Hn as [Hn|Hn].
  + apply (HM1 n). auto. auto.
  + apply (Qlt_le_trans _ M2). apply (HM2 n). apply not_lt in Hn. unfold ge in Hn. apply le_lt_n_Sm. auto. auto.
    apply Qnot_le_lt in HM. apply Qle_lteq. left. apply HM. }
Qed.

Theorem Cauchy_Mult_Cauchy : forall A B, Cauchy A -> Cauchy B
  -> Cauchy (CauchySeqMult A B).
Proof. intros A B HA HB. unfold CauchySeqMult. split.
- intros. destruct (Cauchy_exists _ HA n) as [q1 Hq1].
  destruct (Cauchy_exists _ HB n) as [q2 Hq2].
  exists (q1*q2). intros qa qb Hqa Hqb.
  assert (E1: q1 == qa) by (apply (Cauchy_unique _ HA _ _ _ Hq1 Hqa)).
  assert (E2: q2 == qb) by (apply (Cauchy_unique _ HB _ _ _ Hq2 Hqb)).
  rewrite E1,E2. reflexivity.
- intros. destruct (Cauchy_exists _ HA n) as [qa Hqa].
  destruct (Cauchy_exists _ HB n) as [qb Hqb].
  assert (E1 : q1 == qa * qb) by (apply (H qa qb Hqa Hqb)).
  assert (E2 : q2 == qa * qb) by (apply (H0 qa qb Hqa Hqb)).
  rewrite E1,E2. reflexivity.
- intros. rewrite <- H. auto.
- intros eps Heps.
  destruct (CauchySeqBounded _ HA) as [MA [MAp HMA]].
  destruct (CauchySeqBounded _ HB) as [MB [MBp HMB]].

assert (HM: MB <= MA \/ ~ (MB <= MA)). { apply classic. } destruct HM as [HM | HM].
{
  destruct (Cauchy_def _ HA (eps * (1#2) *(/ MA))) as [NA HNA].
   { apply (eps_divide_2M_positive eps MA Heps MAp). }
  destruct (Cauchy_def _ HB (eps * (1#2) *(/ MA))) as [NB HNB].
   { apply (eps_divide_2M_positive eps MA Heps MAp). }
  assert (E: eps == MA * (eps * (1 # 2) * / MA) + MA * (eps * (1 # 2) * / MA)).
   { rewrite <- Qmult_comm.
     rewrite <- (Qmult_assoc (eps * (1 # 2))).
     rewrite <- (Qmult_comm MA).
     rewrite Qmult_inv_r. ring.
     intros contra. rewrite contra in MAp. discriminate MAp.
   }
assert (HN: le NA NB \/ ~ (le NA NB)). { apply classic. } destruct HN as [HN | HN].
+ exists NB. intros m1 m2 Hm1B Hm2B.
  assert (Hm1A: (m1 > NA)%nat) by omega.
  assert (Hm2A: (m2 > NA)%nat) by omega.
  intros q1 q2. destruct (Cauchy_exists _ HA m1) as [qa1 Hqa1].
  destruct (Cauchy_exists _ HA m2) as [qa2 Hqa2].
  destruct (Cauchy_exists _ HB m1) as [qb1 Hqb1].
  destruct (Cauchy_exists _ HB m2) as [qb2 Hqb2].
  intros HA1B1 HA2B2. assert (E1:q1 == qa1 * qb1) by auto.
  assert (E2:q2 == qa2*qb2) by auto.
  rewrite E1,E2.
  assert (E3: qa1 * qb1 - qa2 * qb2 ==qa1 * (qb1 - qb2) + qb2 * (qa1-qa2)) by ring.
  rewrite E3.
  apply (Qle_lt_trans _ _ _ (Qabs_triangle (qa1 * (qb1 - qb2)) (qb2 * (qa1 - qa2)))).
  rewrite Qabs_Qmult. rewrite Qabs_Qmult.
  rewrite E. apply Qplus_lt_le_compat.
  * apply (Qmult_lt_compat_nonneg _ _ _ _ (Qabs_nonneg qa1) (Qabs_nonneg (qb1-qb2))).
    apply (HMA m1). auto.
    apply (HNB m1 m2). auto. auto. auto. auto.
  * apply Qlt_le_weak. apply (Qmult_lt_compat_nonneg _ _ _ _ (Qabs_nonneg qb2) (Qabs_nonneg (qa1-qa2))).
    assert (E':Qabs qb2 < MB). { apply (HMB m2). auto. }
    apply (Qlt_le_trans _ _ _ E' HM).  auto.
    apply (HNA m1 m2). auto. auto. auto. auto.
+ exists NA. intros m1 m2 Hm1A Hm2A. apply not_le in HN.
  assert (Hm1B: (m1 > NB)%nat) by omega.
  assert (Hm2B: (m2 > NB)%nat) by omega.
  intros q1 q2. destruct (Cauchy_exists _ HA m1) as [qa1 Hqa1].
  destruct (Cauchy_exists _ HA m2) as [qa2 Hqa2].
  destruct (Cauchy_exists _ HB m1) as [qb1 Hqb1].
  destruct (Cauchy_exists _ HB m2) as [qb2 Hqb2].
  intros HA1B1 HA2B2. assert (E1:q1 == qa1 * qb1) by auto.
  assert (E2:q2 == qa2*qb2) by auto.
  rewrite E1,E2.
  assert (E3: qa1 * qb1 - qa2 * qb2 ==qa1 * (qb1 - qb2) + qb2 * (qa1-qa2)) by ring.
  rewrite E3.
  apply (Qle_lt_trans _ _ _ (Qabs_triangle (qa1 * (qb1 - qb2)) (qb2 * (qa1 - qa2)))).
  rewrite Qabs_Qmult. rewrite Qabs_Qmult.
  rewrite E. apply Qplus_lt_le_compat.
  * apply (Qmult_lt_compat_nonneg _ _ _ _ (Qabs_nonneg qa1) (Qabs_nonneg (qb1-qb2))).
    apply (HMA m1). auto.
    apply (HNB m1 m2). auto. auto. auto. auto.
  * apply Qlt_le_weak. apply (Qmult_lt_compat_nonneg _ _ _ _ (Qabs_nonneg qb2) (Qabs_nonneg (qa1-qa2))).
    assert (E':Qabs qb2 < MB). { apply (HMB m2). auto. }
    apply (Qlt_le_trans _ _ _ E' HM).  auto.
    apply (HNA m1 m2). auto. auto. auto. auto.
}
{
  destruct (Cauchy_def _ HA (eps * (1#2) *(/ MB))) as [NA HNA].
   { apply (eps_divide_2M_positive eps MB Heps MBp). }
  destruct (Cauchy_def _ HB (eps * (1#2) *(/ MB))) as [NB HNB].
   { apply (eps_divide_2M_positive eps MB Heps MBp). }
  assert (E: eps == MB * (eps * (1 # 2) * / MB) + MB * (eps * (1 # 2) * / MB)).
   { rewrite <- Qmult_comm.
     rewrite <- (Qmult_assoc (eps * (1 # 2))).
     rewrite <- (Qmult_comm MB).
     rewrite Qmult_inv_r. ring.
     intros contra. rewrite contra in MBp. discriminate MBp.
   }
apply Qnot_le_lt in HM.
assert (HN: le NA NB \/ ~ (le NA NB)). { apply classic. } destruct HN as [HN | HN].
+ exists NB. intros m1 m2 Hm1B Hm2B.
  assert (Hm1A: (m1 > NA)%nat) by omega.
  assert (Hm2A: (m2 > NA)%nat) by omega.
  intros q1 q2. destruct (Cauchy_exists _ HA m1) as [qa1 Hqa1].
  destruct (Cauchy_exists _ HA m2) as [qa2 Hqa2].
  destruct (Cauchy_exists _ HB m1) as [qb1 Hqb1].
  destruct (Cauchy_exists _ HB m2) as [qb2 Hqb2].
  intros HA1B1 HA2B2. assert (E1:q1 == qa1 * qb1) by auto.
  assert (E2:q2 == qa2*qb2) by auto.
  rewrite E1,E2.
  assert (E3: qa1 * qb1 - qa2 * qb2 ==qa1 * (qb1 - qb2) + qb2 * (qa1-qa2)) by ring.
  rewrite E3.
  apply (Qle_lt_trans _ _ _ (Qabs_triangle (qa1 * (qb1 - qb2)) (qb2 * (qa1 - qa2)))).
  rewrite Qabs_Qmult. rewrite Qabs_Qmult.
  rewrite E. apply Qplus_lt_le_compat.
  * apply (Qmult_lt_compat_nonneg _ _ _ _ (Qabs_nonneg qa1) (Qabs_nonneg (qb1-qb2))).
    assert (E':Qabs qa1 < MA). { apply (HMA m1). auto. }
    apply (Qlt_trans _ _ _ E' HM).  auto.
    apply (HNB m1 m2). auto. auto. auto. auto.
  * apply Qlt_le_weak. apply (Qmult_lt_compat_nonneg _ _ _ _ (Qabs_nonneg qb2) (Qabs_nonneg (qa1-qa2))).
    apply (HMB m2). auto.
    apply (HNA m1 m2). auto. auto. auto. auto.
+ exists NA. intros m1 m2 Hm1A Hm2A. apply not_le in HN.
  assert (Hm1B: (m1 > NB)%nat) by omega.
  assert (Hm2B: (m2 > NB)%nat) by omega.
  intros q1 q2. destruct (Cauchy_exists _ HA m1) as [qa1 Hqa1].
  destruct (Cauchy_exists _ HA m2) as [qa2 Hqa2].
  destruct (Cauchy_exists _ HB m1) as [qb1 Hqb1].
  destruct (Cauchy_exists _ HB m2) as [qb2 Hqb2].
  intros HA1B1 HA2B2. assert (E1:q1 == qa1 * qb1) by auto.
  assert (E2:q2 == qa2*qb2) by auto.
  rewrite E1,E2.
  assert (E3: qa1 * qb1 - qa2 * qb2 ==qa1 * (qb1 - qb2) + qb2 * (qa1-qa2)) by ring.
  rewrite E3.
  apply (Qle_lt_trans _ _ _ (Qabs_triangle (qa1 * (qb1 - qb2)) (qb2 * (qa1 - qa2)))).
  rewrite Qabs_Qmult. rewrite Qabs_Qmult.
  rewrite E. apply Qplus_lt_le_compat.
  * apply (Qmult_lt_compat_nonneg _ _ _ _ (Qabs_nonneg qa1) (Qabs_nonneg (qb1-qb2))).
    assert (E':Qabs qa1 < MA). { apply (HMA m1). auto. }
    apply (Qlt_trans _ _ _ E' HM).  auto.
    apply (HNB m1 m2). auto. auto. auto. auto.
  * apply Qlt_le_weak. apply (Qmult_lt_compat_nonneg _ _ _ _ (Qabs_nonneg qb2) (Qabs_nonneg (qa1-qa2))).
    apply (HMB m2). auto.
    apply (HNA m1 m2). auto. auto. auto. auto.
}
Qed.

Definition Rmult(a b:Real):Real:=
match a with
    | (Real_intro A HA) => match b with
                            | (Real_intro B HB) =>
                               Real_intro (CauchySeqMult A B) (Cauchy_Mult_Cauchy A B HA HB)
                          end
  end.

Infix "*" := Rmult : Real_scope.

Lemma CauchySeqBounded_two: forall A B, Cauchy A -> Cauchy B ->
  exists (M:Q), 0 < M
  /\ (forall (n:nat) (q:Q), A n q -> (Qabs q) < M)
  /\ (forall (n:nat) (q:Q), B n q -> (Qabs q) < M) .
Proof. intros.
  destruct (CauchySeqBounded _ H) as [MA [MAp HMA]].
  destruct (CauchySeqBounded _ H0) as [MB [MBp HMB]].
  assert (HM: MB <= MA \/ ~ (MB <= MA)) by (apply classic). destruct HM as [HM|HM].
  - exists MA. split.
    apply MAp. split.
    apply HMA.
    intros. apply (Qlt_le_trans _ MB). apply (HMB n). apply H1. apply HM.
  - exists MB. split. apply MBp. split. intros.
    apply (Qlt_le_trans _ MA). apply (HMA n). auto. apply Qnot_le_lt in HM.
    apply Qlt_le_weak. auto.
    apply HMB.
Qed.

Theorem Cauchy_Mult_equiv: forall (A1 A2 B1 B2: Real),
  (A1 == A2)%R -> (B1 == B2)%R ->
  ((A1 * B1)%R == (A2 * B2)%R)%R.
Proof. intros [A1 HA1] [A2 HA2] [B1 HB1] [B2 HB2] HAeq HBeq.
  unfold Real_equiv in *. unfold Rmult. intros eps Heps.
  destruct (CauchySeqBounded_two _ _ HA2 HB1) as [M [Mp [HMA2 HMB1]]].
  destruct (HAeq (eps * (1#2) *(/ M))) as [NA1 HNA1].
   { apply (eps_divide_2M_positive eps M Heps Mp). }
  destruct (HBeq (eps * (1#2) *(/ M))) as [NB2 HNB2].
   { apply (eps_divide_2M_positive eps M Heps Mp). }

  assert (E: eps == M * (eps * (1 # 2) * / M) + M * (eps * (1 # 2) * / M)).
   { rewrite <- Qmult_comm.
     rewrite <- (Qmult_assoc (eps * (1 # 2))).
     rewrite <- (Qmult_comm M).
     rewrite Qmult_inv_r. ring.
     intros contra. rewrite contra in Mp. discriminate Mp.
   } unfold CauchySeqMult.
  assert (HN: le NA1 NB2 \/ ~ (le NA1 NB2)). { apply classic. } destruct HN as [HN | HN].
+ exists NB2. intros m HmNB2 q1 q2 Hq1 Hq2. unfold CauchySeqMult in *.
  destruct (Cauchy_exists _ HA1 m) as [qa1 Hqa1].
  destruct (Cauchy_exists _ HA2 m) as [qa2 Hqa2].
  destruct (Cauchy_exists _ HB1 m) as [qb1 Hqb1].
  destruct (Cauchy_exists _ HB2 m) as [qb2 Hqb2].
  assert (E1:q1 == qa1 * qb1) by auto.
  assert (E2:q2 == qa2 * qb2) by auto.
  rewrite E1,E2.
  assert (E':qa1 * qb1 - qa2 * qb2 == qa2 * (qb1 - qb2) + qb1 * (qa1-qa2)) by ring.
  rewrite E',E.
  apply (Qle_lt_trans _ _ _ (Qabs_triangle (qa2 * (qb1 - qb2)) (qb1 * (qa1 - qa2)))).
  apply Qplus_lt_le_compat.
  * rewrite Qabs_Qmult.
    apply (Qmult_lt_compat_nonneg _ _ _ _ (Qabs_nonneg qa2) (Qabs_nonneg (qb1-qb2))).
    { apply (HMA2 m). auto. }
    { apply (HNB2 _ HmNB2). auto. auto. }
  * rewrite Qabs_Qmult. apply Qlt_le_weak.
    apply (Qmult_lt_compat_nonneg _ _ _ _ (Qabs_nonneg qb1) (Qabs_nonneg (qa1-qa2))).
    apply (HMB1 m). auto.
    assert (HmNA1: (m > NA1)%nat) by omega.
    apply (HNA1 _ HmNA1). auto. auto.

+ exists NA1. intros m HmNA1 q1 q2 Hq1 Hq2. apply not_le in HN. unfold CauchySeqMult in *.
  destruct (Cauchy_exists _ HA1 m) as [qa1 Hqa1].
  destruct (Cauchy_exists _ HA2 m) as [qa2 Hqa2].
  destruct (Cauchy_exists _ HB1 m) as [qb1 Hqb1].
  destruct (Cauchy_exists _ HB2 m) as [qb2 Hqb2].
  assert (E1:q1 == qa1 * qb1) by auto.
  assert (E2:q2 == qa2 * qb2) by auto.
  rewrite E1,E2.
  assert (E':qa1 * qb1 - qa2 * qb2 == qa2 * (qb1 - qb2) + qb1 * (qa1-qa2)) by ring.
  rewrite E',E.
  apply (Qle_lt_trans _ _ _ (Qabs_triangle (qa2 * (qb1 - qb2)) (qb1 * (qa1 - qa2)))).
  apply Qplus_lt_le_compat.
  * rewrite Qabs_Qmult.
    assert (HmNB2: (m > NB2)%nat) by omega.
    apply (Qmult_lt_compat_nonneg _ _ _ _ (Qabs_nonneg qa2) (Qabs_nonneg (qb1-qb2))).
    { apply (HMA2 m). auto. }
    { apply (HNB2 _ HmNB2). auto. auto. }
  * rewrite Qabs_Qmult. apply Qlt_le_weak.
    apply (Qmult_lt_compat_nonneg _ _ _ _ (Qabs_nonneg qb1) (Qabs_nonneg (qa1-qa2))).
    apply (HMB1 m). auto.
    apply (HNA1 _ HmNA1). auto. auto.
Qed.

(*Proofs about Rinv*)

Definition limit_not_0 (A:nat->Q->Prop):Prop:=
(exists (eps:Q), eps>0 /\ forall (N:nat), exists(nN:nat),(nN > N)%nat /\
   (forall(q:Q), A nN q -> Qabs q > eps)).

Lemma Non_0_QSeq: forall (A:nat->Q->Prop) n, Cauchy A ->
( ~(A n 0) )<->( forall  q, A n q -> ~(q == 0)).
Proof. split.
 - intros. intros C. rewrite C in H1. apply H0 in H1. destruct H1.
 - intros. intros C. apply H0 in C. assert (T: 0 == 0) by reflexivity. apply C in T. destruct T.
Qed.

Definition limit_not_0_real (A:Real):Prop:=
match A with
| Real_intro CA HA => limit_not_0 CA
end.

(* Every limit-not-0 Cauchy Sequence will not be 0 after a certain N *)
Lemma limit_not_0_seq : forall A (H:Cauchy A), limit_not_0_real (Real_intro A H) ->
 exists (N:nat), forall n, (n>N)%nat ->forall q, A n q -> ~(q == 0).
Proof. intros. hnf in H0. destruct H0 as [eps [Heps H0]].
  destruct (Cauchy_def _ H _ Heps) as [N' HN'].
  destruct (H0 N') as [nN' [HnN' H']].
  exists nN'. intros.
  assert (E: (n > N')%nat) by omega.
  destruct (Cauchy_exists _ H nN') as [qnN' HqnN'].
  assert (E1: Qabs (qnN' - q) < eps). { apply (HN' nN' n). auto. auto. auto. auto. }
  apply H' in HqnN'.
  assert (E2: Qabs q >= Qabs (qnN') - Qabs (qnN' - q)).
  { assert (Et: q == qnN' - (qnN' - q)) by ring.
    remember (qnN' - q) as t.
    rewrite Et. rewrite Heqt. apply Qabs_triangle_reverse. }
  apply Qopp_lt_compat in E1.
  assert (E3: Qabs qnN' - Qabs (qnN' - q) > eps - eps).
    { apply Qplus_lt_le_compat. auto. apply Qlt_le_weak. auto. }
  rewrite (Qplus_opp_r eps) in E3.
  assert (E4: Qabs q > 0). { apply (Qlt_le_trans _ _ _ E3 E2). }
  intros C. rewrite C in E4. discriminate E4.
Qed.

(* Some helping lemmas in justifying Rinv *)
Lemma FiniteSeqBounded_Below_nonneg: forall (A:nat->Q->Prop) (N:nat), Cauchy A ->
  exists (M:Q), M>=0 /\ forall (n:nat)(q:Q), (n < N)%nat -> A n q -> Qabs q >= M.
Proof. intros. induction N.
  - exists 1. intros. split. apply Qle_lteq. left. reflexivity. intros. inversion H0.
  - destruct IHN as [M [HM IH]]. destruct (Cauchy_exists _ H N) as [xN HxN].
    assert (Hq: Qlt M (Qabs xN) \/ ~ (Qlt M (Qabs xN))). { apply classic. } destruct Hq as [Hq | Hq].
    + exists M.
      split. apply HM.
      intros. unfold lt in H0. apply le_S_n in H0. apply Nat.le_lteq in H0. destruct H0.
      * apply (IH n). auto. auto.
      * rewrite <- H0 in HxN. assert (E: xN == q). { apply (Cauchy_unique _ H n _ _ HxN H1). }
        rewrite <- E. apply Qlt_le_weak. apply Hq.
    + exists ((Qabs xN))%Q. apply Qnot_lt_le in Hq. split.
      apply Qabs_nonneg.
 intros.
      unfold lt in H0. apply le_S_n in H0. apply Nat.le_lteq in H0. destruct H0.
      * apply (Qle_trans _ M). apply Hq. apply (IH n). apply H0. apply H1.
      * rewrite <- H0 in HxN.
        assert (E: xN == q). { apply (Cauchy_unique _ H n _ _ HxN H1). }
        rewrite <- E. apply Qle_lteq. right. reflexivity.
Qed.

Lemma FiniteNo0SeqBounded_Below_positive: forall (A:nat->Q->Prop) (N:nat), Cauchy A ->
  (exists N',forall n, (n>N')%nat ->  ~(A n 0)) ->
  exists (N':nat),exists (M:Q), M>0 /\ forall (n:nat)(q:Q), (n>N')%nat -> (n < N)%nat -> A n q -> Qabs q >= M.
Proof. intros. induction N. destruct H0 as [N' H0].
  - exists N',1. intros. split. reflexivity. intros. inversion H2.
  - destruct H0 as [N'1 H0].
    destruct IHN as [N' [M [HM IH]]]. destruct (Cauchy_exists _ H N) as [xN HxN].
    assert (Hq: Qlt M (Qabs xN) \/ ~ (Qlt M (Qabs xN))). { apply classic. } destruct Hq as [Hq | Hq].
    + exists N',M.
      split. apply HM.
      intros. unfold lt in H0. apply le_S_n in H2. apply Nat.le_lteq in H2. destruct H2.
      * apply (IH n). auto. auto. auto.
      * rewrite <- H2 in HxN. assert (E: xN == q). { apply (Cauchy_unique _ H n _ _ HxN H3). }
        rewrite <- E. apply Qlt_le_weak. apply Hq.
    + assert (En: lt N'1 N \/ ~ lt N'1 N) by (apply classic). destruct En as [En|En].
      * exists N,((Qabs xN))%Q. apply Qnot_lt_le in Hq. split.
        assert (E: 0<= Qabs xN) by (apply Qabs_nonneg). apply Qle_lteq in E.
        destruct E. apply H1. symmetry in H1. apply Qabs_0 in H1.
        rewrite H1 in HxN. apply H0 in HxN. destruct HxN. auto. intros.
        unfold lt in H1. omega.
      * exists N'1,1. split. reflexivity. intros.
        assert (E: lt N'1 N) by omega. contradiction.
Qed.

Lemma Cauchy_nonzero_pre: forall A  (HA:Cauchy A),  limit_not_0_real (Real_intro A HA)
  -> exists (N:nat),
( exists (eps0:Q), eps0>0 /\ (forall (n:nat), (n>N)%nat -> forall(q:Q), A n q -> Qabs q >= eps0)).
Proof. intros A HA. intros H.  destruct (limit_not_0_seq _ HA H) as [N0 Hnot0].
  assert (Hlim: limit_not_0 A) by auto.
  destruct H as [eps [Heps H]].
  destruct (Cauchy_def _ HA (eps*(1#2)) (eps_divide_2_positive _ Heps)) as [N1 HN].
  destruct (H N1) as [nN1 [HnN1N HnN1]].

assert (E:exists (N':nat),exists (M:Q), M>0 /\ forall (n:nat)(q:Q), (n>N')%nat -> (n < (S N1))%nat -> A n q -> Qabs q >= M ).
{ apply FiniteNo0SeqBounded_Below_positive. auto.
  destruct (limit_not_0_seq _ HA Hlim). exists x. intros. apply Non_0_QSeq. auto.
  intros. apply (H0 n). auto. auto. }
destruct E as [N' [x [Hx H0]]].

  assert (Eq: x < eps * (1#2) \/ ~(x<eps*(1#2))). { apply classic. } destruct Eq as [Eq | Eq].
  + exists N',x. split. apply Hx.
    intros. assert (En: lt n (S N1) \/ ~(lt n (S N1))) by (apply classic). destruct En.
    { apply (H0 n). auto. auto. auto. }
    { apply not_lt in H3. apply Qlt_le_weak. apply (Qlt_trans _ (eps*(1#2)) _).  apply Eq.
      destruct (Cauchy_exists _ HA nN1) as [qnN1 HqnN1].
      assert (E: (- q) == - (q - qnN1) - qnN1) by ring.
      rewrite <- Qabs_opp. rewrite E.
      apply (Qlt_le_trans _ (- Qabs (q - qnN1) +(Qabs qnN1))).
      * assert(E1: eps * (1 # 2) == - eps*(1#2) + eps) by ring.
        rewrite E1.
        apply Qplus_lt_le_compat.
      { apply Qlt_minus_iff. rewrite Qplus_comm.
        assert (E2: - (- eps * (1 # 2))  == eps*(1#2)) by ring. rewrite E2.
        apply (Qlt_minus_iff (Qabs (q - qnN1))). apply (HN n nN1). omega. omega. auto. auto. }
      { apply Qlt_le_weak. apply HnN1. auto. }
      * rewrite Qplus_comm. rewrite <- (Qabs_opp qnN1).
        rewrite (Qplus_comm (- (q - qnN1)) (- qnN1)).
        apply Qabs_triangle_reverse.
    }
  + exists N',(eps*(1#2)). apply Qnot_lt_le in Eq. split.
    apply (eps_divide_2_positive _ Heps). intros.
    assert (En: lt n (S N1) \/ ~(lt n (S N1))) by (apply classic). destruct En.
    { apply (Qle_trans _ x _). auto. apply (H0 n). auto. auto. auto. }
    { apply not_lt in H3. apply Qlt_le_weak.
      destruct (Cauchy_exists _ HA nN1) as [qnN1 HqnN1].
      assert (E: (- q) == - (q - qnN1) - qnN1) by ring.
      rewrite <- Qabs_opp. rewrite E.
      apply (Qlt_le_trans _ (- Qabs (q - qnN1) +(Qabs qnN1))).
      * assert(E1: eps * (1 # 2) == - eps*(1#2) + eps) by ring.
        rewrite E1.
        apply Qplus_lt_le_compat.
      { apply Qlt_minus_iff. rewrite Qplus_comm.
        assert (E2: - (- eps * (1 # 2))  == eps*(1#2)) by ring. rewrite E2.
        apply (Qlt_minus_iff (Qabs (q - qnN1))). apply (HN n nN1). omega. omega. auto. auto. }
      { apply Qlt_le_weak. apply HnN1. auto. }
      * rewrite Qplus_comm. rewrite <- (Qabs_opp qnN1).
        rewrite (Qplus_comm (- (q - qnN1)) (- qnN1)).
        apply Qabs_triangle_reverse.
    }
Qed.

(* A Cauchy Sequence can have its inversion as long as its limit is not 0 *)
Lemma Cauchy_inv_nonzero: forall A  (H:Cauchy A) , limit_not_0_real (Real_intro A H)
  -> Cauchy (fun (n:nat)(q:Q) => A n (/q)).
Proof. intros. split.
- intros. destruct (Cauchy_exists _ H n).
  exists (/x). rewrite <- (Qinv_involutive x) in H1. auto.
- intros. assert (E:/q1==/q2). { apply (Cauchy_unique _ H _ _ _ H1 H2). }
  rewrite <- Qinv_involutive. rewrite E. apply Qinv_involutive.
- intros. assert (E:/ p == / q). rewrite H1. reflexivity. rewrite <- E. auto.
- intros.
  assert (H0':(exists N', forall (n : nat), (n>N')%nat ->forall q, A n q -> ~ q == 0)). { apply (limit_not_0_seq _ H). auto. }
  destruct H0' as [N' H0'].
  destruct (Cauchy_nonzero_pre A H H0) as [N0 [eps0 [Heps0 H']]].
  assert (Eeps: 0 < eps * eps0 * eps0).
  { rewrite <- (Qmult_0_l eps0). apply (Qmult_lt_compat_r _ _ _ Heps0).
    rewrite <- (Qmult_0_l eps0). apply (Qmult_lt_compat_r _ _ _ Heps0). apply H1. }
  destruct (Cauchy_def _ H _ Eeps) as [N HN].
  assert (En: lt N' N \/ ~ lt N' N) by (apply classic). destruct En as [En|En].
  { assert (En': lt N0 N \/ ~ lt N0 N) by (apply classic). destruct En' as [En'|En'].
    { exists N. intros m1 m2 Hm1N Hm2N q1 q2 Hq1 Hq2.
      assert (E1:Qabs (/ q1 - / q2) < eps * eps0 * eps0). { apply (HN m1 m2). auto. auto. auto. auto. }
      assert (E2:Qabs(/q1) >0).
      { assert (Eq:Qabs (/q1) >= 0) by (apply Qabs_nonneg). apply Qle_lteq in Eq. destruct Eq.
        - apply H2. - apply H0' in Hq1. symmetry in H2. apply Qabs_0 in H2. contradiction. omega. }
      assert (E3:Qabs(/q2) >0).
      { assert (Eq:Qabs (/q2) >= 0) by (apply Qabs_nonneg). apply Qle_lteq in Eq. destruct Eq.
        - apply H2. - apply H0' in Hq2. symmetry in H2. apply Qabs_0 in H2. contradiction. omega. }
      assert (Em1N': (m1 > N')%nat) by omega.
      assert (Em2N': (m2 > N')%nat) by omega.
      assert (E4:/Qabs (/ q1) <= /eps0).
      { apply (Qmult_le_l _ _ _ E2).
        rewrite (Qmult_inv_r _ (Qnot_0_abs _ (H0' _ Em1N' _ Hq1))).
        rewrite Qmult_comm.
        apply (Qmult_le_l _ _ _ Heps0). rewrite Qmult_assoc.
        rewrite (Qmult_inv_r _ (Qlt_not_0 _ Heps0)).
        rewrite Qmult_1_r. rewrite Qmult_1_l.
        apply (H' m1). auto. omega. auto. }
      assert (E5:/Qabs (/ q2) <= /eps0).
      { apply (Qmult_le_l _ _ _ E3).
        rewrite (Qmult_inv_r _ (Qnot_0_abs _ (H0' _ Em2N' _ Hq2))).
        rewrite Qmult_comm.
        apply (Qmult_le_l _ _ _ Heps0). rewrite Qmult_assoc.
        rewrite (Qmult_inv_r _ (Qlt_not_0 _ Heps0)).
        rewrite Qmult_1_r. rewrite Qmult_1_l.
        apply (H' m2). auto. omega. auto. }
      assert (E6:q1 - q2 == (/q2-/q1)/((/q1)*(/q2))).
      { unfold Qdiv. unfold Qminus. rewrite Qmult_plus_distr_l.
        rewrite Qinv_mult_distr. rewrite Qinv_involutive. rewrite Qinv_involutive.
        rewrite (Qmult_comm (/q2)). rewrite <- Qmult_assoc.
        rewrite (Qmult_inv_r _ (Qinv_not_0 _ (Qabs_not_0 _ (Qlt_not_0 _ E3)))).
        rewrite (Qmult_assoc).
        assert (Etmp: - / q1 * q1 * q2 == - (/ q1 * q1 * q2)) by ring.
        rewrite Etmp. rewrite (Qmult_comm (/q1)).
        rewrite (Qmult_inv_r _ (Qinv_not_0 _ (Qabs_not_0 _ (Qlt_not_0 _ E2)))).
        ring. }
      assert (E7:eps == eps * eps0 * eps0 *  (/ eps0 * / eps0)).
      { rewrite Qmult_assoc.
        rewrite <- (Qmult_assoc _ eps0 (/eps0)).
        rewrite (Qmult_inv_r _ (Qlt_not_0 _ Heps0)).
        rewrite Qmult_1_r.
        rewrite <- Qmult_assoc. rewrite (Qmult_inv_r _ (Qlt_not_0 _ Heps0)).
        ring. }
      assert (E8: Qabs ((/ q2 - / q1) / (/ q1 * / q2)) ==
       Qabs (/ q2 - / q1) * (/ Qabs (/ q1) / Qabs (/ q2))).
      { unfold Qdiv. rewrite Qabs_Qmult.
        rewrite Qabs_Qinv. rewrite Qabs_Qmult. rewrite Qmult_assoc.
        rewrite Qinv_mult_distr. rewrite Qmult_assoc. reflexivity. }
      rewrite E6. rewrite E7. rewrite E8.
      assert (E9: / Qabs (/ q1) / Qabs (/ q2) > 0).
      { rewrite <- (Qmult_0_l (/ Qabs (/ q2))).
        apply (Qmult_lt_compat_r _ _ _ (Qinv_lt_0_compat _ E3) (Qinv_lt_0_compat _ E2)). }
      apply ( Qmult_lt_compat_trans_positive (
          Qabs (/ q2 - / q1))             (eps * eps0 * eps0)
          (/ Qabs (/ q1) / Qabs (/ q2))   (/ eps0 * / eps0)).
      apply Qabs_nonneg. apply E9.
      rewrite Qabs_Qminus. apply E1.
      unfold Qdiv. apply Qmult_le_compat_nonneg.
      apply (Qinv_le_0_compat _ (Qabs_nonneg (/ q1))).
      apply (Qinv_le_0_compat _ (Qabs_nonneg (/ q2))).
      auto. auto.     }
    { exists N0. apply not_lt in En'.
      intros m1 m2 Hm1N Hm2N q1 q2 Hq1 Hq2.
      assert (E1:Qabs (/ q1 - / q2) < eps * eps0 * eps0). { apply (HN m1 m2). omega. omega. auto. auto.  }
      assert (E2:Qabs(/q1) >0).
      { assert (Eq:Qabs (/q1) >= 0) by (apply Qabs_nonneg). apply Qle_lteq in Eq. destruct Eq.
        - apply H2. - apply H0' in Hq1. symmetry in H2. apply Qabs_0 in H2. contradiction. omega. }
      assert (E3:Qabs(/q2) >0).
      { assert (Eq:Qabs (/q2) >= 0) by (apply Qabs_nonneg). apply Qle_lteq in Eq. destruct Eq.
        - apply H2. - apply H0' in Hq2. symmetry in H2. apply Qabs_0 in H2. contradiction. omega. }
      assert (Em1N': (m1 > N')%nat) by omega.
      assert (Em2N': (m2 > N')%nat) by omega.
      assert (E4:/Qabs (/ q1) <= /eps0).
      { apply (Qmult_le_l _ _ _ E2).
        rewrite (Qmult_inv_r _ (Qnot_0_abs _ (H0' _ Em1N' _ Hq1))).
        rewrite Qmult_comm.
        apply (Qmult_le_l _ _ _ Heps0). rewrite Qmult_assoc.
        rewrite (Qmult_inv_r _ (Qlt_not_0 _ Heps0)).
        rewrite Qmult_1_r. rewrite Qmult_1_l.
        apply (H' m1). auto. auto. }
      assert (E5:/Qabs (/ q2) <= /eps0).
      { apply (Qmult_le_l _ _ _ E3).
        rewrite (Qmult_inv_r _ (Qnot_0_abs _ (H0' _ Em2N' _ Hq2))).
        rewrite Qmult_comm.
        apply (Qmult_le_l _ _ _ Heps0). rewrite Qmult_assoc.
        rewrite (Qmult_inv_r _ (Qlt_not_0 _ Heps0)).
        rewrite Qmult_1_r. rewrite Qmult_1_l.
        apply (H' m2). auto. auto. }
      assert (E6:q1 - q2 == (/q2-/q1)/((/q1)*(/q2))).
      { unfold Qdiv. unfold Qminus. rewrite Qmult_plus_distr_l.
        rewrite Qinv_mult_distr. rewrite Qinv_involutive. rewrite Qinv_involutive.
        rewrite (Qmult_comm (/q2)). rewrite <- Qmult_assoc.
        rewrite (Qmult_inv_r _ (Qinv_not_0 _ (Qabs_not_0 _ (Qlt_not_0 _ E3)))).
        rewrite (Qmult_assoc).
        assert (Etmp: - / q1 * q1 * q2 == - (/ q1 * q1 * q2)) by ring.
        rewrite Etmp. rewrite (Qmult_comm (/q1)).
        rewrite (Qmult_inv_r _ (Qinv_not_0 _ (Qabs_not_0 _ (Qlt_not_0 _ E2)))).
        ring. }
      assert (E7:eps == eps * eps0 * eps0 *  (/ eps0 * / eps0)).
      { rewrite Qmult_assoc.
        rewrite <- (Qmult_assoc _ eps0 (/eps0)).
        rewrite (Qmult_inv_r _ (Qlt_not_0 _ Heps0)).
        rewrite Qmult_1_r.
        rewrite <- Qmult_assoc. rewrite (Qmult_inv_r _ (Qlt_not_0 _ Heps0)).
        ring. }
      assert (E8: Qabs ((/ q2 - / q1) / (/ q1 * / q2)) ==
       Qabs (/ q2 - / q1) * (/ Qabs (/ q1) / Qabs (/ q2))).
      { unfold Qdiv. rewrite Qabs_Qmult.
        rewrite Qabs_Qinv. rewrite Qabs_Qmult. rewrite Qmult_assoc.
        rewrite Qinv_mult_distr. rewrite Qmult_assoc. reflexivity. }
      rewrite E6. rewrite E7. rewrite E8.
      assert (E9: / Qabs (/ q1) / Qabs (/ q2) > 0).
      { rewrite <- (Qmult_0_l (/ Qabs (/ q2))).
        apply (Qmult_lt_compat_r _ _ _ (Qinv_lt_0_compat _ E3) (Qinv_lt_0_compat _ E2)). }
      apply ( Qmult_lt_compat_trans_positive (
          Qabs (/ q2 - / q1))             (eps * eps0 * eps0)
          (/ Qabs (/ q1) / Qabs (/ q2))   (/ eps0 * / eps0)).
      apply Qabs_nonneg. apply E9.
      rewrite Qabs_Qminus. apply E1.
      unfold Qdiv. apply Qmult_le_compat_nonneg.
      apply (Qinv_le_0_compat _ (Qabs_nonneg (/ q1))).
      apply (Qinv_le_0_compat _ (Qabs_nonneg (/ q2))).
      auto. auto. }
    }

  { assert (En': lt N0 N' \/ ~ lt N0 N') by (apply classic). destruct En' as [En'|En'].
    { apply not_lt in En. exists N'. intros m1 m2 Hm1N Hm2N q1 q2 Hq1 Hq2.
      assert (E1:Qabs (/ q1 - / q2) < eps * eps0 * eps0). { apply (HN m1 m2). omega. omega. auto. auto. }
      assert (E2:Qabs(/q1) >0).
      { assert (Eq:Qabs (/q1) >= 0) by (apply Qabs_nonneg). apply Qle_lteq in Eq. destruct Eq.
        - apply H2. - apply H0' in Hq1. symmetry in H2. apply Qabs_0 in H2. contradiction. omega. }
      assert (E3:Qabs(/q2) >0).
      { assert (Eq:Qabs (/q2) >= 0) by (apply Qabs_nonneg). apply Qle_lteq in Eq. destruct Eq.
        - apply H2. - apply H0' in Hq2. symmetry in H2. apply Qabs_0 in H2. contradiction. omega. }
      assert (Em1N': (m1 > N')%nat) by omega.
      assert (Em2N': (m2 > N')%nat) by omega.
      assert (E4:/Qabs (/ q1) <= /eps0).
      { apply (Qmult_le_l _ _ _ E2).
        rewrite (Qmult_inv_r _ (Qnot_0_abs _ (H0' _ Em1N' _ Hq1))).
        rewrite Qmult_comm.
        apply (Qmult_le_l _ _ _ Heps0). rewrite Qmult_assoc.
        rewrite (Qmult_inv_r _ (Qlt_not_0 _ Heps0)).
        rewrite Qmult_1_r. rewrite Qmult_1_l.
        apply (H' m1). auto. omega. auto. }
      assert (E5:/Qabs (/ q2) <= /eps0).
      { apply (Qmult_le_l _ _ _ E3).
        rewrite (Qmult_inv_r _ (Qnot_0_abs _ (H0' _ Em2N' _ Hq2))).
        rewrite Qmult_comm.
        apply (Qmult_le_l _ _ _ Heps0). rewrite Qmult_assoc.
        rewrite (Qmult_inv_r _ (Qlt_not_0 _ Heps0)).
        rewrite Qmult_1_r. rewrite Qmult_1_l.
        apply (H' m2). auto. omega. auto. }
      assert (E6:q1 - q2 == (/q2-/q1)/((/q1)*(/q2))).
      { unfold Qdiv. unfold Qminus. rewrite Qmult_plus_distr_l.
        rewrite Qinv_mult_distr. rewrite Qinv_involutive. rewrite Qinv_involutive.
        rewrite (Qmult_comm (/q2)). rewrite <- Qmult_assoc.
        rewrite (Qmult_inv_r _ (Qinv_not_0 _ (Qabs_not_0 _ (Qlt_not_0 _ E3)))).
        rewrite (Qmult_assoc).
        assert (Etmp: - / q1 * q1 * q2 == - (/ q1 * q1 * q2)) by ring.
        rewrite Etmp. rewrite (Qmult_comm (/q1)).
        rewrite (Qmult_inv_r _ (Qinv_not_0 _ (Qabs_not_0 _ (Qlt_not_0 _ E2)))).
        ring. }
      assert (E7:eps == eps * eps0 * eps0 *  (/ eps0 * / eps0)).
      { rewrite Qmult_assoc.
        rewrite <- (Qmult_assoc _ eps0 (/eps0)).
        rewrite (Qmult_inv_r _ (Qlt_not_0 _ Heps0)).
        rewrite Qmult_1_r.
        rewrite <- Qmult_assoc. rewrite (Qmult_inv_r _ (Qlt_not_0 _ Heps0)).
        ring. }
      assert (E8: Qabs ((/ q2 - / q1) / (/ q1 * / q2)) ==
       Qabs (/ q2 - / q1) * (/ Qabs (/ q1) / Qabs (/ q2))).
      { unfold Qdiv. rewrite Qabs_Qmult.
        rewrite Qabs_Qinv. rewrite Qabs_Qmult. rewrite Qmult_assoc.
        rewrite Qinv_mult_distr. rewrite Qmult_assoc. reflexivity. }
      rewrite E6. rewrite E7. rewrite E8.
      assert (E9: / Qabs (/ q1) / Qabs (/ q2) > 0).
      { rewrite <- (Qmult_0_l (/ Qabs (/ q2))).
        apply (Qmult_lt_compat_r _ _ _ (Qinv_lt_0_compat _ E3) (Qinv_lt_0_compat _ E2)). }
      apply ( Qmult_lt_compat_trans_positive (
          Qabs (/ q2 - / q1))             (eps * eps0 * eps0)
          (/ Qabs (/ q1) / Qabs (/ q2))   (/ eps0 * / eps0)).
      apply Qabs_nonneg. apply E9.
      rewrite Qabs_Qminus. apply E1.
      unfold Qdiv. apply Qmult_le_compat_nonneg.
      apply (Qinv_le_0_compat _ (Qabs_nonneg (/ q1))).
      apply (Qinv_le_0_compat _ (Qabs_nonneg (/ q2))).
      auto. auto.    }
    { apply not_lt in En. apply not_lt in En'. exists N0.
      intros m1 m2 Hm1N Hm2N q1 q2 Hq1 Hq2.
      assert (E1:Qabs (/ q1 - / q2) < eps * eps0 * eps0). { apply (HN m1 m2). omega. omega. auto. auto.  }
      assert (E2:Qabs(/q1) >0).
      { assert (Eq:Qabs (/q1) >= 0) by (apply Qabs_nonneg). apply Qle_lteq in Eq. destruct Eq.
        - apply H2. - apply H0' in Hq1. symmetry in H2. apply Qabs_0 in H2. contradiction. omega. }
      assert (E3:Qabs(/q2) >0).
      { assert (Eq:Qabs (/q2) >= 0) by (apply Qabs_nonneg). apply Qle_lteq in Eq. destruct Eq.
        - apply H2. - apply H0' in Hq2. symmetry in H2. apply Qabs_0 in H2. contradiction. omega. }
      assert (Em1N': (m1 > N')%nat) by omega.
      assert (Em2N': (m2 > N')%nat) by omega.
      assert (E4:/Qabs (/ q1) <= /eps0).
      { apply (Qmult_le_l _ _ _ E2).
        rewrite (Qmult_inv_r _ (Qnot_0_abs _ (H0' _ Em1N' _ Hq1))).
        rewrite Qmult_comm.
        apply (Qmult_le_l _ _ _ Heps0). rewrite Qmult_assoc.
        rewrite (Qmult_inv_r _ (Qlt_not_0 _ Heps0)).
        rewrite Qmult_1_r. rewrite Qmult_1_l.
        apply (H' m1). auto. auto. }
      assert (E5:/Qabs (/ q2) <= /eps0).
      { apply (Qmult_le_l _ _ _ E3).
        rewrite (Qmult_inv_r _ (Qnot_0_abs _ (H0' _ Em2N' _ Hq2))).
        rewrite Qmult_comm.
        apply (Qmult_le_l _ _ _ Heps0). rewrite Qmult_assoc.
        rewrite (Qmult_inv_r _ (Qlt_not_0 _ Heps0)).
        rewrite Qmult_1_r. rewrite Qmult_1_l.
        apply (H' m2). auto. auto. }
      assert (E6:q1 - q2 == (/q2-/q1)/((/q1)*(/q2))).
      { unfold Qdiv. unfold Qminus. rewrite Qmult_plus_distr_l.
        rewrite Qinv_mult_distr. rewrite Qinv_involutive. rewrite Qinv_involutive.
        rewrite (Qmult_comm (/q2)). rewrite <- Qmult_assoc.
        rewrite (Qmult_inv_r _ (Qinv_not_0 _ (Qabs_not_0 _ (Qlt_not_0 _ E3)))).
        rewrite (Qmult_assoc).
        assert (Etmp: - / q1 * q1 * q2 == - (/ q1 * q1 * q2)) by ring.
        rewrite Etmp. rewrite (Qmult_comm (/q1)).
        rewrite (Qmult_inv_r _ (Qinv_not_0 _ (Qabs_not_0 _ (Qlt_not_0 _ E2)))).
        ring. }
      assert (E7:eps == eps * eps0 * eps0 *  (/ eps0 * / eps0)).
      { rewrite Qmult_assoc.
        rewrite <- (Qmult_assoc _ eps0 (/eps0)).
        rewrite (Qmult_inv_r _ (Qlt_not_0 _ Heps0)).
        rewrite Qmult_1_r.
        rewrite <- Qmult_assoc. rewrite (Qmult_inv_r _ (Qlt_not_0 _ Heps0)).
        ring. }
      assert (E8: Qabs ((/ q2 - / q1) / (/ q1 * / q2)) ==
       Qabs (/ q2 - / q1) * (/ Qabs (/ q1) / Qabs (/ q2))).
      { unfold Qdiv. rewrite Qabs_Qmult.
        rewrite Qabs_Qinv. rewrite Qabs_Qmult. rewrite Qmult_assoc.
        rewrite Qinv_mult_distr. rewrite Qmult_assoc. reflexivity. }
      rewrite E6. rewrite E7. rewrite E8.
      assert (E9: / Qabs (/ q1) / Qabs (/ q2) > 0).
      { rewrite <- (Qmult_0_l (/ Qabs (/ q2))).
        apply (Qmult_lt_compat_r _ _ _ (Qinv_lt_0_compat _ E3) (Qinv_lt_0_compat _ E2)). }
      apply ( Qmult_lt_compat_trans_positive (
          Qabs (/ q2 - / q1))             (eps * eps0 * eps0)
          (/ Qabs (/ q1) / Qabs (/ q2))   (/ eps0 * / eps0)).
      apply Qabs_nonneg. apply E9.
      rewrite Qabs_Qminus. apply E1.
      unfold Qdiv. apply Qmult_le_compat_nonneg.
      apply (Qinv_le_0_compat _ (Qabs_nonneg (/ q1))).
      apply (Qinv_le_0_compat _ (Qabs_nonneg (/ q2))).
      auto. auto. }
    }
Qed.

Lemma limit_not_0_spec: forall x: Real,
  (~ x == Rzero)%R <-> limit_not_0_real x.
Proof. intros. split.
- intros. hnf. unfold Real_equiv in H. destruct x as [A HA]. unfold Rzero in *.
  apply not_all_ex_not in H. destruct H as [q Hq]. apply imply_to_and in Hq.
  destruct Hq as [Hq H]. assert (E: forall n, ~(forall m, (m>n)%nat -> (forall q1 q2 : Q, A m q1 -> q2 == 0 -> Qabs (q1 - q2) < q))).
  { intros n. apply (not_ex_all_not _ _ H n). }
  exists (q*(1#2)). split. apply eps_divide_2_positive. auto.
  intros N. assert (E1: ~(forall m : nat,
     (m > N)%nat -> forall q1 q2 : Q, A m q1 -> q2 == 0 -> Qabs (q1 - q2) < q)). { apply E. }
  clear H. clear E. apply not_all_ex_not in E1. destruct E1 as [nN E1].
  exists nN. apply imply_to_and in E1. destruct E1 as [E1 E2].
  split. apply E1. apply (not_all_ex_not) in E2. destruct E2 as [q1 Hq1].
  apply not_all_ex_not in Hq1. destruct Hq1 as [q2 Hq1].
  apply imply_to_and in Hq1. destruct Hq1 as [Hq1 H].
  apply imply_to_and in H. destruct H as [Hq2 H].
  rewrite Hq2 in H. intros q0 Hq0. assert (E: q0==q1).
  { apply (Cauchy_unique _ HA nN). auto. auto. }
  assert (E2: Qabs q0 >= q). { apply Qnot_lt_le in H.
    assert (Et:q1 - 0 == q1) by ring. rewrite Et in H. rewrite E. auto. }
  apply (Qlt_le_trans _ q).
  { apply (Qplus_lt_l _ _ (-q*(1#2))).
    assert (Et1: q * (1 # 2) + - q * (1 # 2) == 0) by ring.
    assert (Et2: q + - q * (1 # 2) == q*(1#2)) by ring.
    rewrite Et1,Et2. apply eps_divide_2_positive. auto. }
  auto.
- intros. destruct x as [A HA]. hnf in *. intros C. hnf in *.
  destruct H as [eps0 [Heps0 H]]. apply C in Heps0.
  destruct Heps0 as [n Hn]. destruct (H n) as [nN [HnN Hn']].
  destruct (Cauchy_exists _ HA nN) as [qnN HqnN].
  assert (E1: eps0 < Qabs qnN) by auto.
  assert (E2: eps0 > Qabs (qnN - 0)). { apply (Hn nN). auto. auto. reflexivity. }
  assert (Et: qnN-0 == qnN) by ring. rewrite Et in E2.
  assert (Nonsense: Qabs qnN <Qabs qnN ). { apply (Qlt_trans _ eps0). auto. auto. }
  apply Qlt_irrefl in Nonsense.  contradiction.
Qed.

Definition Rinv (a: {a0: Real | (~ a0 == Rzero)%R }): Real :=
  match a with
  | exist _ (Real_intro a0 H) H0 =>
      Real_intro
        (fun (n : nat) (q : Q) => a0 n (/ q))
        (Cauchy_inv_nonzero a0 H (proj1 (limit_not_0_spec (Real_intro a0 H)) H0))
  end.

Notation "/ x" := (Rinv x) : Real_scope.

Definition Rdiv x y := Rmult x (Rinv y).

Infix "/" := Rdiv : R_scope.

Theorem take_max_N_3prop:
forall N1 N2 N3 (P Q R:nat->Prop),
 (forall n, (n>N1)%nat -> P n) -> (forall n ,(n>N2)%nat -> Q n) ->
 (forall n, (n>N3)%nat -> R n) ->
  exists N, forall n,(n>N)%nat -> P n /\  Q n /\ R n.
Proof. intros N1 N2 N3 P Q R H1 H2 H3.
  destruct (classic (N1>N2)%nat),(classic (N1>N3)%nat),(classic (N2>N3)%nat).
  - exists N1. intros. split.
    * auto.
    * split. ** apply H2. omega.
             ** apply H3. omega.
  - exists N1. intros. split.
    * auto.
    * split. ** apply H2. omega.
             ** apply H3. omega.
  - exists O. split.
    * omega.
    * split. ** omega.
             ** omega.
  - exists N3. intros. split.
    * apply H1. omega.
    * split. ** apply H2. omega.
             ** apply H3. omega.
  - exists N2. intros. split.
    * apply H1. omega.
    * split. ** apply H2. omega.
             ** apply H3. omega.
  - exists O. split.
    * intros. omega.
    * split. ** omega.
             ** omega.
  - exists N2. intros. split.
    * intros. apply H1. omega.
    * split. ** apply H2. omega.
             ** apply H3. omega.
  - exists N3. intros. split.
    * apply H1. omega.
    * split. ** apply H2. omega.
             ** apply H3. omega.
Qed.

Theorem Rinv_equiv: forall A B,
((match A with exist _ A HA => A end) == (match B with exist _ B HB => B end))%R ->
(Rinv A == Rinv B)%R.
Proof. intros [[A HA1] HA2]. intros [[B HB1] HB2]. intros H. hnf in *.
  apply limit_not_0_spec in HA2. apply limit_not_0_spec in HB2.
  intros eps Heps.
  destruct (Cauchy_nonzero_pre _ HA1 HA2) as [NA [Amin [HAmin HA3]]].
  destruct (Cauchy_nonzero_pre _ HB1 HB2) as [NB [Bmin [HBmin HB3]]].
  assert (Eeps: 0< eps*Amin*Bmin).
  { rewrite <- (Qmult_0_l (Amin * Bmin)).
    rewrite Qmult_assoc.
   apply Qmult_lt_r. auto. apply Qmult_lt_r. auto. auto. }
  destruct (H (eps*Amin*Bmin) Eeps) as [N HN]. clear H.
  destruct (take_max_N_3prop NA NB N
    (fun n => forall q : Q, A n q -> Amin <= Qabs q)
    (fun n => forall q : Q, B n q -> Bmin <= Qabs q)
    (fun m => forall q1 q2 : Q, A m q1 -> B m q2 -> Qabs (q1 - q2) < eps * Amin * Bmin)
    HA3 HB3 HN) as [N0 H].
  clear HA3 HB3 HN NA NB N.
  apply (limit_not_0_seq A HA1) in HA2. destruct HA2 as [NA HA3].
  apply (limit_not_0_seq B HB1) in HB2. destruct HB2 as [NB HB3].
  destruct (take_max_N_3prop NA NB N0 _ _ _ HA3 HB3 H) as [N1 H0].
  clear HA3 HB3 H NA NB N0.
  exists N1. intros.
  destruct (H0 _ H) as [E1 [E2 [E3 [E4 E5]]]]. clear H0.
  assert (P1: Qabs ((/q2) - (/q1)) < eps * Amin * Bmin). { rewrite Qabs_Qminus. auto. }
  assert (P2: q1 - q2 == (/q2 - /q1)*(q1)*q2).
  { field. split. apply Qinv_not_0. auto. apply Qinv_not_0. auto. }
  rewrite P2. rewrite <- Qmult_assoc. rewrite Qabs_Qmult.
  assert (P3: q1 * q2 == / (/q1 * /q2)).
  { field. split. apply Qinv_not_0. auto. apply Qinv_not_0. auto. }
  rewrite P3. rewrite Qabs_Qinv.
  rewrite Qabs_Qmult. rewrite Qinv_mult_distr.
  assert (P4: / Qabs(/q1) <= /Amin).
  { apply (Qmult_le_r _ _ _ HAmin).
    assert (Pt: Qabs (/ q1)>0).
    { destruct ((proj1 (Qle_lteq _ _)) (Qabs_nonneg (/q1))).
    - auto. - symmetry in H0. apply Qabs_0 in H0. apply E1 in H1. contradiction. }
    apply (Qmult_le_l _ _ _ Pt).
    assert (Pt2: Qabs (/ q1) * (/ Amin * Amin) == Qabs(/q1)).
    { field. intros C. rewrite C in HAmin. apply Qlt_irrefl in HAmin. auto. }
    assert (Pt3: Qabs (/ q1) * (/ Qabs (/ q1) * Amin) == Amin).
    { field. intros C. apply Qabs_0 in C. rewrite C in H1. apply E1 in H1.
      apply H1. reflexivity. }
    rewrite Pt2,Pt3. apply E3. auto. }
  assert (P5: / Qabs(/q2) <= /Bmin).
  { apply (Qmult_le_r _ _ _ HBmin).
    assert (Pt: Qabs (/ q2)>0).
    { destruct ((proj1 (Qle_lteq _ _)) (Qabs_nonneg (/q2))).
    - auto. - symmetry in H0. apply Qabs_0 in H0. apply E2 in H2. contradiction. }
    apply (Qmult_le_l _ _ _ Pt).
    assert (Pt2: Qabs (/ q2) * (/ Bmin * Bmin) == Qabs(/q2)).
    { field. intros C. rewrite C in HBmin. apply Qlt_irrefl in HBmin. auto. }
    assert (Pt3: Qabs (/ q2) * (/ Qabs (/ q2) * Bmin) == Bmin).
    { field. intros C. apply Qabs_0 in C. rewrite C in H2. apply E2 in H2.
      apply H2. reflexivity. }
    rewrite Pt2,Pt3. apply E4. auto. }
  assert (P6: eps == (eps * Amin * Bmin) * (/Amin * /Bmin)).
  { field. split.
    - intros C. rewrite C in HBmin. apply Qlt_irrefl in HBmin. contradiction.
    - intros C. rewrite C in HAmin. apply Qlt_irrefl in HAmin. contradiction. }
  rewrite P6.
  apply (Qmult_lt_compat_trans_positive  (Qabs (/ q2 - / q1)) (eps * Amin * Bmin) ).
  - apply Qabs_nonneg.
  - rewrite <- (Qmult_0_r (/ (Qabs (/ q1)))).
    apply Qmult_lt_l.
    + apply Qinv_lt_0_compat.
      destruct ((proj1 (Qle_lteq _ _)) (Qabs_nonneg (/q1))).
      * auto. * symmetry in H0. apply Qabs_0 in H0. apply E1 in H1. contradiction.
    + apply Qinv_lt_0_compat.
      destruct ((proj1 (Qle_lteq _ _)) (Qabs_nonneg (/q2))).
      * auto. * symmetry in H0. apply Qabs_0 in H0. apply E2 in H2. contradiction.
  - auto.
  - apply Qmult_le_compat_nonneg.
    + apply Qlt_le_weak. apply Qinv_lt_0_compat.
      destruct ((proj1 (Qle_lteq _ _)) (Qabs_nonneg (/q1))).
      * auto. * symmetry in H0. apply Qabs_0 in H0. apply E1 in H1. contradiction.
    + apply Qlt_le_weak. apply Qinv_lt_0_compat.
      destruct ((proj1 (Qle_lteq _ _)) (Qabs_nonneg (/q2))).
      * auto. * symmetry in H0. apply Qabs_0 in H0. apply E2 in H2. contradiction.
    + auto. + auto.
Qed.

Theorem Rmult_comm: forall A B,
  (A * B == B * A)%R.
Proof. intros [A HA] [B HB].
unfold Real_equiv. unfold Rmult.
unfold CauchySeqMult. intros eps Heps. exists O.
intros. destruct (Cauchy_exists _ HA m) as [qa Hqa].
destruct (Cauchy_exists _ HB m) as [qb Hqb].
assert (E1: q1 == qa * qb). { auto. }
assert (E2: q2 == qb * qa). { auto. }
rewrite E1,E2.
assert (E: qa * qb - qb * qa == 0) by ring.
rewrite E. apply Heps.
Qed.

Theorem Rmult_assoc: forall A B C,
  ( A * B * C == A * (B * C))%R.
Proof. intros [A HA] [B HB] [C HC]. hnf.
  unfold CauchySeqMult. intros eps Heps. exists O.
  intros. destruct (Cauchy_exists _ HA m) as [qa Hqa].
  destruct (Cauchy_exists _ HB m) as [qb Hqb].
  destruct (Cauchy_exists _ HC m) as [qc Hqc].
  assert (E1: q1 == qa * qb * qc).
  { apply H0. intros. rewrite (Cauchy_unique _ HA m q0 qa H2 Hqa).
    rewrite (Cauchy_unique _ HB m qb q3 Hqb H3).
    reflexivity. auto. }
  assert (E2: q2 == qa * (qb * qc)).
  { apply H1. auto. intros. rewrite (Cauchy_unique _ HB m q0 qb H2 Hqb).
    rewrite (Cauchy_unique _ HC m qc q3 Hqc H3). reflexivity. }
  assert (E: qa * qb * qc - qa * (qb * qc) == 0) by ring.
  rewrite E1,E2,E. apply Heps.
Qed.

Definition Rone:Real :=
 Real_intro (fun (n:nat) => (fun x => x == 1)) (Real_has_Q 1).

Notation " 1 " := Rone : Real_scope.

Theorem Rmult_1_r: forall A, (A * Rone == A)%R.
Proof. intros [A HA]. hnf. unfold CauchySeqMult.
  intros. exists O. intros.
  assert (E:q1 == q2). { rewrite <- (Qmult_1_r q2). apply H1. auto. reflexivity. }
  rewrite E. unfold Qminus. rewrite Qplus_opp_r. apply H.
Qed.

Theorem Rmult_inv_r: forall A:{A: Real | (~ A == Rzero)%R },
((match A with | exist _ A0 _ => A0 end) * (Rinv A) == Rone)%R.
Proof. intros [[A HA1] HA2]. hnf. apply limit_not_0_spec in HA2.
  apply (limit_not_0_seq _ HA1) in HA2. destruct HA2 as [N HA2].
  intros eps Heps. exists N. intros. unfold CauchySeqMult in H0.
  destruct (Cauchy_exists _ HA1 m) as [qm Hqm].
  assert (E: q1 == qm * /qm). { apply H0. apply Hqm. rewrite Qinv_involutive. apply Hqm. }
  rewrite Qmult_inv_r in E. rewrite H1,E. apply Heps.
  apply (HA2 m). auto. auto.
Qed.

Theorem Rmult_inv_r': forall (A: Real) (H: (~ A == Rzero)%R),
(A * (Rinv (exist _ A H)) == Rone)%R.
Proof. intros [A HA1] HA2. hnf. apply limit_not_0_spec in HA2.
  apply (limit_not_0_seq _ HA1) in HA2. destruct HA2 as [N HA2].
  intros eps Heps. exists N. intros. unfold CauchySeqMult in H0.
  destruct (Cauchy_exists _ HA1 m) as [qm Hqm].
  assert (E: q1 == qm * /qm). { apply H0. apply Hqm. rewrite Qinv_involutive. apply Hqm. }
  rewrite Qmult_inv_r in E. rewrite H1,E. apply Heps.
  apply (HA2 m). auto. auto.
Qed.

Theorem Rmult_plus_distr_r: forall A B C, (A*(B+C)==A*B+A*C)%R.
Proof. intros [A HA] [B HB] [C HC] eps Heps. hnf. unfold CauchySeqMult. unfold CauchySeqPlus.
  exists O. intros m Hm Q1 Q2 H1 H2.
  destruct (Cauchy_exists _ HA m) as [qa Hqa].
  destruct (Cauchy_exists _ HB m) as [qb Hqb].
  destruct (Cauchy_exists _ HC m) as [qc Hqc].
  assert (E1: Q1 == qa * (qb + qc)).
  { apply H1. auto. intros. rewrite (Cauchy_unique _ HB m q1 qb H Hqb).
    rewrite (Cauchy_unique _ HC m qc q2 Hqc H0). reflexivity. }
  assert (E2: Q2 == qa * qb + qa * qc).
  { apply H2. intros. rewrite (Cauchy_unique _ HA m q1 qa H Hqa).
    rewrite (Cauchy_unique _ HB m q2 qb H0 Hqb). reflexivity.
    intros. rewrite (Cauchy_unique _ HA m q1 qa H Hqa).
    rewrite (Cauchy_unique _ HC m qc q2 Hqc H0). reflexivity. }
  assert (E: qa * (qb + qc) - (qa * qb + qa * qc) == 0) by ring.
  rewrite E1,E2,E. auto.
Qed.

Instance Rplus_comp : Proper (Real_equiv ==> Real_equiv ==> Real_equiv) Rplus.
Proof. hnf. intros. hnf. intros.
  apply Cauchy_Plus_equiv. auto. auto.
Qed.

Instance Ropp_comp : Proper (Real_equiv ==> Real_equiv) Ropp.
Proof. hnf. intros [A HA] [B HB] H. hnf in *. unfold Cauchy_opp in *. intros.
  destruct (H _ H0) as [N HN]. exists N. intros.
  destruct (Cauchy_exists _ HA m) as [qa Hqa].
  destruct (Cauchy_exists _ HB m) as [qb Hqb].
  assert (E1: q1 == -qa) by auto.
  assert (E2: q2 == -qb) by auto.
  rewrite E1,E2. assert (E3: - qa - - qb == (qb - qa)) by ring.
  rewrite E3. rewrite Qabs_Qminus. apply (HN _ H1). auto. auto.
Qed.

Instance Rminus_comp : Proper (Real_equiv ==> Real_equiv ==> Real_equiv) Rminus.
Proof. hnf. intros. hnf. intros.
  apply Ropp_comp in H0. unfold Rminus.
  rewrite H,H0. reflexivity.
Qed.

Instance Rmult_comp : Proper (Real_equiv ==> Real_equiv ==> Real_equiv) Rmult.
Proof. hnf. intros. hnf. intros.
  apply Cauchy_Mult_equiv. auto. auto.
Qed.

Lemma Rplus_0_l : forall x, (0+x == x)%R.
Proof. intros. rewrite Rplus_comm. apply Rplus_Zero.
Qed.
Lemma Rplus_0_r : forall x, (x+0 == x)%R.
Proof. intros. apply Rplus_Zero.
Qed.
Theorem Ropp_involutive: forall x, (x == - - x)%R.
Proof. intros. destruct x as [A HA]. hnf in *.
  unfold Cauchy_opp. intros. exists O.
  intros. assert (E: q2 == - - q1).
    { apply H2. intros. rewrite (Cauchy_unique _ HA _ _ _ H1 H3). reflexivity. }
  rewrite E. assert (Et: q1 - - - q1 == 0) by ring.
  rewrite Et. apply H.
Qed.

Theorem Ropp_plus_distr: forall x y, (- (x + y) == - x + - y)%R.
Proof. intros. destruct x as [A HA], y as [B HB].
  hnf in *. unfold Cauchy_opp. unfold CauchySeqPlus.
  intros. exists O. intros.
  destruct (Cauchy_exists _ HA m) as [qa Hqa].
  destruct (Cauchy_exists _ HB m) as [qb Hqb].
  assert (E1: q1 == - (qa + qb)).
  { apply H1. intros.
    rewrite (Cauchy_unique _ HA _ _ _ Hqa H3).
    rewrite (Cauchy_unique _ HB _ _ _ Hqb H4).
    reflexivity. }
  assert (E2: q2 == -qa + -qb).
  { apply H2. intros. rewrite (Cauchy_unique _ HA _ _ _ Hqa H3). reflexivity.
    intros. rewrite (Cauchy_unique _ HB _ _ _ Hqb H3). reflexivity. }
  assert (E3: q1 - q2 == 0).
  { rewrite E1. rewrite E2. ring. }
  rewrite E3. apply H.
Qed.

Lemma Rplus_inj_r (x y z: Real):
  (x + z == y + z)%R <-> (x == y)%R.
Proof. intros. split.
  - intros. assert (E: (x == x + 0)%R). { rewrite Rplus_0_r. reflexivity. }
    rewrite E. rewrite <- (Rplus_opp_r z). rewrite <- Rplus_assoc.
    rewrite H. rewrite Rplus_assoc. rewrite Rplus_opp_r. rewrite Rplus_0_r. reflexivity.
  - intros. rewrite H. reflexivity.
Qed.

Lemma Rplus_inj_l (x y z: Real):
  (z + x == z + y)%R <-> (x == y)%R.
Proof. intros. split.
  - intros. rewrite Rplus_comm in H. rewrite (Rplus_comm z y) in H.
    apply (proj1 (Rplus_inj_r x y z)). auto.
  - intros. rewrite H. reflexivity.
Qed.

Lemma Rmult_0_l : forall x , (0*x == 0)%R.
Proof. intros. destruct x. hnf.
  intros. exists O. intros. unfold CauchySeqMult in *.
  destruct (Cauchy_exists _ H m) as [qa Hqa].
  rewrite (H2 _ _ H3 Hqa). rewrite H3. assert (E: 0*qa-0==0) by ring.
  rewrite E. apply H0.
Qed.

Lemma Rmult_0_r : forall x , (x*0 == 0)%R.
Proof. intros. rewrite Rmult_comm. apply Rmult_0_l.
Qed.

Lemma Rmult_1_l : forall n, (1*n == n)%R.
Proof. intros. rewrite Rmult_comm. apply Rmult_1_r.
Qed.

Theorem Rmult_plus_distr_l : forall x y z, ((x+y)*z==(x*z)+(y*z))%R.
Proof. intros. rewrite Rmult_comm.
  rewrite Rmult_plus_distr_r. rewrite Rmult_comm. rewrite (Rmult_comm z y).
  reflexivity.
Qed.

Theorem Rmult_integral : forall x y, (x*y==0)%R -> (x==0)%R \/ (y==0)%R.
Proof. intros.
  destruct (classic (x==0)%R).
  - left. apply H0.
  - right. rewrite <- Rmult_1_l. rewrite <- (Rmult_inv_r' x H0).
    rewrite (Rmult_comm x). rewrite Rmult_assoc. rewrite H. rewrite Rmult_0_r.
    reflexivity.
Qed.

Theorem Rmult_integral_l : forall x y, ~ (x == 0)%R -> (x*y == 0)%R -> (y == 0)%R.
Proof. intros. apply Rmult_integral in H0. destruct H0.
  - contradiction.
  - auto.
Qed.

Lemma take_max_N_0423:
forall N1 N2 N3 (P:nat->nat->Prop) (Q R:nat->Prop),
 (forall n1 n2, (n1>N1)%nat -> (n2>N1)%nat -> P n1 n2) -> (forall n ,(n>N2)%nat -> Q n) ->
 (forall n, (n>N3)%nat -> R n) ->
  exists N, (forall n1 n2,(n1>N)%nat -> (n2>N)%nat -> P n1 n2) /\ (forall n, (n>N)%nat-> Q n /\ R n).
Proof. intros. destruct (classic (lt N1 N2)), (classic (lt N2 N3)), (classic (lt N1 N3)).
- exists N3. split. intros. apply H. omega. omega.
  intros. split. apply H0. omega. apply H1. omega.
- omega.
- exists N2. split. intros. apply H. omega. omega.
  intros. split. apply H0. omega. apply H1. omega.
- exists N2. split. intros. apply H. omega. omega.
  intros. split. apply H0. omega. apply H1. omega.
- exists N3. split. intros. apply H. omega. omega.
  intros. split. apply H0. omega. apply H1. omega.
- exists N1. split. intros. apply H. omega. omega.
  intros. split. apply H0. omega. apply H1. omega.
- omega.
- exists N1. split. intros. apply H. omega. omega.
  intros. split. apply H0. omega. apply H1. omega.
Qed.

Lemma Rmult_nonzero (x y:Real): ~(x==0)%R->~(y==0)%R->~(x*y==0)%R.
Proof.
  intros. intros C. apply Rmult_integral in C. destruct C.
  - contradiction.
  - contradiction.
Qed.

Lemma Rinv_mult_distr : forall p q (Hp:~(p==0)%R)(Hq:~(q==0)%R),
 (/ (exist _ (p * q) (Rmult_nonzero _ _ Hp Hq)) == /(exist _ p Hp) * /(exist _ q Hq))%R.
Proof. intros. destruct p as [A HA]. destruct q as [B HB].
  hnf. unfold CauchySeqMult. intros. exists O.
  intros. destruct (Cauchy_exists _ HA m) as [qa Hqa].
  destruct (Cauchy_exists _ HB m) as [qb Hqb].
  assert (E1: /q1 == qa * qb). { apply H1. auto. auto. }
  assert (E2: / q2 == qa * qb).
  { rewrite <- (Qinv_involutive qa). rewrite <- (Qinv_involutive qb).
    rewrite <- Qinv_mult_distr.
    rewrite <- Qinv_involutive in Hqa.
    rewrite <- Qinv_involutive in Hqb.
    rewrite (H2 _ _ Hqa Hqb). reflexivity. }
  rewrite <- (Qinv_involutive q1), <- (Qinv_involutive q2).
  rewrite E1. rewrite E2.
  assert (Et: / (qa * qb) - / (qa * qb) == 0) by ring.
  rewrite Et. apply H.
Qed.

Theorem Rdiv_mult_l : forall x y (H:~(y == 0)%R), ((x * y)*/(exist _ y H) == x)%R.
Proof. intros. destruct x as [A HA], y as [B HB].
  hnf. intros. unfold CauchySeqMult.
  apply (limit_not_0_spec) in H. apply limit_not_0_seq in H.
  destruct H as [N HN].
  exists N.
  intros. destruct (Cauchy_exists _ HA m) as [qa Hqa].
  destruct (Cauchy_exists _ HB m) as [qb Hqb].
  assert (E: q1 == qa * qb * (/qb)). { apply H1.
  - intros. rewrite (Cauchy_unique _ HA _ _ _ Hqa H3).
    rewrite (Cauchy_unique _ HB _ _ _ Hqb H4).
    reflexivity.
  - intros. rewrite Qinv_involutive. apply Hqb. }
  rewrite E. rewrite <- Qmult_assoc. rewrite Qmult_inv_r.
  rewrite Qmult_1_r. rewrite (Cauchy_unique _ HA _ _ _ Hqa H2).
  assert (Et: q2 - q2 == 0) by ring. rewrite Et. apply H0.
  apply (HN m). auto. auto.
Qed.

Theorem Rmult_div_r : forall x y (H:~ (y == 0)%R) , (y*(x*/(exist _ y H)) == x)%R.
Proof. intros. rewrite Rmult_comm. rewrite Rmult_assoc.
  rewrite (Rmult_comm _ y). rewrite <- Rmult_assoc. apply Rdiv_mult_l.
Qed.

Lemma Rmult_inj_r_suff: forall x y z, (x == y)%R -> (x * z == y * z )%R.
Proof. intros. rewrite H. reflexivity.
Qed.

Lemma Rmult_inj_r (x y z: Real): (~ z == 0 -> (x * z == y * z <-> x == y))%R.
Proof. intros. split.
  - intros. apply (Rmult_inj_r_suff _ _ (/ (exist _ z H))) in H0.
    rewrite (Rdiv_mult_l x z) in H0. rewrite (Rdiv_mult_l y z) in H0. apply H0.
  - intros. apply Rmult_inj_r_suff. auto.
Qed.

Lemma Rmult_inj_l (x y z: Real): (~ z == 0 -> (z * x == z * y <-> x == y))%R.
Proof. intros. split.
  - intros. apply (Rmult_inj_r _ _ z). apply H. rewrite Rmult_comm. rewrite (Rmult_comm y z).
    apply H0.
  - intros. rewrite H0. reflexivity.
Qed.

Lemma Rinv_nonzero (x:Real)(H:~(x==0)%R): ~(Rinv (exist _ x H) == 0)%R.
Proof. destruct x as [A HA].
  apply limit_not_0_spec. hnf.
  assert (H1: limit_not_0_real (Real_intro A HA)). { apply limit_not_0_spec. auto. }
  destruct (CauchySeqBounded _ HA) as [M [HM H2]].
  apply limit_not_0_seq in H1. destruct H1 as [N HN].
  exists (/M). split.
  - apply Qinv_lt_0_compat. auto.
  - intros. destruct (classic (N0 < N)%nat).
    + exists (S N). split. omega. intros. apply (Qmult_lt_l _ _ _ HM).
      rewrite Qmult_inv_r. apply (Qmult_lt_r _ _ (/ (Qabs q))).
      rewrite <- Qabs_Qinv. apply Qnot_0_abs_pos. apply (HN (S N)). omega. auto.
      rewrite Qmult_1_l. rewrite <- Qmult_assoc. rewrite Qmult_inv_r.
      rewrite Qmult_1_r. rewrite <- Qabs_Qinv. apply (H2 (S N)). auto.
      apply Qnot_0_abs. intros C. assert (foo: ~ / q == 0). { apply (HN (S N)). auto. auto. }
      rewrite C in foo. apply foo. reflexivity. intros C. rewrite C in HM.
      apply Qlt_irrefl in HM. auto.
    + exists (S N0). split. omega. intros. apply (Qmult_lt_l _ _ _ HM).
      rewrite Qmult_inv_r. apply (Qmult_lt_r _ _ (/ (Qabs q))).
      rewrite <- Qabs_Qinv. apply Qnot_0_abs_pos. apply (HN (S N0)). omega. auto.
      rewrite Qmult_1_l. rewrite <- Qmult_assoc. rewrite Qmult_inv_r.
      rewrite Qmult_1_r. rewrite <- Qabs_Qinv. apply (H2 (S N0)). auto.
      apply Qnot_0_abs. intros C. assert (foo: ~ / q == 0). { apply (HN (S N0)). omega. auto. }
      rewrite C in foo. apply foo. reflexivity. intros C. rewrite C in HM.
      apply Qlt_irrefl in HM. auto.
Qed.
Lemma Rinv_involutive (x:Real)(H:~(x==0)%R):
 (/ (exist _ (Rinv (exist _ x H)) (Rinv_nonzero _ H)) == x)%R.
Proof. destruct x as [A HA]. hnf.
  intros. exists O. intros. rewrite <- (Cauchy_unique _ HA _ _ _ H2 H3).
  rewrite Qinv_involutive. assert(E:q1 - q1==0) by ring.
  rewrite E. apply H0.
Qed.

Lemma inject_Q_plus (x y: Q): (inject_Q (x + y) == inject_Q x + inject_Q y)%R.
Proof. hnf. intros. exists O.
  intros. unfold CauchySeqPlus in *. rewrite (H2 x y). rewrite H1.
  assert (E:x + y - (x + y) == 0) by ring. rewrite E. apply H. reflexivity. reflexivity.
Qed.

Lemma inject_Q_mult (x y: Q): (inject_Q (x * y) == inject_Q x * inject_Q y)%R.
Proof. hnf. intros. exists O.
  intros. unfold CauchySeqMult in *. rewrite (H2 x y). rewrite H1.
  assert (E:x * y - (x * y) == 0) by ring. rewrite E. apply H. reflexivity. reflexivity.
Qed.
Lemma inject_Q_opp (x: Q): (inject_Q (- x) == - inject_Q x)%R.
Proof. hnf. intros. exists O.
  intros. unfold Cauchy_opp in *. rewrite (H2 x). rewrite H1.
  assert (E:- x - - x == 0) by ring. rewrite E. apply H. reflexivity.
Qed.

Instance inject_Q_comp: Proper (Qeq ==>Real_equiv) inject_Q.
Proof. hnf. intros.
  hnf. intros.
  exists O.
  intros.
  rewrite H2,H3.
  rewrite H.
  assert (Et: y-y==0)by ring.
  rewrite Et.
  apply H0.
Qed.

Lemma inject_Q_nonzero: forall q, ~ q == 0 -> ~ (inject_Q q == 0)%R.
Proof. intros. intros C.
  hnf in C.
  pose proof (C (Qabs q) (Qnot_0_abs_pos q H)).
  destruct H0.
  assert (S x>x)%nat by omega.
  pose proof (H0 (S x) H1).
  assert (Qabs q > Qabs (q -0)).
  { apply H2. reflexivity. reflexivity. }
  assert (q-0==q) by ring. rewrite H4 in H3.
  apply Qlt_irrefl in H3.
  auto.
Qed.

Lemma inject_Q_inv: forall q (H:~q==0) , (inject_Q (/q) ==
    / exist (fun a0 : Real => ~ a0 == 0) (inject_Q q) (inject_Q_nonzero _ H))%R.
Proof. intros.
  hnf.
  intros.
  exists O.
  intros.
  rewrite H2.
  assert (Et: q2 == /q). { rewrite <- H3. rewrite Qinv_involutive. reflexivity. }
  rewrite Et.
  assert (Et':  (/ q - / q) == 0) by ring.
  rewrite Et'.
  apply H0.
Qed.

Theorem inject_Q_eq_inv: forall (q1 q2:Q), (inject_Q q1 == inject_Q q2)%R -> q1 == q2.
Proof. intros. hnf in H.
  destruct (classic (q1 == q2)). auto.
  assert (E:~(q1-q2==0)).
  { intros C. apply H0. rewrite <- (Qplus_0_r q2). rewrite <- C. ring. }
  apply Qnot_0_abs_pos in E. apply H in E.
  destruct E. assert (foo: Qabs (q1 - q2) < Qabs (q1 - q2)).
  { apply (H1 (S x)). omega. reflexivity. reflexivity. }
  apply Qlt_irrefl in foo. destruct foo.
Qed.

Definition Rsrt : (ring_theory 0 1 Rplus Rmult Rminus Ropp Real_equiv)%R.
Proof.
  constructor.
  - exact Rplus_0_l.
  - exact Rplus_comm.
  - intros. rewrite Rplus_assoc. reflexivity.
  - exact Rmult_1_l.
  - exact Rmult_comm.
  - intros. rewrite Rmult_assoc. reflexivity.
  - exact Rmult_plus_distr_l.
  - reflexivity.
  - exact Rplus_opp_r.
Qed.

Add Ring Rring :Rsrt.


(* (c) Copyright Microsoft Corporation and Inria. All rights reserved. *)
Require Import ssreflect ssrbool ssrfun eqtype ssrnat.
Require Import seq fintype div bigops prime ssralg poly.
Require Import finset groups morphisms automorphism normal perm zmodp.

(***********************************************************************)
(*  Properties of cyclic groups                                        *)
(***********************************************************************)
(* Definitions:                                                        *)
(* Defined in groups.v:                                                *)
(*   <[x]>         == the cycle (cyclic group) generated by x          *)
(*   #[x]          == the order of x, i.e., the cardinal of <[x]>.     *)
(* Defined in phi.v:                                                   *)
(*   phi n         == Euler's totient function                         *)
(* In this file:                                                       *)
(*   cyclic G      <=> G is a cyclic group.                            *)
(*   generator G x <=> x is a generator of the (cyclic) group G.       *)
(*   Zpm x         == the isomorphism between the additive group of    *)
(*                    integers mod #[x], and the group <[x]>           *)
(*   cyclem x n    == the endomorphism y |-> y ^+ n of <[x]>           *)
(*   Zp_unitm x    == the isomorphism from the multiplicative group of *)
(*                    the units of the ring of integers mod #[x], with *)
(*                    the group Aut <[x]> of automorphisms of <[x]>.   *)
(*                    (Zp_unitm x map u to cyclem x u)                 *)
(* Basic results for these notions, plus the classical result that     *)
(* any finite group isomorphic to a subggroup of a field is cycle,     *)
(* and the corollary that Aut G is cyclic when G is of prime order.    *)
(***********************************************************************)

Set Implicit Arguments.
Unset Strict Implicit.
Import Prenex Implicits.

Import GroupScope.

(***********************************************************************)
(*  Cyclic groups.                                                     *)
(***********************************************************************)

Section Cyclic.

Variable gT : finGroupType.
Implicit Types a x y : gT.
Implicit Types A B : {set gT}.
Implicit Types G H : {group gT}.

Definition cyclic A := existsb x, A == <[x]>.

Lemma cyclicP : forall A, reflect (exists x, A = <[x]>) (cyclic A).
Proof. move=> A; apply: (iffP existsP) => [] [x]; exists x; exact/eqP. Qed.

Lemma cycle_cyclic : forall x, cyclic <[x]>.
Proof. by move=> x; apply/cyclicP; exists x. Qed.

Lemma cyclic1 : cyclic [1 gT].
Proof. by rewrite -cycle1 cycle_cyclic. Qed.

(***********************************************************************)
(* Isomorphism with the additive group                                 *)
(***********************************************************************)

Section Zpm.

Variable a : gT.

Definition Zpm (i : 'I_#[a]) := a ^+ i.

Lemma ZpmM : {in Zp #[a] &, {morph Zpm : x y / x * y}}.
Proof. by move=> i j _ _; rewrite /Zpm /= expg_mod_order expgn_add. Qed.

Canonical Structure Zpm_morphism := Morphism ZpmM.

Lemma morphim_Zpm : Zpm @* Zp #[a] = <[a]>.
Proof.
apply/eqP; rewrite morphimEdom eq_sym eqEcard andbC.
rewrite -[#|<[a]>|]card_Zp leq_imset_card.
apply/subsetP=> x; case/cyclePmin=> i lt_i_a ->.
by apply/imsetP; exists (Ordinal lt_i_a); rewrite ?inE.
Qed.

Lemma Zpm_inj : injective Zpm.
Proof.
apply/injectiveP; apply/card_uniqP; rewrite size_map -cardE card_ord /=.
rewrite {5}/order -morphim_Zpm morphimEdom /=; apply: eq_card => x.
by apply/imageP/imsetP=> [] [i _ ->] /=; exists i; rewrite ?inE.
Qed.

Lemma injm_Zpm : 'injm Zpm.
Proof. apply/injmP; exact: (in2W Zpm_inj). Qed.

Lemma eq_expg_mod_order : forall m n,
  (a ^+ m == a ^+ n) = (m == n %[mod #[a]]).
Proof.
move=> m n; symmetry; pose Za := inZp (order_gt0 a).
by rewrite -[_ == _](inj_eq Zpm_inj (Za m) (Za n)) /Zpm !expg_mod_order.
Qed.

Lemma Zp_isom : isom (Zp #[a]) <[a]> Zpm.
Proof. by apply/isomP; rewrite injm_Zpm morphim_Zpm. Qed.

Lemma Zp_isog : isog (Zp #[a]) <[a]>.
Proof. exact: isom_isog Zp_isom. Qed.

Lemma cycle_decomp : forall b,
  b \in <[a]> -> {m : nat | m < #[a] & a ^+ m = b}.
Proof.
move=> b; rewrite -morphim_Zpm; move/(invmK injm_Zpm).
by case: {+}(invm _ b) => m; exists m.
Qed.

End Zpm.

(***********************************************************************)
(*        Central and direct product of cycles                         *)
(***********************************************************************)

Lemma cents_cycle : forall a b, commute a b -> <[a]> \subset 'C(<[b]>).
Proof.
move=> a b cab; rewrite gen_subG centsC cent_set1 cycle_subG; exact/cent1P.
Qed.

Lemma cycle_abelian : forall a, abelian <[a]>.
Proof. move=> a; exact: cents_cycle. Qed.

Lemma cyclic_abelian : forall A, cyclic A -> abelian A.
Proof. move=> A; case/cyclicP=> a ->; exact: cycle_abelian. Qed.

Lemma cycleMsub : forall a b,
  commute a b -> coprime #[a] #[b] -> <[a]> \subset <[a * b]>.
Proof.
move=> a b cab co_ab; apply/subsetP=> x; case/cycleP=> k ->{x}.
apply/cycleP; exists (chinese #[a] #[b] k 0); symmetry.
rewrite expMgn // -expg_mod_order chinese_modl // expg_mod_order.
by rewrite /chinese addn0 -mulnA mulnCA expgn_mul expg_order exp1gn mulg1.
Qed.

Lemma cycleM : forall a b,
  commute a b -> coprime #[a] #[b] -> <[a * b]> = <[a]> * <[b]>.
Proof.
move=> a b cab co_ab; apply/eqP.
rewrite eqEsubset -(cent_mulgenEl (cents_cycle cab)).
rewrite mulgen_subG {3}cab !cycleMsub // 1?coprime_sym //.
by rewrite -genM_mulgen cycle_subG mem_gen // mem_imset2 ?cycle_id.
Qed.

(***********************************************************************)
(*        Order properties                                             *)
(***********************************************************************)

Lemma order_dvdn : forall a n, (#[a] %| n) = (a ^+ n == 1).
Proof. by move=> a n; rewrite (eq_expg_mod_order a n 0) mod0n. Qed.

Lemma order_inf : forall a n, a ^+ n.+1 == 1 -> #[a] <= n.+1.
Proof. move=> a n; rewrite -order_dvdn; exact: dvdn_leq. Qed.

Lemma order_eq1 : forall a, (#[a] == 1%N) = (a == 1).
Proof. by move=> a; rewrite -dvdn1 order_dvdn expg1. Qed.

Lemma cycle_eq1 : forall a, (<[a]> == 1) = (a == 1).
Proof. by move=> a; rewrite -order_eq1 trivg_card1. Qed.

Lemma order_dvdG : forall (G : {group gT}) a, a \in G -> #[a] %| #|G|.
Proof. by move=> G a Ga; apply: cardSg; rewrite cycle_subG. Qed.

Lemma orderXdvd : forall a n, #[a ^+ n] %| #[a].
Proof. move=> a n; apply: order_dvdG; exact: mem_cycle. Qed.

Lemma orderXgcd : forall a n, #[a ^+ n] = #[a] %/ gcdn #[a] n.
Proof.
move=> a n; apply/eqP; rewrite eqn_dvd; apply/andP; split.
  rewrite order_dvdn -expgn_mul -gcdn_divnC //.
  by rewrite expgn_mul expg_order exp1gn.
case: (posnP n) => [-> | n_gt0]; first by rewrite gcdn0 divnn order_gt0 dvd1n.
rewrite -(dvdn_pmul2r n_gt0) divn_mulAC ?dvdn_gcdl // dvdn_lcm.
by rewrite order_dvdn mulnC expgn_mul expg_order eqxx dvdn_mulr.
Qed.

Lemma orderXdiv : forall a n, n %| #[a] -> #[a ^+ n] = #[a] %/ n.
Proof.
by move=> a n; case/dvdnP=> q defq; rewrite orderXgcd {2}defq gcdnC gcdn_mull.
Qed.

Lemma orderM : forall a b : gT,
  commute a b -> coprime #[a] #[b] -> #[a * b] = (#[a] * #[b])%N.
Proof. by move=> a b Hcom Hcop; rewrite -coprime_cardMg -?cycleM. Qed.

(***********************************************************************)
(*        Generator                                                    *)
(***********************************************************************)

Definition generator (A : {set gT}) a := A == <[a]>.

Lemma generator_cycle : forall a, generator <[a]> a.
Proof. by move=> a; exact: eqxx. Qed.

Lemma cycle_generator : forall a x, generator <[a]> x -> x \in <[a]>.
Proof. move=> a x; move/(<[a]> =P _)->; exact: cycle_id. Qed.

Lemma generator_order : forall a b,
  generator <[a]> b -> #[a] = #[b].
Proof. by rewrite /order => a b; move/(<[a]> =P _)->. Qed.

End Cyclic.

(* Euler's theorem *)

Theorem Euler: forall a n, coprime a n -> a ^ phi n  = 1 %[mod n].
Proof.
move=> a n; case: (posnP n) => [-> //|n_gt0] co_a_n; pose n0 := PosNat n_gt0.
have Ua: coprime n0 (inZp n_gt0 a) by rewrite coprime_sym coprime_modl.
have: ZpUnit Ua ^+ phi n0 == 1.
  by rewrite -card_Zp_units -order_dvdn order_dvdG ?inE.
by rewrite -2!val_eqE /= (@Zp_units_expgn n0) /= modn_exp; move/eqP.
Qed.

Section CyclicSubGroup.

Variable gT : finGroupType.

(*  G. 1.3.1 (i) *)

Lemma cycle_sub_group : forall (a : gT) m, m %| #[a] ->
  [set H : {group gT} | (H \subset <[a]>) && (#|H| == m)]
     = [set <[a ^+ (#[a] %/ m)]>%G].
Proof.
move=> a m Hdiv.
have Hpos: 0 < m by apply (dvdn_gt0 (order_gt0 a) Hdiv).
have Hcardm: #|<[a ^+ (#[a] %/ m)]>| == m.
  rewrite [#|_|]orderXgcd -(divn_pmul2r Hpos) muln_gcdl divnK // gcdnC.
  by rewrite gcdn_mulr mulKn.
apply/eqP; rewrite eqEsubset sub1set inE /= cycleX Hcardm !andbT.
apply/subsetP=> X; rewrite in_set1 inE -val_eqE /= eqEcard (eqP Hcardm).
case/andP=> sXa; move/eqP=> oX; rewrite oX leqnn andbT.
apply/subsetP=> x Xx; case/cycleP: (subsetP sXa _ Xx) => k def_x.
have: (x ^+ m == 1)%g by rewrite -oX -order_dvdn cardSg // gen_subG sub1set.
rewrite def_x -expgn_mul -order_dvdn -[#[a]](LaGrange sXa) -oX mulnC.
rewrite dvdn_pmul2r // mulnK //; case/dvdnP=> i ->{def_x k}.
by rewrite mulnC expgn_mul groupX // cycle_id.
Qed.

Lemma cycle_subgroup_char : forall a (H : {group gT}),
  H \subset <[a]> -> H \char <[a]>.
Proof.
move=> a H sHa; apply: lone_subgroup_char => // J sJa isoJH.
have dvHa: #|H| %| #[a] by exact: cardSg.
have{dvHa} Huniq := esym (cycle_sub_group dvHa).
move/setP: Huniq => Huniq; move: (Huniq H) (Huniq J); rewrite !inE /=.
by rewrite sHa sJa (isog_card isoJH) eqxx; do 2!move/eqP <-.
Qed.

End CyclicSubGroup.

(***********************************************************************)
(*  Reflected boolean property and morphic image, injection, bijection *)
(***********************************************************************)

Section MorphicImage.

Variables aT rT : finGroupType.
Variables (D : {group aT}) (f : {morphism D >-> rT}) (x : aT).
Hypothesis Dx : x \in D.

Lemma morphim_cycle : f @* <[x]> = <[f x]>.
Proof. by rewrite morphim_gen (sub1set, morphim_set1). Qed.

Lemma morph_order : #[f x] %| #[x].
Proof. by rewrite order_dvdn -morphX // expg_order morph1. Qed.

Lemma morph_generator : forall A, generator A x -> generator (f @* A) (f x).
Proof. by move=> A; move/(A =P _)->; rewrite /generator morphim_cycle. Qed.

End MorphicImage.

Section CyclicProps.

Variables gT : finGroupType.
Implicit Types G H K : {group gT}.
Implicit Types aT rT : finGroupType.

Lemma cyclicS : forall G H, H \subset G -> cyclic G -> cyclic H.
Proof.
move=> G H HsubG; case/cyclicP=> x gex; apply/cyclicP.
exists (x ^+ (#[x] %/ #|H|)); apply: congr_group; apply/set1P.
by rewrite -cycle_sub_group /order -gex ?cardSg // inE HsubG eqxx.
Qed.

Lemma cyclicJ:  forall G x, cyclic (G :^ x) = cyclic G.
Proof.
move=> G x; apply/cyclicP/cyclicP=> [[y] | [y ->]].
  by move/(canRL (conjsgK x)); rewrite -cycleJ; exists (y ^ x^-1).
by exists (y ^ x); rewrite cycleJ.
Qed.

Lemma morphim_cyclic :  forall rT G H (f : {morphism G >-> rT}),
  cyclic H -> cyclic (f @* H).
Proof.
move=> rT G H f cH; wlog sHG: H cH / H \subset G.
  by rewrite -morphimIdom; apply; rewrite (cyclicS _ cH, subsetIl) ?subsetIr.
case/cyclicP: cH sHG => x ->; rewrite gen_subG sub1set => Gx.
by apply/cyclicP; exists (f x); rewrite morphim_cycle.
Qed.

Lemma quotient_cycle : forall x H, x \in 'N(H) -> <[x]> / H = <[coset H x]>.
Proof. move=> x H; exact: morphim_cycle. Qed.

Lemma quotient_cyclic : forall G H, cyclic G -> cyclic (G / H).
Proof. move=> G H; exact: morphim_cyclic. Qed.

Lemma quotient_generator : forall x G H,
  x \in 'N(H) -> generator G x -> generator (G / H) (coset H x).
Proof. by move=> x G H Nx; apply: morph_generator. Qed.

Lemma prime_cyclic : forall G, prime #|G| -> cyclic G.
Proof.
move=> G pG; case: (pickP (mem G^#)) => [x Hx| Hx]; last first.
  by move: pG; rewrite (cardsD1 1 G) group1 (eq_card0 Hx).
move: (Hx); rewrite /= in_setD1; case/andP => xD1; rewrite -cycle_subG=> xIG.
case/primeP: pG => _; move/(_ _ (cardSg xIG)); case/orP;  move/eqP.
  by rewrite (cardsD1 1) (cardsD1 x) group1 in_setD1 xD1 cycle_id.
move=> CxG; apply/cyclicP; exists x.
by apply/eqP; rewrite eq_sym eqEcard // CxG leqnn andbT.
Qed.

Lemma cyclic_small : forall G, #|G| <= 3 -> cyclic G.
Proof.
move=> G; rewrite 4!(ltnS, leq_eqVlt) -trivg_card_le1 orbA orbC.
case/predU1P=> [->|oG]; first exact: cyclic1.
by apply: prime_cyclic; case/pred2P: oG => ->.
Qed.

End CyclicProps.

Section IsoCyclic.

Variables gT rT : finGroupType.
Implicit Types G H : {group gT}.
Implicit Types M : {group rT}.

Lemma injm_cyclic :  forall G H (f : {morphism G >-> rT}),
  'injm f -> H \subset G -> cyclic (f @* H) = cyclic H.
Proof.
move=> G H f injf sHG; apply/idP/idP; last exact: morphim_cyclic.
rewrite -{2}(morphim_invm injf sHG); exact: morphim_cyclic.
Qed.

Lemma isog_cyclic :forall G M, G \isog M -> cyclic G = cyclic M.
Proof. by move=> G M; case/isogP=> f injf <-; rewrite injm_cyclic. Qed.

Lemma isog_cyclic_card : forall G M,
  cyclic G -> isog G M = cyclic M && (#|M| == #|G|).
Proof.
move=> G H cycG; apply/idP/idP=> [isoGM | ].
  by rewrite (isog_card isoGM) -(isog_cyclic isoGM) cycG /=.
case/cyclicP: cycG => x ->{G}; case/andP; case/cyclicP=> y ->{M} oy.
apply: isog_trans (isog_symr _) (Zp_isog y).
by rewrite ((order_pos_nat y =P order_pos_nat x) _) // Zp_isog.
Qed.

Lemma injm_generator : forall G H (f : {morphism G >-> rT}) x,
    'injm f -> x \in G -> H \subset G ->
  generator (f @* H) (f x) = generator H x.
Proof.
move=> G H f x injf Gx sHG; apply/idP/idP; last exact: morph_generator.
rewrite -{2}(morphim_invm injf sHG) -{2}(invmE injf Gx).
apply: morph_generator; exact: mem_morphim.
Qed.

End IsoCyclic.

(***********************************************************************)
(*       Automorphisms of cyclic groups                                *)
(***********************************************************************)

Section CyclicAutomorphism.

Variable gT : finGroupType.

Section CycleAutomorphism.

Variable a : gT.

Section CycleMorphism.

Variable n : nat.

Definition cyclem of gT := fun x : gT => x ^+ n.

Lemma cyclemM : {in <[a]> & , {morph cyclem a : x y / x * y}}.
Proof.
move=> x y ax ay; apply: expMgn; exact: (centsP (cycle_abelian a)).
Qed.

Canonical Structure cyclem_morphism := Morphism cyclemM.

End CycleMorphism.

Section ZpUnitMorphism.

Variable u : Zp_unit #[a].

Lemma injm_cyclem : 'injm (cyclem u a).
Proof.
apply/subsetP=> x; case/setIdP=> ax; rewrite !inE -order_dvdn.
rewrite -order_eq1 -dvdn1; move/eqnP: (valP u) => /= <-.
by rewrite dvdn_gcd order_dvdG.
Qed.

Lemma cyclem_dom : cyclem u a @* <[a]> = <[a]>.
Proof.
apply/morphim_fixP=> //; first exact: injm_cyclem.
by rewrite morphim_cycle ?cycle_id ?cycleX.
Qed.

Definition Zp_unitm := aut injm_cyclem cyclem_dom.

End ZpUnitMorphism.

Lemma Zp_unitmM : {in Zp_units #[a] &, {morph Zp_unitm : u v / u * v}}.
Proof.
move=> u v _ _; apply: (eq_Aut (Aut_aut _ _)) => [|x a_x].
  by rewrite groupM ?Aut_aut.
rewrite permM !autE ?groupX //= /cyclem -expgn_mul.
by rewrite -expg_mod_order modn_dvdm ?expg_mod_order // order_dvdG.
Qed.

Canonical Structure Zp_unit_morphism := Morphism Zp_unitmM.

Lemma injm_Zp_unitm : 'injm Zp_unitm.
Proof.
apply/subsetP=> u; case/morphpreP=> _; move/set1P=> /= um1.
have{um1}: Zp_unitm u a == Zp_unitm 1 a by rewrite um1 morph1.
by rewrite !autE ?cycle_id // eq_expg_mod_order !modZp inE.
Qed.

Lemma generator_coprime : forall m, generator <[a]> (a ^+ m) = coprime #[a] m.
Proof.
move=> m; rewrite /generator eq_sym eqEcard cycleX -/#[a] [#|_|]orderXgcd /=.
apply/idP/idP=> [le_a_am|co_am]; last by rewrite (eqnP co_am) divn1.
have am_gt0: 0 < gcdn #[a] m by rewrite gcdn_gt0 order_gt0.
by rewrite /coprime eqn_leq am_gt0 andbT -(@leq_pmul2l #[a]) ?muln1 -?leq_divr.
Qed.

Lemma morphim_Zp_unitm : Zp_unitm @* Zp_units #[a] = Aut <[a]>.
Proof.
rewrite morphimEdom; apply/setP=> f; apply/imsetP/idP=> [[u _ ->] | Af].
  exact: Aut_aut.
pose n := invm (injm_Zpm a) (f a).
have a_fa: <[a]> = <[f a]>.
  by rewrite -(autmE Af) -morphim_cycle ?autm_dom ?cycle_id.
have def_n: a ^+ n = f a.
  by rewrite -/(Zpm n) invmK // morphim_Zpm a_fa cycle_id.
have co_a_n : coprime #[a] n by rewrite -generator_coprime def_n; exact/eqP.
exists (ZpUnit co_a_n); rewrite ?inE //.
apply: eq_Aut (Af) (Aut_aut _ _) _ => x ax.
rewrite autE //= /cyclem; case/cycleP: ax => k ->{x}.
by rewrite -(autmE Af) morphX ?cycle_id //= autmE -def_n -!expgn_mul mulnC.
Qed.

Lemma Zp_unit_isom : isom (Zp_units #[a]) (Aut <[a]>) Zp_unitm.
Proof. by apply/isomP; rewrite ?injm_Zp_unitm ?morphim_Zp_unitm. Qed.

Lemma Zp_unit_isog : isog (Zp_units #[a]) (Aut <[a]>).
Proof. exact: isom_isog Zp_unit_isom. Qed.

Lemma card_Aut_cycle : #|Aut <[a]>| = phi #[a].
Proof. by rewrite -(isog_card Zp_unit_isog) card_Zp_units. Qed.

Lemma phi_gen : phi #[a] = #|[set x | generator <[a]> x]|.
Proof.
rewrite -(card_injm (injm_invm (injm_Zpm a))) /= ?morphim_Zpm.
  rewrite -card_Zp_units cardsE card_sub morphim_invmE.
  by apply: eq_card => d; rewrite !inE /= -generator_coprime.
apply/subsetP=> x; rewrite inE; exact: cycle_generator.
Qed.

Lemma Aut_cycle_abelian : abelian (Aut <[a]>).
Proof. by rewrite -morphim_Zp_unitm morphim_abelian ?Zp_units_abelian. Qed.

End CycleAutomorphism.

Variable G : {group gT}.

Lemma Aut_cyclic_abelian : cyclic G -> abelian (Aut G).
Proof. case/cyclicP=> x ->; exact: Aut_cycle_abelian. Qed.

Lemma card_Aut_cyclic : cyclic G -> #|Aut G| = phi #|G|.
Proof. case/cyclicP=> x ->; exact: card_Aut_cycle. Qed.

Lemma sum_ncycle_phi :
  \sum_(d < #|G|.+1) #|[set <[x]> | x <- G, #[x] == d]| * phi d = #|G|.
Proof.
pose h (x : gT) : 'I_#|G|.+1 := inord #[x].
symmetry; rewrite -{1}sum1_card (partition_big h xpredT) //=.
apply: eq_bigr => d _; set Gd := finset _.
rewrite -sum_nat_const sum1dep_card -sum1_card (_ : finset _ = Gd); last first.
  apply/setP=> x; rewrite !inE; case Gx: (x \in G) => //.
  by rewrite /eq_op /= inordK // ltnS subset_leq_card ?cycle_subG.
rewrite (partition_big_imset cycle) {}/Gd; apply: eq_bigr => C /=.
case/imsetP=> x; case/setIdP=> Gx; move/eqP=> <- -> {C d}.
rewrite sum1dep_card phi_gen; apply: eq_card => y; rewrite !inE /generator.
move: Gx; rewrite andbC eq_sym -!cycle_subG /order.
by case: (<[x]> == <[y]>) / (<[x]> =P <[y]>) => // -> ->; exact: eqxx.
Qed.

End CyclicAutomorphism.

Lemma sum_phi_dvd : forall n, \sum_(d < n.+1 | d %| n) phi d = n.
Proof.
move=> n; rewrite big_mkcond /=.
case: (posnP n) => [-> | n_gt0]; first by rewrite big_ord_recl big_ord0.
pose n0 := PosNat n_gt0; pose x1 : 'I_n0 := Zp_gen.
have ox1 : #[x1] = n by rewrite /order -Zp_cycle card_Zp.
rewrite -{8}ox1 -[#[_]]sum_ncycle_phi [#|_|]ox1; apply: eq_bigr => d _.
rewrite -{2}ox1; case: ifP => [|ndv_dG]; last first.
  rewrite eq_card0 // => C; apply/imsetP=> [[x]]; case/setIdP=> Gx oxd _{C}.
  by rewrite -(eqP oxd) order_dvdG in ndv_dG.
move/cycle_sub_group; set Gd := [set _] => def_Gd.
rewrite (_ : _ @: _ = @gval _ @: Gd); first by rewrite imset_set1 cards1 mul1n.
apply/setP=> C; apply/idP/imsetP=> [| [gC GdC ->{C}]].
  case/imsetP=> x; case/setIdP=> _ oxd ->; exists <[x]>%G => //.
  by rewrite -def_Gd inE -Zp_cycle subsetT.
have:= GdC; rewrite -def_Gd; case/setIdP=> _; move/eqP=> <-.
by rewrite (set1P GdC) /= mem_imset // inE eqxx (mem_cycle x1).
Qed.

Section FieldMulCyclic.

(***********************************************************************)
(* A classic application to finite multiplicative subgroups of fields. *)
(***********************************************************************)

Import GRing.Theory.

Variables (gT : finGroupType) (G : {group gT}).

Lemma order_inj_cyclic :
  {in G &, forall x y, #[x] = #[y] -> <[x]> = <[y]>} -> cyclic G.
Proof.
move=> ucG; apply: negbNE (contra _ (negbT (ltnn #|G|))) => ncG.
rewrite -{2}[#|G|]sum_phi_dvd big_mkcond (bigD1 ord_max) ?dvdnn //=.
rewrite -{1}[#|G|]sum_ncycle_phi (bigD1 ord_max) //= -addSn leq_add //.
  rewrite eq_card0 ?phi_gt0 ?cardG_gt0 // => C.
  apply/imsetP=> [[x]]; case/setIdP=> Gx; move/eqP=> oxG; case/cyclicP: ncG.
  by exists x; apply/eqP; rewrite eq_sym eqEcard cycle_subG Gx -oxG /=.
apply: (big_rel (fun a b => a <= b)) => // [*|d _]; first exact: leq_add.
set Gd := _ @: _; case: (set_0Vmem Gd) => [-> | [C]]; first by rewrite cards0.
rewrite {}/Gd; case/imsetP=> x; case/setIdP=> Gx; move/eqP=> <- _ {C d}.
rewrite order_dvdG // (@eq_card1 _ <[x]>) ?mul1n // => C.
apply/idP/eqP=> [|-> {C}]; last by rewrite mem_imset // inE Gx eqxx.
by case/imsetP=> y; case/setIdP=> Gy; move/eqP; move/ucG->.
Qed.

Lemma div_ring_mul_group_cyclic : forall (R : unitRingType) (f : gT -> R),
    f 1 = 1%R -> {in G &, {morph f : u v / u * v >-> (u * v)%R}} ->
    {in G^#, forall x, GRing.unit (f x - 1)%R} ->
  abelian G -> cyclic G.
Proof.
move=> R f f1 fM f1P abelG.
have fX: forall n, {in G, {morph f : u / u ^+ n >-> (u ^+ n)%R}}.
  by case=> // n x Gx; elim: n => //= n IHn; rewrite expgS fM ?groupX ?IHn.
have fU: forall x, x \in G -> GRing.unit (f x).
  move=> x Gx; apply/unitrP.
  by exists (f x^-1); rewrite -!fM ?groupV ?gsimp.
apply: order_inj_cyclic => x y Gx Gy; set n := #[x] => yn.
apply/eqP; rewrite eq_sym eqEcard -[#|_|]/n yn leqnn andbT cycle_subG /=.
suff{y Gy yn} ->: <[x]> = G :&: [set z | #[z] %| n] by rewrite !inE Gy yn /=.
apply/eqP; rewrite eqEcard subsetI cycle_subG {}Gx /= cardE; set rs := enum _.
apply/andP; split; first by apply/subsetP=> y xy; rewrite inE order_dvdG.
pose P : {poly R} := ('X^n - 1)%R; have n_gt0: n > 0 by exact: order_gt0.
have szP: size P = n.+1 by rewrite size_addl size_polyXn ?size_opp ?size_poly1.
rewrite -ltnS -szP -(size_map f) max_ring_poly_roots -?size_poly_eq0 ?{}szP //.
  apply/allP=> fy; case/mapP=> y; rewrite mem_enum !inE order_dvdn.
  case/andP=> Gy; move/eqP=> yn1 ->{fy}; apply/eqP.
  by rewrite !(horner_lin, hornerXn) -fX // yn1 f1 subrr.
have: uniq rs by exact: enum_uniq.
have: all (mem G) rs by apply/allP=> y; rewrite mem_enum; case/setIP.
elim: rs => //= y rs IHrs; case/andP=> Gy Grs; case/andP=> y_rs; rewrite andbC.
move/IHrs=> -> {IHrs}//; apply/allP=> fz; case/mapP=> z rs_z ->{fz}.
have{Grs} Gz := allP Grs z rs_z; rewrite /diff_root -!fM // (centsP abelG) //.
rewrite eqxx -[f y]mul1r -(mulgKV y z) fM ?groupM ?groupV //=.
rewrite -mulNr -mulr_addl unitr_mull ?fU ?f1P // !inE.
by rewrite groupM ?groupV // andbT -eq_mulgV1; apply: contra y_rs; move/eqP <-.
Qed.

Lemma field_mul_group_cyclic : forall (F : fieldType) (f : gT -> F),
    {in G &, {morph f : u v / u * v >-> (u * v)%R}} ->
    {in G, forall x, f x = 1%R <-> x = 1} ->
  cyclic G.
Proof.
move=> F f fM f1P; have f1 : f 1 = 1%R by exact/f1P.
apply: (div_ring_mul_group_cyclic f1 fM) => [x|].
  case/setD1P=> x1 Gx; rewrite unitfE; apply: contra x1.
  by rewrite subr_eq0; move/eqP; move/f1P->.
apply/centsP=> x Gx y Gy; apply/commgP; apply/eqP.
apply/f1P; rewrite ?fM ?groupM ?groupV //.
by rewrite mulrCA -!fM ?groupM ?groupV // mulKg mulVg.
Qed.

End FieldMulCyclic.

(***********************************************************************)
(*  Cycles of prime order                                              *)
(***********************************************************************)

Section AutPrime.

Variable gT : finGroupType.

Lemma Aut_prime_cycle_cyclic : forall a : gT, prime #[a] -> cyclic (Aut <[a]>).
Proof.
move=> a pr_a; pose ff f := invm (injm_Zp_unitm a) f : Fp_field pr_a.
apply: (@field_mul_group_cyclic _ _ _ ff) => [f g Af Ag | f Af].
  by apply: val_inj; rewrite /ff morphM ?morphim_Zp_unitm.
split=> [/= ff1 |->]; last by apply: val_inj; rewrite /ff morph1.
apply: (injm1 (injm_invm (injm_Zp_unitm a))).
  by rewrite /= morphim_Zp_unitm.
by do 2!apply: val_inj; move/(congr1 val): ff1.
Qed.

Lemma Aut_prime_cyclic : forall G : {group gT}, prime #|G| -> cyclic (Aut G).
Proof.
move=> G pr_G; case/cyclicP: (prime_cyclic pr_G) (pr_G) => x ->.
exact: Aut_prime_cycle_cyclic.
Qed.

End AutPrime.


Require Import Lia.

Require Import ssreflect ssrbool ssrfun.

Set Default Goal Selector "!".

(* induction/recursion principle wrt. a decreasing measure f *)
(* example: elim /(measure_rect length) : l. *)
Lemma measure_rect {X : Type} (f : X -> nat) (P : X -> Type) :
  (forall x, (forall y, f y < f x -> P y) -> P x) -> forall (x : X), P x.
Proof.
  exact: (well_founded_induction_type (Wf_nat.well_founded_lt_compat X f _ (fun _ _ => id)) P).
Qed.

(* duplicates argument *)
Lemma copy {A : Prop} : A -> A * A.
Proof. done. Qed.

Lemma unnest (X Y Z: Type): X -> (Y -> Z) -> (X -> Y) -> Z.
Proof. by auto. Qed.