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

Require Export Expon.
Require Export CPoly_ApZero.
Require Export CPoly_Contin.

Section Nested_Intervals.

Variables a,b : nat->IR.
Hypothesis a_mon : (i:nat)((a i) [:<=] (a (S i))).
Hypothesis b_mon : (i:nat)((b (S i)) [:<=] (b i)).
Hypothesis a_b : (i:nat)((a i) [:<] (b i)).
Hypothesis b_a : (eps:IR)(Zero [:<] eps) -> (EX i | (b i) [:<] (a i)[+]eps).

Lemma a_mon' : (i,j:nat)(le i j) -> ((a i) [:<=] (a j)).
Intros.
Induction j; Intros.
Rewrite <- (le_n_O_eq ? H). Apply leEq_reflexive.
Elim (le_lt_eq_dec ?? H); Intros.
Apply leEq_transitive with (a j).
Auto with arith.
Auto.
Rewrite <- y. Apply leEq_reflexive.
Qed.

Lemma b_mon' : (i,j:nat)(le i j) -> ((b j) [:<=] (b i)).
Intros.
Induction j; Intros.
Rewrite <- (le_n_O_eq ? H). Apply leEq_reflexive.
Elim (le_lt_eq_dec ?? H); Intros.
Apply leEq_transitive with (b j).
Auto.
Auto with arith.
Rewrite <- y. Apply leEq_reflexive.
Qed.

Lemma a_b' : (i,j:nat)((a i) [:<] (b j)).
Intros.
Elim (le_lt_dec i j); Intro.
Apply leEq_less_trans with (a j).
Apply a_mon'. Auto.
Auto.
Apply less_leEq_trans with (b i).
Auto.
Apply b_mon'. Auto with arith.
Qed.

Lemma intervals_cauchy : (Cauchy_prop a).
Unfold Cauchy_prop.
Unfold absSmall.
Intro eps. Intros.
Elim (b_a eps H). Intro n. Intros. Exists n.
Intro i. Intros.
Split.
Apply less_leEq_trans with Zero::IR.
Step_less_rht [--]Zero::IR.
Apply min_resp_less. Auto.
Step_leEq_lft (a n)[-](a n).
Apply minus_resp_leEq.
Apply a_mon'. Auto.
Apply shift_minus_less'.
Apply less_transitive_unfolded with (b n).
Apply a_b'.
Auto.
Qed.

Local a' := (Build_CauchySeq ? a intervals_cauchy).

Lemma nested_intervals_limit :
  (EX z | ((i:nat)((a i) [:<=] z)) /\ ((i:nat)(z [:<=] (b i)))).
