(* $Id: FTAreg.v,v 1.46 2000/11/10 11:27:32 freek Exp $ *)

Require Export KneserLemma.
Require Export CPoly_Shift.
Require Export CPoly_Contin1.

Section Seq_Exists.
Variable n:nat.
Hypothesis lt0n: (lt (0) n).

Section Kneser_Sequence.
Variable qK : IR.
Variable zltq : (Zero [:<] qK).
Variable qlt1 : (qK [:<] One).
Variable q_prop :
   (p:(cpoly CC))(Monic n p) ->
		(c:IR)((AbsCC (p!Zero)) [:<] c) ->
        { z : CC |
          ((AbsCC z)[^]n [:<] c) /\
          ((AbsCC (p!z)) [:<] qK[*]c)}.

Variable p:(cpoly CC).
Hypothesis mp: (Monic n p).

Variable c0 : IR.
Hypothesis p0ltc0 : (AbsCC (p!Zero))[:<] c0.


Record Knes_tup : Set :=
  {z_el      :>  CC;
   c_el      :  IR;
   Kt_prop   :  (AbsCC (p!z_el)) [:<] c_el
  }.

Record Knes_tupp [tup:Knes_tup] : Set :=
  {Kntup     :>  Knes_tup;
   Ktp_prop  :  (c_el Kntup) [=] (qK[*](c_el tup));
   Ktpp_prop :  (AbsCC (Kntup)[-]tup)[^]n [:<] (c_el tup)
  }.