Exists (Lim a').
Split; Intros.
Unfold leEq. Unfold not. Intros.
Elim (Lim_less_so_seq_less a' (a i)). Intro n. Intros.
Elim (le_lt_dec n i); Intro.
Cut ~((a i) [:<] (a i)). Intro.
Unfold not in H1. Apply H1. Apply H0. Auto.
Apply less_irreflexive_unfolded.
Cut (i,j:nat)(le i j) -> ((a i) [:<=] (a j)). Intro a_mon''.
Unfold leEq in a_mon''. Unfold not in a_mon''.
Apply a_mon'' with i n. Auto with arith.
Apply H0.
Auto.
Intros. Apply a_mon'; Auto.
Auto.
Unfold leEq. Unfold not. Intros.
Elim (less_Lim_so_less_seq a' (b i) H). Intro n. Intros.
Elim (le_lt_dec n i); Intro.
Cut ~((a i) [:<] (b i)). Unfold not. Intro.
Apply H1. Auto. Apply less_antisymmetric_unfolded.
Apply H0.
Auto.
Cut ~((a n) [:<] (b n)). Unfold not. Intro.
Apply H1. Auto. Apply less_antisymmetric_unfolded.
Apply leEq_less_trans with (b i).
Apply b_mon'. Auto with arith.
Apply H0. Auto.
Qed.

Variable f : (CSetoid_un_op IR).
Hypothesis f_contin : (contin f).

Lemma f_contin_pos :
  (z:IR)(Zero [:<] (f z)) ->
    (EX eps | (Zero [:<] eps) /\
      ((x:IR)(x [:<] z[+]eps) -> (z [:<] x[+]eps) -> (Zero [:<] (f x)))).
Intros.
Unfold contin in f_contin.
Unfold continAt in f_contin.
Unfold funLim in f_contin.
Unfold absSmall in f_contin.
Elim (f_contin z (f z) H). Intro eps. Intros. Elim H0. Intros.
Exists eps.
Split. Auto. Intros.
Elim (H2 x). Intros.
Step_less_lft (f z)[-](f z).
Apply shift_minus_less.
Apply shift_less_plus'. Auto.
Split.
Apply shift_less_minus.
Step_Rat_less_lft x[-]eps.
Apply shift_minus_less. Auto.
Apply shift_minus_less'. Auto.
Qed.

Lemma f_contin_neg :
  (z:IR)((f z) [:<] Zero) ->
    (EX eps | (Zero [:<] eps) /\
      ((x:IR)(x [:<] z[+]eps) -> (z [:<] x[+]eps) -> ((f x) [:<] Zero))).
Intros.
Unfold contin in f_contin.
Unfold continAt in f_contin.
Unfold funLim in f_contin.
Unfold absSmall in f_contin.
Cut Zero [:<] [--](f z). Intro.
Elim (f_contin z [--](f z) H0). Intro eps. Intros. Elim H1. Intros.
Exists eps.
Split. Auto. Intros.
Elim (H3 x). Intros.
Step_Rat_less_rht (f z)[-][--][--](f z).
Apply shift_less_minus'.
Apply shift_plus_less. Auto.
Split.
Apply shift_less_minus.
Step_Rat_less_lft x[-]eps.
Apply shift_minus_less. Auto.
Apply shift_minus_less'. Auto.
Step_less_lft [--]Zero::IR.
Apply min_resp_less. Auto.
Qed.

Hypothesis f_a : (i:nat)((f (a i)) [:<=] Zero).
Hypothesis f_b : (i:nat)(Zero [:<=] (f (b i))).

Lemma nested_intervals_zero :
  (EX z | ((a (0)) [:<=] z) /\ (z [:<=] (b (0))) /\ ((f z) [=] Zero)).
Elim nested_intervals_limit. Intro z. Intros. Exists z.
Elim H. Intros.
Split. Auto. Split. Auto.
Apply not_ap_imp_eq.
Unfold not.
Intros.
Elim (ap_imp_less ??? H2); Intros.
Elim (f_contin_neg z H3). Intro eps. Intros. Elim H4. Intros.
Elim (b_a eps). Intro i. Intros.
Cut (b i) [:<] z[+]eps. Intro.
Cut z [:<] (b i)[+]eps. Intro.
Unfold leEq in f_b. Unfold not in f_b.
Apply f_b with i. Apply H6. Auto. Auto.
Apply leEq_less_trans with (b i). Auto.
Step_less_lft (b i)[+]Zero. Apply plus_resp_less_lft. Auto.
Apply less_leEq_trans with (a i)[+]eps. Auto.
Apply plus_resp_leEq. Auto. Auto.
Elim (f_contin_pos z H3). Intro eps. Intros. Elim H4. Intros.
Elim (b_a eps). Intro i. Intros.
Cut (a i) [:<] z[+]eps. Intro.
Cut z [:<] (a i)[+]eps. Intro.
Unfold leEq in f_a. Unfold not in f_a.
Apply f_a with i. Apply H6. Auto. Auto.
Apply leEq_less_trans with (b i). Auto.
Auto. Auto.
Apply leEq_less_trans with z. Auto.
Step_less_lft z[+]Zero. Apply plus_resp_less_lft. Auto.
Auto.
Qed.

End Nested_Intervals.


Section Bisection.

Variable f : (CSetoid_un_op IR).
Hypothesis f_apzero_interval : (a,b:IR)(a [:<] b) ->
  (EX c | (a [:<] c) /\ (c [:<] b) /\ ((f c) [#] Zero)).
Variable a,b : IR.
Hypothesis a_b : a [:<] b.
Hypothesis f_a : (f a) [:<=] Zero.
Hypothesis f_b : Zero [:<=] (f b).

Local Small : IR := Two[/]ThreeNZ.
Local lft := (Two[*]a[+]b)[/]ThreeNZ.
Local rht := (a[+]Two[*]b)[/]ThreeNZ.

Lemma a_lft : a [:<] lft.
Unfold lft.
Apply shift_less_div.
Apply pos_three.
Step_Rat_less_lft Two[*]a[+]a.
Apply plus_resp_less_lft.
Auto.
Qed.

Lemma rht_b : rht [:<] b.
Unfold rht.
Apply shift_div_less.
Apply pos_three.
Step_Rat_less_rht b[+]Two[*]b.
Apply plus_resp_less_rht.
Auto.
Qed.

Lemma lft_rht : lft [:<] rht.
Unfold lft. Unfold rht.
Apply div_resp_less_rht.
Step_Rat_less_lft (a[+]b)[+]a.
Step_Rat_less_rht (a[+]b)[+]b.
Apply plus_resp_less_lft.
Auto.
Apply pos_three.
Qed.

Lemma smaller_lft : rht[-]a [=] Small[*](b[-]a).
Unfold Small. Unfold rht.
Rational.
Qed.

Lemma smaller_rht : b[-]lft [=] Small[*](b[-]a).
Unfold Small. Unfold lft.
Rational.
Qed.

Hints Resolve smaller_lft smaller_rht : algebra.

Lemma bisect'' :
  (EX c |
    (a [:<] c) /\ (c [:<] b) /\
    (c[-]a [:<] Small[*](b[-]a)) /\ (b[-]c [:<] Small[*](b[-]a)) /\
    (((f c) [:<=] Zero) \/ (Zero [:<=] (f c)))).
Elim (f_apzero_interval lft rht lft_rht). Intro c. Intros.
Elim H. Intros. Elim H1. Intros.
Exists c.
Split. Apply less_transitive_unfolded with lft. Apply a_lft. Auto.
Split. Apply less_transitive_unfolded with rht. Auto. Apply rht_b.
Split. Step_less_rht rht[-]a. Apply minus_resp_less. Auto.
Split. Step_less_rht b[-]lft. Apply minus_resp_less_rht. Auto.
Elim (ap_imp_less ??? H3); Intros.
Left. Apply less_leEq. Auto.
Right. Apply less_leEq. Auto.
Qed.

Lemma bisect' :
  (EX a' | (EX b' |
    (a [:<=] a') /\ (a' [:<] b') /\ (b' [:<=] b) /\
    (b'[-]a' [:<] Small[*](b[-]a)) /\
    ((f a') [:<=] Zero) /\ (Zero [:<=] (f b')))).
Elim bisect''. Intro c. Intros.
Elim H. Intros. Elim H1. Intros. Elim H3. Intros. Elim H5. Intros.
Elim H7; Intros.
Exists c. Exists b.
Split. Apply less_leEq. Auto. Split. Auto. Split. Apply leEq_reflexive.
Split. Auto. Split. Auto. Auto.
Exists a. Exists c.
Split. Apply leEq_reflexive. Split. Auto. Split. Apply less_leEq. Auto.
Split. Auto. Split. Auto. Auto.
Qed.

End Bisection.


Section Bisect_Interval.

Variable f : (CSetoid_un_op IR).
Hypothesis f_apzero_interval : (a,b:IR)(a [:<] b) ->
  (EX c | (a [:<] c) /\ (c [:<] b) /\ ((f c) [#] Zero)).

Local Small : IR := Two[/]ThreeNZ.

Record bisect_interval : Set :=
  { interval_lft     : IR;
    interval_rht     : IR;
    interval_lft_rht : interval_lft [:<] interval_rht;
    interval_f_lft   : (f interval_lft) [:<=] Zero;
    interval_f_rht   : Zero [:<=] (f interval_rht)
  }.

Lemma bisect_exists : (I:bisect_interval)
  (EX I' |
    ((interval_rht I')[-](interval_lft I') [:<]
      Small[*]((interval_rht I)[-](interval_lft I))) /\
    ((interval_lft I) [:<=] (interval_lft I')) /\
    ((interval_rht I') [:<=] (interval_rht I))).
Intros.
Elim (bisect' f f_apzero_interval
  ?? (interval_lft_rht I) (interval_f_lft I) (interval_f_rht I)).
Intro lft. Intros.
Elim H. Intro rht. Intros.
Elim H0. Intros. Elim H2. Intros. Elim H4. Intros. Elim H6. Intros.
Elim H8. Intros.
Exists (Build_bisect_interval lft rht H3 H9 H10).
Simpl.
Unfold Small.
Split. Auto. Split. Auto. Auto.
Qed.

Definition bisect : bisect_interval -> bisect_interval :=
  [I:bisect_interval]
    (proj1_sig ?? (ex_informative ?
      [I':bisect_interval]
        (((interval_rht I')[-](interval_lft I') [:<]
          Small[*]((interval_rht I)[-](interval_lft I))) /\
        ((interval_lft I) [:<=] (interval_lft I')) /\
        ((interval_rht I') [:<=] (interval_rht I)))
      (bisect_exists I))).

Lemma bisect_prop : (I:bisect_interval)
  (((interval_rht (bisect I))[-](interval_lft (bisect I)) [:<]
    Small[*]((interval_rht I)[-](interval_lft I))) /\
  ((interval_lft I) [:<=] (interval_lft (bisect I))) /\
  ((interval_rht (bisect I)) [:<=] (interval_rht I))).
Intros.
Unfold bisect.
Apply proj2_sig with P :=
      [I':bisect_interval]
        (((interval_rht I')[-](interval_lft I') [:<]
          Small[*]((interval_rht I)[-](interval_lft I))) /\
        ((interval_lft I) [:<=] (interval_lft I')) /\
        ((interval_rht I') [:<=] (interval_rht I))).
Qed.

End Bisect_Interval.


Section IVT_Op.

Variable f : (CSetoid_un_op IR).
Hypothesis f_contin : (contin f).
Hypothesis f_apzero_interval : (a,b:IR)(a [:<] b) ->
  (EX c | (a [:<] c) /\ (c [:<] b) /\ ((f c) [#] Zero)).
Variable a,b : IR.
Hypothesis a_b : a [:<] b.
Hypothesis f_a : (f a) [:<=] Zero.
Hypothesis f_b : Zero [:<=] (f b).

Local Small : IR := Two[/]ThreeNZ.

Fixpoint interval_sequence [n:nat] : (bisect_interval f) :=
  Cases n of
    O => (Build_bisect_interval f a b a_b f_a f_b)
  | (S m) => (bisect f f_apzero_interval (interval_sequence m))
  end.

Local a_ := [i:nat](interval_lft ? (interval_sequence i)).
Local b_ := [i:nat](interval_rht ? (interval_sequence i)).

Lemma intervals_smaller :
  (i:nat)((b_ i)[-](a_ i) [:<=] Small[^]i[*](b[-]a)).
Intros.
Induction i; Intros.
Unfold a_. Unfold b_. Simpl.
Step_Rat_leEq_rht b[-]a.
Apply leEq_reflexive.
Apply leEq_transitive with Small[*]((b_ i)[-](a_ i)).
Apply less_leEq.
Elim (bisect_prop f f_apzero_interval (interval_sequence i)). Auto.
Simpl.
Replace (nexp ? Small i) with Small[^]i. 2: Auto.
Step_Rat_leEq_rht Small[*](Small[^]i[*](b[-]a)).
Apply mult_resp_leEq_lft.
Auto.
Apply less_leEq.
Unfold Small. Apply div_resp_pos. Apply pos_three. Apply pos_two.
Qed.

Lemma intervals_small'' : (i:nat)(Small[^]i[*](Nring i) [:<] One).
Intros.
Apply mult_cancel_less with (Three[^]i)::IR.
Apply nexp_resp_pos. Apply pos_three.
Step_less_rht (Three[^]i)::IR.
Step_Rat_less_lft (Nring i)[*](Small[^]i[*]Three[^]i).
Step_less_lft (Nring i)[*]((Small[*]Three)[^]i).
Cut Small[*]Three [=] Two. Intro.
2: Unfold Small. 2: Rational.
Step_less_lft ((Nring i)[*]Two[^]i)::IR.
Induction i.
Simpl. Step_less_lft Zero::IR. Apply pos_one.
Elim (zerop i); Intros.
Rewrite y. Simpl.
Step_Rat_less_lft Zero[+]Two::IR. Step_Rat_less_rht One[+]Two::IR.
Apply plus_resp_less_rht. Apply pos_one.
Elim (le_lt_or_eq ?? (lt_le_S ?? y)); Intros.
Apply mult_cancel_less with (Nring i)::IR.
Step_less_lft (Nring (0))::IR. Apply nring_less. Auto.
Replace (Two[^](S i))::IR with Two[^]i[*]Two::IR. 2: Auto.
Step_Rat_less_lft ((Nring (S i))[*]Two)[*]((Nring i)[*]Two[^]i)::IR.
Replace (Three[^](S i))::IR with Three[^]i[*]Three::IR. 2: Auto.
Step_Rat_less_rht (((Nring i)[*]Three)[*]Three[^]i)::IR.
Apply leEq_less_trans with ((Nring i)[*]Three)[*]((Nring i)[*]Two[^]i)::IR.
Apply mult_resp_leEq_rht.
Simpl.
Step_Rat_leEq_lft (Nring i)[*]Two[+]Two::IR.
Step_Rat_leEq_rht (Nring i)[*]Two[+](Nring i)::IR.
Apply plus_resp_leEq_lft.
Elim (le_lt_or_eq ?? (lt_le_S ?? H0)); Intros.
Apply less_leEq. Apply nring_less. Auto.
Rewrite <- H1. Apply leEq_reflexive.
Apply less_leEq. Apply mult_resp_pos.
Step_less_lft (Nring (0))::IR. Apply nring_less. Auto.
Apply nexp_resp_pos. Apply pos_two.
Apply mult_resp_less_lft. Auto.
Apply mult_resp_pos.
Step_less_lft (Nring (0))::IR. Apply nring_less. Auto.
Apply pos_three.
Rewrite <- H0.
Step_Rat_less_lft (Nring (8))[+]Zero::IR.
Step_Rat_less_rht (Nring (8))[+]One::IR.
Apply plus_resp_less_lft. Apply pos_one.
Qed.

Lemma intervals_small' :
  (eps:IR)(Zero [:<] eps) -> (EX i | Small[^]i[*](b[-]a) [:<] eps).
Intros.
Cut eps [#] Zero. Intro.
Elim (Archimedes (b[-]a)[/]eps[//]H0). Intro i. Intros. Exists i.
Step_less_rht eps[*]One.
Apply shift_less_mult' with H0. Auto.
Step_less_lft Small[^]i[*]((b[-]a)[/]eps[//]H0).
Apply less_transitive_unfolded with Small[^]i[*](Nring i).
Apply mult_resp_less_lft.
Auto.
Apply nexp_resp_pos.
Step_less_lft Zero::IR[/]ThreeNZ. Unfold Small.
Apply div_resp_less_rht. Apply pos_two. Apply pos_three.
Apply intervals_small''.
Apply Greater_imp_ap. Auto.
Qed.

Lemma intervals_small :
  (eps:IR)(Zero [:<] eps) -> (EX i | (b_ i) [:<] (a_ i)[+]eps).
Intros.
Elim (intervals_small' eps H). Intro i. Intros. Exists i.
Apply shift_less_plus'.
Apply leEq_less_trans with Small[^]i[*](b[-]a).
Apply intervals_smaller.
Auto.
Qed.

Lemma ivt_op :
  (EX z | (a [:<=] z) /\ (z [:<=] b) /\ ((f z) [=] Zero)).
Cut (i:nat)((a_ i) [:<=] (a_ (S i))). Intro.
Cut (i:nat)((b_ (S i)) [:<=] (b_ i)). Intro.
Cut (i:nat)((a_ i) [:<] (b_ i)). Intro.
Cut (i:nat)((f (a_ i)) [:<=] Zero). Intro.
Cut (i:nat)(Zero [:<=] (f (b_ i))). Intro.
Elim (nested_intervals_zero a_ b_ H H0 H1 intervals_small f f_contin H2 H3).
Intro z. Intros. Exists z.
Exact H4.
Intros. Exact (interval_f_rht ? (interval_sequence i)).
Intros. Exact (interval_f_lft ? (interval_sequence i)).
Intros. Exact (interval_lft_rht ? (interval_sequence i)).
Intros. Elim (bisect_prop f f_apzero_interval (interval_sequence i)).
Intros. Elim H1. Intros.
Unfold b_. Simpl. Auto.
Intros. Elim (bisect_prop f f_apzero_interval (interval_sequence i)).
Intros. Elim H0. Intros.
Unfold a_. Simpl. Auto.
Qed.

End IVT_Op.


Section IVT_Poly.

Lemma ivt_poly :
  (f:(cpoly_cring IR))(f [#] Zero) ->
  (a,b:IR)(a [:<] b) -> (f!a [:<=] Zero) -> (Zero [:<=] f!b) ->
    (EX x | (a [:<=] x) /\ (x [:<=] b) /\ (f!x [=] Zero)).
Intros.
Cut (EX x |
  (a [:<=] x) /\ (x [:<=] b) /\ (((cpoly_csetoid_op ? f) x) [=] Zero)).
Intro. Auto.
Apply ivt_op; Auto.
Apply cpoly_op_contin.
Intros.
Change (EX c:IR |
  (a0 [:<] c) /\ (c [:<] b0) /\ ((f!c) [#] Zero)).
Apply poly_apzero_interval; Auto.
Qed.

End IVT_Poly.