Definition Knes_fun : (tup:Knes_tup)(Knes_tupp tup).
Intro tup.
Elim tup.
Intros z c pzltc.
Cut ((AbsCC (poly_shift z p)!(Zero)) [:<] c).
Intro Hsh.
Generalize (q_prop (Shift z p) (poly_shift_monic z p n mp) c Hsh).
Intro Hex.
Elim Hex.
Intros z' Hz'.
Decompose [and] Hz'.
Cut ((AbsCC(p!(z'[+]z)))[:<] (qK[*]c)).
Intro HH.
Apply (Build_Knes_tupp (Build_Knes_tup z c pzltc)
	(Build_Knes_tup (z'[+]z) (qK[*]c) HH)).
Simpl; Algebra.
Simpl; Apply less_wdl with (AbsCC z')[^]n.
Assumption.
Apply (nexp_wd IR (AbsCC z') (AbsCC (z'[+] z)[-]z) n).
Apply AbsCC_wd.
Rational.
Apply less_wdl with (AbsCC (poly_shift z p)!z').
Exact H1.
Apply AbsCC_wd.
Apply poly_shift_apply.
Apply less_wdl with (AbsCC p!z).
Assumption.
Generalize (poly_shift_apply z p Zero).
Intro H3.
Apply eq_symmetric_unfolded.
Apply AbsCC_wd.
Apply eq_transitive_unfolded with p!(Zero[+]z).
Assumption.
Algebra.
Defined.

Fixpoint Knes_fun_it[i:nat]: Knes_tup :=
	Cases i of
	O	=> (Build_Knes_tup Zero c0 p0ltc0)
	| (S j) => (Knes_fun (Knes_fun_it j))
	end.	

Definition sK:= Knes_fun_it :: (nat -> CC).

Lemma sK_c : (tup: Knes_tup)
	(c_el (Knes_fun tup))[=](qK[*](c_el tup)).
Proof.
Intro tup.
Generalize (Ktp_prop tup (Knes_fun tup)).
Auto.
Qed.

Lemma sK_c0 : (i:nat)
	(c_el (Knes_fun_it i)) [=] qK[^]i[*]c0.
Proof.
Induction i.
Simpl.
Rational.
Intros.
Simpl.
Generalize (sK_c (Knes_fun_it n0)).
Intro H1.
Apply eq_transitive_unfolded with qK[*](c_el (Knes_fun_it n0)).
Assumption.
Step_Rat_rht qK[*]((nexp (IR) qK n0)[*]c0).
Apply mult_wd_rht.
Exact H.
Qed.

Lemma sK_prop1 : (i:nat)
	((AbsCC (p!(sK i))) [:<] (qK[^]i [*]c0)).
Unfold sK.
Induction i.
Simpl.
Step_Rat_less_rht c0.
Exact p0ltc0.
Intros.
Simpl.
Generalize (Kt_prop (Knes_fun (Knes_fun_it n0))).
Intro H2.
Apply less_wdr with (c_el (Knes_fun (Knes_fun_it n0))).
Assumption.
Generalize (sK_c (Knes_fun_it n0)).
Intro H3.
EApply eq_transitive_unfolded.
Apply H3.
Generalize (sK_c0 n0).
Intro H4.
Step_Rat_rht (qK[*]((nexp (IR) qK n0)[*]c0)).
Apply mult_wd_rht.
Exact H4.
Qed.

Lemma sK_it: (tup: Knes_tup)
	(AbsCC((Knes_fun tup)[-]tup))[^]n [:<] (c_el tup).
Proof.
Intro tup.
Generalize (Ktpp_prop tup (Knes_fun tup)).
Auto.
Qed.

Lemma sK_prop2 : (i:nat)
	(AbsCC((sK (S i))[-](sK i)))[^]n [:<] (qK[^]i [*]c0).
Proof.
Unfold sK.
Simpl.
Intro i.
Generalize (sK_it (Knes_fun_it i)).
Intro H0.
EApply less_wdr.
Apply H0.
Exact (sK_c0 i).
Qed.

Lemma z_ex_inf :
	((p:(cpoly (CC)))
        (monic (CC) n p)
        ->(c:(IR))
           ((AbsCC p!(Zero)) [:<] c)
           ->(EX z:(CC) |
                ((AbsCC z)[^]n [:<] c)/\((AbsCC p!z) [:<] qK[*]c)))
	->
	((p:(cpoly (CC)))
        (monic (CC) n p)
        ->(c:(IR))
           ((AbsCC p!(Zero)) [:<] c)
           ->{ z:(CC) |
                ((AbsCC z)[^]n [:<] c)/\((AbsCC p!z) [:<] qK[*]c)}).
Proof.
Intro H.
Intros p0 H0 c H1.
Apply (ex_informative CC [z:CC](((AbsCC z)[^]n [:<] c) /\
          ((AbsCC (p0!z)) [:<] qK[*]c)) (H p0 H0 c H1)).
Qed.

End Kneser_Sequence.

Lemma seq_exists :   (EX q | (Zero [:<] q) /\ (q [:<] One) /\
    (p:(cpoly CC))(Monic n p) ->
      (c:IR)((AbsCC (p!Zero)) [:<] c) ->
	(EX s : nat -> CC | (i:nat)((AbsCC (p!(s i))) [:<] (q[^]i [*]c)) /\
			((AbsCC((s (S i))[-](s i)))[^]n [:<] (q[^]i [*]c)))).

Proof.
Elim (Kneser n lt0n).
Intros q Hq.
Decompose [and] Hq.
Exists q.
Split;Try Assumption.
Split;Try Assumption.
Intros p mp c pzltc.
Generalize (z_ex_inf q H2).
Intro HH.
Exists (sK q HH p mp c pzltc).
Split.
Exact (sK_prop1 q HH p mp c pzltc i).
Exact (sK_prop2 q HH p mp c pzltc i).
Qed.

End Seq_Exists.


Section N_Exists.

Variable n:nat.
Hypothesis lt0n : (lt (0) n).
Variable q:IR.
Hypothesis zltq : (Zero [:<] q).
Hypothesis qlt1 : (q [:<] One).
Variable c:IR.
Hypothesis zltc : (Zero [:<] c).
Local qmonz := (qltone IR q qlt1) : (q[-]One [#] Zero).
Variable e:IR.
Variable zlte : (Zero [:<] e).


Lemma N_exists :
	(EX N | (m:nat)(le N m)->
		( ((q[^]m [-] q[^]N)[/](q[-]One)[//]qmonz)[*]c) [:<]e).
Proof.
Cut (Zero [:<]One[-]q).
Intro H0.
Cut (One[-]q [#]Zero).
Intro H3.
Cut (c[#]Zero).
Intro H1.
Cut (Zero [:<] ((One[-]q)[*](e[/]c[//]H1))).
Intro H2.
Elim (qi_yields_zero q zltq qlt1 (((One[-]q)[*](e[/]c[//]H1))) H2).
Intros N HN.
Exists N.
Intros m leNm.
Step_Rat_less_lft ((q[^]N[-]q[^]m)[/](One[-]q)[//]H3[*]c).
Apply shift_mult_less with H1.
Assumption.
Apply shift_div_less'.
Assumption.
Apply less_transitive_unfolded with q[^]N.
Step_Rat_less_lft (Zero [+](q[^]N[-]q[^]m)).
Apply shift_plus_less.
Step_Rat_less_rht q[^]m.
Apply nexp_resp_pos.
Assumption.
Assumption.
Apply mult_resp_pos.
Assumption.
Apply div_resp_pos.
Assumption.
Assumption.
Apply ap_symmetric_unfolded.
Apply less_imp_ap.
Assumption.
Apply ap_symmetric_unfolded.
Apply less_imp_ap.
Assumption.
Apply shift_less_minus.
Step_Rat_less_lft q.
Assumption.
Qed.

End N_Exists.

Section Seq_is_CC_CAuchy.
Variable n:nat.
Hypothesis lt0n :(lt (0) n).
Variable q:IR.
Hypothesis zltq :(Zero [:<] q).
Hypothesis qlt1 : (q [:<] One).
Variable c:IR.
Hypothesis zltc:(Zero [:<] c).
Local qmonz := (qltone IR q qlt1) : (q[-]One [#] Zero).
Local nrtq := (nroot_fun q n zltq lt0n) : IR.
Local nrtc := (nroot_fun c n zltc lt0n) : IR.
Local nrtqlt1 := (nroot_pres_lt1 q n zltq lt0n qlt1) :(nrtq [:<] One).
Local nrtqmonz := (qltone IR nrtq nrtqlt1) :(nrtq[-]One [#]Zero).

Definition zlt_nrtq := (nroot_pos q n zltq lt0n) :(Zero [:<] nrtq).
Definition zlt_nrtc := (nroot_pos c n zltc lt0n) :(Zero [:<] nrtc).

Lemma nrt_pow : (i:nat)(H:Zero [:<] q[^]i[*]c)
	(nroot_fun (q[^]i[*]c) n H lt0n)
		[=] (nrtq[^]i[*]nrtc).
Intros.
Apply root_unique with n.
Apply less_leEq. Apply nroot_pos.
Apply mult_resp_nonneg.
Apply nexp_resp_nonneg. Apply less_leEq. Exact zlt_nrtq.
Apply less_leEq. Exact zlt_nrtc.
Auto.
Step q[^]i[*]c.
Step_rht (nrtq[^]i)[^]n[*]nrtc[^]n.
Step_rht nrtq[^](mult i n)[*]nrtc[^]n.
Rewrite mult_sym.
Step_rht (nrtq[^]n)[^]i[*]nrtc[^]n.
Unfold nrtq. Unfold nrtc.
Apply bin_op_wd_unfolded.
Apply un_op_wd_unfolded.
Apply eq_symmetric_unfolded. Apply nroot_power.
Apply eq_symmetric_unfolded. Apply nroot_power.
Qed.

Lemma abs_pow_ltRe : (s : nat -> CC)
	((i:nat)(AbsCC (s (S i))[-](s i))[^]n [:<] q[^]i[*]c)
	-> ((i:nat)
          (AbsIR (Re (s (S i)))[-](Re (s i))) [:<] ((nrtq)[^]i[*]nrtc)).
Proof.
Intros s H i.
Apply less_wdl with (AbsIR (Re (s (S i))[-](s i))).
Apply leEq_less_trans with (AbsCC (s (S i))[-](s i)).
Apply absCC_absIR_re.
Generalize (H i).
Intro Hi.
Cut Zero [:<] q[^]i[*]c.
Intro H0.
Cut ((AbsCC (s (S i))[-](s i)) [:<] (nroot_fun (q[^]i[*]c) n H0 lt0n)).
Intro H1.
Apply less_wdr with (nroot_fun q[^]i[*]c n H0 lt0n).
Assumption.
Apply nrt_pow.
Apply power_cancel_less with n.
Apply less_leEq.
Apply nroot_pos.
Apply less_wdr with q[^]i[*]c.
Exact (H i).
Apply eq_symmetric_unfolded.
Apply nroot_power.
Apply mult_resp_pos.
Apply nexp_resp_pos.
Assumption.
Assumption.
Apply ABSIR_well_def.
Apply Re_resp_min.
Qed.

Lemma abs_pow_ltIm : (s : nat -> CC)
	((i:nat)(AbsCC (s (S i))[-](s i))[^]n [:<] q[^]i[*]c)
	-> ((i:nat)
          (AbsIR (Im (s (S i)))[-](Im (s i))) [:<] ((nrtq)[^]i[*]nrtc)).
Proof.
Intros s H i.
Apply less_wdl with (AbsIR (Im (s (S i))[-](s i))).
Apply leEq_less_trans with (AbsCC (s (S i))[-](s i)).
Apply absCC_absIR_im.
Generalize (H i).
Intro Hi.
Cut Zero [:<] q[^]i[*]c.
Intro H0.
Cut ((AbsCC (s (S i))[-](s i)) [:<] (nroot_fun (q[^]i[*]c) n H0 lt0n)).
Intro H1.
Apply less_wdr with (nroot_fun q[^]i[*]c n H0 lt0n).
Assumption.
Apply nrt_pow.
Apply power_cancel_less with n.
Apply less_leEq.
Apply nroot_pos.
Apply less_wdr with q[^]i[*]c.
Exact (H i).
Apply eq_symmetric_unfolded.
Apply nroot_power.
Apply mult_resp_pos.
Apply nexp_resp_pos.
Assumption.
Assumption.
Apply ABSIR_well_def.
Apply Im_resp_min.
Qed.

Lemma SublemmaRe:
	(s : nat -> CC)
	((i:nat)((AbsCC((s (S i))[-](s i)))[^]n  [:<] (q[^]i [*]c))) ->
	(N,m:nat)(le N m)->((AbsIR((Re(s m))[-](Re (s N)))) [:<=]
	((((nrtq[^]m [-] nrtq[^]N))[/](nrtq[-]One)[//]nrtqmonz)[*]nrtc ) ).
Proof.
Intros s Hi N m leNm.
Elim (le_lt_or_eq N m leNm).
Intro ltNm.
Generalize (diff_is_sum [j:nat](Re (s j)) N m ltNm).
Intro Hsum.
Generalize (ABSIR_well_def ?? Hsum). (* Use abs_wdIR *)
Intro Habseq.
Apply leEq_wdl with (ABSIR
                    (sum (IR) N (pred m)
                      [i:nat](Re (s (S i)))[-](Re (s i)))).
2: Apply eq_symmetric_unfolded; Apply Habseq.
Cut (le N (S (pred m))). Intro leNm'. 2: Omega.
Generalize (triangle_sumIR N (pred m)[i:nat](Re (s (S i)))[-](Re (s i)) leNm').
Intro Htri.
Apply leEq_transitive with (sum (IR) N (pred m)
                    [i:nat]
                     (csf_fun (IR) (IR) AbsIR
                       (Re (s (S i)))[-](Re (s i)))).
Exact Htri.
Generalize (sum_pres_less [i:nat]((AbsIR(Re (s (S i)))[-](Re (s i))))
	[i:nat]nrtq[^]i[*]nrtc (abs_pow_ltRe s Hi) N (pred m)).
Intro Hlt.
Apply leEq_transitive with (sum (IR) N (pred m) [i:nat]nrtq[^]i[*]nrtc).
Cut (le N (pred m)).
Intro leNpm.
Exact (Hlt leNpm).
Generalize (S_pred m N ltNm).
Intro Heq.
Apply lt_n_Sm_le.
Simpl.
Rewrite <- Heq.
Assumption.
Generalize (sum_c_exp nrtq nrtqmonz N (pred m)).
Intro Hs.
Generalize (sum_comm_scal [i:nat](nrtq[^]i) nrtc N (pred m)).
Intro Hs2.
EApply leEq_wdl.
2: Apply eq_symmetric_unfolded; Apply Hs2.
Apply mult_resp_leEq_rht.
Generalize (sum_c_exp nrtq nrtqmonz N (pred m)).
Intro Hs3.
Cut (S (pred m))=m.
Intro Heq.
Rewrite Heq in Hs3.
Apply eq_imp_leEq; Assumption.
Generalize (S_pred m N ltNm).
Auto.
Exact (less_leEq ??? zlt_nrtc).

Intro HNm.
Rewrite HNm.
Apply leEq_wdl with (AbsIR Zero).
Apply leEq_wdl with Zero::IR.
Apply leEq_wdr with Zero::IR.
Exact (leEq_reflexive ??).
Rational.
Apply eq_symmetric_unfolded; Exact AbsIRz_isz.
Apply ABSIR_well_def.
Rational.
Qed.


Lemma SublemmaIm:
	(s : nat -> CC)
	((i:nat)((AbsCC((s (S i))[-](s i)))[^]n  [:<] (q[^]i [*]c))) ->
	(N,m:nat)(le N m)->
	((AbsIR((Im(s m))[-](Im (s N)))) [:<=]
	((((nrtq[^]m [-] nrtq[^]N))[/](nrtq[-]One)[//]nrtqmonz)[*]nrtc ) ).
Proof.
Intros s Hi N m leNm.
Elim (le_lt_or_eq N m leNm).
Intro ltNm.
Generalize (diff_is_sum [j:nat](Im (s j)) N m ltNm).
Intro Hsum.
Generalize (ABSIR_well_def ?? Hsum). (* Use abs_wdIR *)
Intro Habseq.
Apply leEq_wdl with (ABSIR
                    (sum (IR) N (pred m)
                      [i:nat](Im (s (S i)))[-](Im (s i)))).
2: Apply eq_symmetric_unfolded; Apply Habseq.
Cut (le N (S (pred m))). Intro leNm'. 2: Omega.
Generalize (triangle_sumIR N (pred m)[i:nat](Im (s (S i)))[-](Im (s i)) leNm').
Intro Htri.
Apply leEq_transitive with (sum (IR) N (pred m)
                    [i:nat]
                     (csf_fun (IR) (IR) AbsIR
                       (Im (s (S i)))[-](Im (s i)))).
Exact Htri.
Generalize (sum_pres_less [i:nat]((AbsIR(Im (s (S i)))[-](Im (s i))))
	[i:nat]nrtq[^]i[*]nrtc (abs_pow_ltIm s Hi) N (pred m)).
Intro Hlt.
Apply leEq_transitive with (sum (IR) N (pred m) [i:nat]nrtq[^]i[*]nrtc).
Cut (le N (pred m)).
Intro leNpm.
Exact (Hlt leNpm).
Generalize (S_pred m N ltNm).
Intro Heq.
Apply lt_n_Sm_le.
Simpl.
Rewrite <- Heq.
Assumption.
Generalize (sum_c_exp nrtq nrtqmonz N (pred m)).
Intro Hs.
Generalize (sum_comm_scal [i:nat](nrtq[^]i) nrtc N (pred m)).
Intro Hs2.
EApply leEq_wdl.
2: Apply eq_symmetric_unfolded; Apply Hs2.
Apply mult_resp_leEq_rht.
Generalize (sum_c_exp nrtq nrtqmonz N (pred m)).
Intro Hs3.
Cut (S (pred m))=m.
Intro Heq.
Rewrite Heq in Hs3.
Apply eq_imp_leEq; Assumption.
Generalize (S_pred m N ltNm).
Auto.
Exact (less_leEq ??? zlt_nrtc).
Intro HNm.
Rewrite HNm.
Apply leEq_wdl with (AbsIR Zero).
Apply leEq_wdl with Zero::IR.
Apply leEq_wdr with Zero::IR.
Exact (leEq_reflexive ??).
Rational.
Apply eq_symmetric_unfolded; Exact AbsIRz_isz.
Apply ABSIR_well_def.
Rational.
Qed.

Lemma seq_is_CC_Cauchy :
	(s : nat -> CC)
	((i:nat)((AbsCC((s (S i))[-](s i)))[^]n  [:<] (q[^]i [*]c))) ->
	(CC_Cauchy_prop s).
Proof.
Unfold CC_Cauchy_prop.
Split.
(* Prove (Cauchy_prop (seq_re s)) *)
Unfold Cauchy_prop.
Intros e zlte.
Generalize (N_exists (*n lt0n*) nrtq zlt_nrtq nrtqlt1 nrtc zlt_nrtc e zlte ).
Intro Hex.
Elim Hex.
Intros N HN.
Exists N.
Intros m leNm.
Apply abs_eq_abssmall2.
Assumption.
Generalize (SublemmaRe s H N m leNm).
Intro H2.
Generalize (HN m leNm).
Intro H3.
EApply leEq_less_trans.
2:Apply H3.
Step_Rat_leEq_rht (nrtq[^]m[-]nrtq[^]N)[/](nrtq[-]One)[//]nrtqmonz[*]nrtc.
Exact H2.
(* Prove (Cauchy_prop (seq_im s)) *)
Unfold Cauchy_prop.
Intros e zlte.
Generalize (N_exists (*n lt0n*) nrtq zlt_nrtq nrtqlt1 nrtc zlt_nrtc e zlte ).
Intro Hex.
Elim Hex.
Intros N HN.
Exists N.
Intros m leNm.
Apply abs_eq_abssmall2.
Assumption.
Generalize (SublemmaIm s H N m leNm).
Intro H2.
Generalize (HN m leNm).
Intro H3.
EApply leEq_less_trans.
2:Apply H3.
Step_Rat_leEq_rht (nrtq[^]m[-]nrtq[^]N)[/](nrtq[-]One)[//]nrtqmonz[*]nrtc.
Exact H2.
Qed.

End Seq_is_CC_CAuchy.

(* To COrdFields *)
Lemma zero_lt_posplus1 : (x:IR)(Zero[:<=]x)-> (Zero[:<]x [+]One).
Proof.
Intros x zltx.
Apply leEq_less_trans with x.
Assumption.
Exact (less_plusOne ? x).
Qed.


(* Begin_Tex_Verb *)
Lemma fta_monic : (p: (cpoly CC);n:nat)(lt (0) n) ->
 (Monic n p)->
 (EX c | ( p ! c) [=] Zero).
(* End_Tex_Verb *)
Proof.
Intros p n H0n mon.
Generalize (seq_exists n  H0n ).
Intro H.
Elim H.
Intros q Hq.
Elim Hq.
Intros posq Hq1.
Elim Hq1.
Intros qlt10 Hq2.
Generalize (Hq2 p mon).
Intro Hq3.
Cut Zero[:<](AbsCC(p!(Zero))) [+]One.
Intro Hp.
Elim (Hq3 (AbsCC(p!(Zero)))[+]One).
Intros s Hs.
Cut ((i:nat)((AbsCC((s (S i))[-](s i)))[^]n [:<]
	(q[^]i [*]((AbsCC p!(Zero))[+]One)))).
Intro Hs2.
Cut (CC_Cauchy_prop s).
Intro Hs3.
Exists (LimCC (Build_CC_CauchySeq s Hs3)).
Apply CC_seqLimit_uniq with [n:nat](p!(s n)).
Exact (poly_pres_lim [x:CC](p!x) (contin_polyCC p)(Build_CC_CauchySeq s Hs3)).
Generalize (seq_yields_zero q posq qlt10 ((AbsCC(p!Zero))[+]One) Hp
	[n0:nat]p!(s n0)).
Intro H0. Apply H0.
Intro i. Generalize (Hs i).
Intro H1;Decompose [and] H1;Assumption.
Exact (seq_is_CC_Cauchy n H0n  q  posq qlt10
	((AbsCC p!(Zero))[+]One) Hp s Hs2).
Intro i;Generalize (Hs i);Intro Ha;Elim Ha;Intros;Assumption.
Exact (less_plusOne ? (AbsCC(p!(Zero)))).
Apply zero_lt_posplus1.
Apply AbsCC_nonneg.
Qed.

(* Begin_Tex_Verb *)
Lemma fta_reg : (p: (cpoly CC);n:nat)(lt (0) n) ->
 (Degree n p)->
 (EX c | ( p ! c) [=] Zero).
(* End_Tex_Verb *)
Intros.
Elim (fta_monic (poly_norm ? p n H0) n); Auto.
Intros. Exists x.
Apply poly_norm_apply with n H0; Auto.
Apply poly_norm_monic; Auto.
Qed.


