Section ycngstys.
Unset Standard Proposition Elimination Names.
Variable intr : Trajectory.
Definition thetat : R -> R := theta intr.
Definition Rs (t : R) : R :=
sqrt (Rsqr (xi intr t - xi intr 0) + Rsqr (yi intr t - yi intr 0)).
Axiom
alphas_exists :
{ f : Differential_D2 |
forall t : R,
xi intr t = (Rs t * cos (f t) + xi intr 0)%R /\
yi intr t = (Rs t * sin (f t) + yi intr 0)%R }.
Definition alphas := let (a,_) := alphas_exists in a.
unfold alphas in |- *; case alphas_exists; trivial.
Qed.
intros; generalize (alphas_def t); intro H; elim H; intros;
rewrite Rplus_comm; assumption.
Qed.
intros; generalize (alphas_def t); intro H; elim H; intros;
rewrite Rplus_comm; assumption.
Qed.
intros; rewrite Rsx; unfold Rminus, Rdiv in |- *;
rewrite (Rplus_comm (xi intr 0)); rewrite Rplus_assoc;
rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite Rmult_assoc;
rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r; reflexivity | assumption ].
Qed.
intros; rewrite Rsy; unfold Rminus, Rdiv in |- *;
rewrite (Rplus_comm (yi intr 0)); rewrite Rplus_assoc;
rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite Rmult_assoc;
rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r; reflexivity | assumption ].
Qed.
unfold derivable in |- *; intro.
case (total_order_T (cos (alphas x)) 0); intro.
elim s; intro.
cut (cos (alphas x) <> 0%R).
intro;
cut
(exists eps : posreal,
(forall h : R, (Rabs h < eps)%R -> cos (alphas (x + h)%R) <> 0%R)).
set (xi_p := fun t : R => xi intr t).
intro;
cut (derivable_pt (fun t : R => ((xi_p t - xi_p 0) / cos (alphas t))%R) x).
intro X; unfold derivable_pt in X; elim X; intros l H1.
unfold derivable_pt in |- *; exists l.
unfold derivable_pt_abs in H1; unfold derivable_pt_lim in H1;
unfold derivable_pt_abs in |- *; unfold derivable_pt_lim in |- *;
intros.
elim (H1 eps H2); intros del H3.
elim H0; intros dom H4.
cut (0 < Rmin del dom)%R.
intro; exists (mkposreal (Rmin del dom) H5); intros.
repeat rewrite Rs_x.
unfold xi_p in H3; apply H3.
assumption.
apply Rlt_le_trans with (Rmin del dom); [ apply H7 | apply Rmin_l ].
apply H.
apply H4; apply Rlt_le_trans with (Rmin del dom); [ apply H7 | apply Rmin_r ].
unfold Rmin in |- *; case (Rle_dec del dom); intro.
apply (cond_pos del).
apply (cond_pos dom).
set (alphas_p := d2 alphas); reg.
unfold alphas_p in |- *; apply (cond_D1 alphas).
apply (xi_derivable intr x).
set (alphas_p := d2 alphas); set (f := fun t : R => cos (alphas_p t)).
cut
(exists eps : posreal,
(forall h : R, (Rabs h < eps)%R -> f (x + h)%R <> 0%R)).
intro; elim H0; intros.
exists x0; intros; unfold f in H1; apply H1; assumption.
apply continuous_neq_0.
unfold f in |- *; reg; apply derivable_continuous_pt; apply (cond_D1 alphas).
apply H.
red in |- *; intro; rewrite H in a; elim (Rlt_irrefl _ a).
cut (sin (alphas x) <> 0%R).
intro;
cut
(exists eps : posreal,
(forall h : R, (Rabs h < eps)%R -> sin (alphas (x + h)%R) <> 0%R)).
set (yi_p := fun t : R => yi intr t).
intro;
cut (derivable_pt (fun t : R => ((yi_p t - yi_p 0) / sin (alphas t))%R) x).
intro X; unfold derivable_pt in X.
elim X; intros l H1.
unfold derivable_pt in |- *; exists l.
unfold derivable_pt_abs in H1; unfold derivable_pt_lim in H1;
unfold derivable_pt_abs in |- *; unfold derivable_pt_lim in |- *;
intros.
elim (H1 eps H2); intros del H3.
elim H0; intros dom H4.
cut (0 < Rmin del dom)%R.
intro; exists (mkposreal (Rmin del dom) H5); intros.
repeat rewrite Rs_y.
unfold yi_p in H3; apply H3.
assumption.
apply Rlt_le_trans with (Rmin del dom); [ apply H7 | apply Rmin_l ].
apply H.
apply H4; apply Rlt_le_trans with (Rmin del dom); [ apply H7 | apply Rmin_r ].
unfold Rmin in |- *; case (Rle_dec del dom); intro.
apply (cond_pos del).
apply (cond_pos dom).
set (alphas_p := d2 alphas); reg.
unfold alphas_p in |- *; apply (cond_D1 alphas).
apply (yi_derivable intr x).
set (alphas_p := d2 alphas); set (f := fun t : R => sin (alphas_p t)).
cut
(exists eps : posreal,
(forall h : R, (Rabs h < eps)%R -> f (x + h)%R <> 0%R)).
intro; elim H0; intros.
exists x0; intros; unfold f in H1; apply H1; assumption.
apply continuous_neq_0.
unfold f in |- *; reg; apply derivable_continuous_pt; apply (cond_D1 alphas).
apply H.
assert (H := cos_sin_0_var (alphas x)); elim H; intro.
elim H0; assumption.
exact H0.
cut (cos (alphas x) <> 0%R).
intro;
cut
(exists eps : posreal,
(forall h : R, (Rabs h < eps)%R -> cos (alphas (x + h)%R) <> 0%R)).
set (xi_p := fun t : R => xi intr t).
intro;
cut (derivable_pt (fun t : R => ((xi_p t - xi_p 0) / cos (alphas t))%R) x).
intro X; unfold derivable_pt in X; elim X; intros l H1.
unfold derivable_pt in |- *; exists l.
unfold derivable_pt_abs in H1; unfold derivable_pt_lim in H1;
unfold derivable_pt_abs in |- *; unfold derivable_pt_lim in |- *;
intros.
elim (H1 eps H2); intros del H3.
elim H0; intros dom H4.
cut (0 < Rmin del dom)%R.
intro; exists (mkposreal (Rmin del dom) H5); intros.
repeat rewrite Rs_x.
unfold xi_p in H3; apply H3.
assumption.
apply Rlt_le_trans with (Rmin del dom); [ apply H7 | apply Rmin_l ].
apply H.
apply H4; apply Rlt_le_trans with (Rmin del dom); [ apply H7 | apply Rmin_r ].
unfold Rmin in |- *; case (Rle_dec del dom); intro.
apply (cond_pos del).
apply (cond_pos dom).
set (alphas_p := d2 alphas); reg.
unfold alphas_p in |- *; apply (cond_D1 alphas).
apply (xi_derivable intr x).
set (alphas_p := d2 alphas); set (f := fun t : R => cos (alphas_p t)).
cut
(exists eps : posreal,
(forall h : R, (Rabs h < eps)%R -> f (x + h)%R <> 0%R)).
intro; elim H0; intros.
exists x0; intros; unfold f in H1; apply H1; assumption.
apply continuous_neq_0.
unfold f in |- *; reg; apply derivable_continuous_pt; apply (cond_D1 alphas).
apply H.
red in |- *; intro; rewrite H in r; elim (Rlt_irrefl _ r).
Qed.
Definition alphas_p : R -> R := d2 alphas.
intro; reg. apply (cond_D1 alphas).
apply Rs_derivable.
Qed.
intro.
assert (H := fct_der4).
replace (derive_pt (xi intr) t (xi_derivable intr t)) with
(derive_pt ((Rs * comp cos alphas_p)%F + fct_cte (xi intr 0)) t (H t)).
unfold plus_fct, mult_fct, comp, fct_cte in |- *.
set (H0 := Rs_derivable t).
cut (derivable_pt alphas_p t); [ intro X | apply (cond_D1 alphas) ].
replace (derive_pt alphas t (cond_D1 alphas t)) with (derive_pt alphas_p t X);
[ idtac | apply pr_nu ].
reg.
unfold comp, alphas_p in |- *; ring.
unfold derive_pt in |- *.
case (H t).
case (xi_derivable intr t).
simpl.
intros.
eapply uniqueness_limite.
unfold derivable_pt_abs in d0.
apply d0.
unfold derivable_pt_lim in |- *; intros.
unfold derivable_pt_abs in d; unfold derivable_pt_lim in d.
elim (d eps H0); intros.
exists x1; intros.
unfold plus_fct, mult_fct, comp, fct_cte in |- *.
assert (H4 := H1 _ H2 H3).
replace
((Rs (t + h) * cos (alphas_p (t + h)) + xi intr 0 -
(Rs t * cos (alphas_p t) + xi intr 0)) / h - x)%R with
((xi intr (t + h) - xi intr t) / h - x)%R.
apply H4.
rewrite (Rsx t).
rewrite (Rsx (t + h)).
replace
(xi intr 0 + Rs (t + h) * cos (alphas (t + h)) -
(xi intr 0 + Rs t * cos (alphas t)))%R with
(Rs (t + h) * cos (alphas_p (t + h)) + xi intr 0 -
(Rs t * cos (alphas_p t) + xi intr 0))%R.
reflexivity.
unfold alphas_p in |- *; ring.
Qed.
intro.
set (H := Rs_derivable t).
cut (derivable_pt alphas_p t); [ intro X | apply (cond_D1 alphas) ].
cut (derivable_pt ((Rs * comp sin alphas_p)%F + fct_cte (yi intr 0)) t);
[ intro X0 | reg ].
replace (derive_pt (yi intr) t (yi_derivable intr t)) with
(derive_pt ((Rs * comp sin alphas_p)%F + fct_cte (yi intr 0)) t X0).
replace (derive_pt alphas t (cond_D1 alphas t)) with (derive_pt alphas_p t X);
[ idtac | apply pr_nu ].
unfold plus_fct, mult_fct, comp, fct_cte in |- *.
reg.
unfold comp, alphas_p in |- *; ring.
unfold derive_pt in |- *.
case X0.
case (yi_derivable intr t).
simpl.
intros.
eapply uniqueness_limite.
unfold derivable_pt_abs in d0.
apply d0.
unfold derivable_pt_lim in |- *; intros.
unfold derivable_pt_abs in d; unfold derivable_pt_lim in d.
elim (d eps H0); intros.
exists x1; intros.
unfold plus_fct, mult_fct, comp, fct_cte in |- *.
assert (H4 := H1 _ H2 H3).
replace
((Rs (t + h) * sin (alphas_p (t + h)) + yi intr 0 -
(Rs t * sin (alphas_p t) + yi intr 0)) / h - x)%R with
((yi intr (t + h) - yi intr t) / h - x)%R.
apply H4.
rewrite (Rsy t).
rewrite (Rsy (t + h)).
replace
(yi intr 0 + Rs (t + h) * sin (alphas (t + h)) -
(yi intr 0 + Rs t * sin (alphas t)))%R with
(Rs (t + h) * sin (alphas_p (t + h)) + yi intr 0 -
(Rs t * sin (alphas_p t) + yi intr 0))%R.
reflexivity.
unfold alphas_p in |- *; ring.
Qed.
intro.
assert (H := Dxi t).
unfold xi in H.
assert (H0 := cond_x intr t).
cut
(derive_pt (x intr) t (xi_derivable intr t) =
derive_pt (x intr) t (cond_diff (x intr) t)); [ intro | apply pr_nu ].
rewrite H1 in H.
rewrite H0 in H.
unfold vi, thetat in |- *; symmetry  in |- *; assumption.
Qed.
intro; assert (H := Dyi t).
unfold yi in H; assert (H0 := cond_y intr t).
cut
(derive_pt (y intr) t (yi_derivable intr t) =
derive_pt (y intr) t (cond_diff (y intr) t)); [ intro | apply pr_nu ].
rewrite H1 in H.
rewrite H0 in H.
unfold vi, thetat in |- *; symmetry  in |- *; assumption.
Qed.
intros; rewrite H; rewrite H0; reflexivity.
Qed.
intro.
assert (H := DRs_cos t).
assert (H0 := DRs_sin t).
assert (H1 := Rmult_eq_compat_l (cos (alphas t)) _ _ H).
assert (H2 := Rmult_eq_compat_l (sin (alphas t)) _ _ H0).
replace (derive_pt Rs t (Rs_derivable t)) with
(cos (alphas t) *
(derive_pt Rs t (Rs_derivable t) * cos (alphas t) -
Rs t * sin (alphas t) * derive_pt alphas t (cond_D1 alphas t)) +
sin (alphas t) *
(derive_pt Rs t (Rs_derivable t) * sin (alphas t) +
Rs t * cos (alphas t) * derive_pt alphas t (cond_D1 alphas t)))%R.
replace (vi intr * cos (thetat t - alphas t))%R with
(cos (alphas t) * (vi intr * cos (thetat t)) +
sin (alphas t) * (vi intr * sin (thetat t)))%R.
apply eq_plus_eq_is_eq; assumption.
rewrite cos_minus; ring.
unfold Rminus in |- *.
repeat rewrite Rmult_plus_distr_l.
replace
(cos (alphas t) * (derive_pt Rs t (Rs_derivable t) * cos (alphas t)) +
cos (alphas t) *
- (Rs t * sin (alphas t) * derive_pt alphas t (cond_D1 alphas t)) +
(sin (alphas t) * (derive_pt Rs t (Rs_derivable t) * sin (alphas t)) +
sin (alphas t) *
(Rs t * cos (alphas t) * derive_pt alphas t (cond_D1 alphas t))))%R with
(derive_pt Rs t (Rs_derivable t) *
(Rsqr (sin (alphas t)) + Rsqr (cos (alphas t))) +
cos (alphas t) *
- (Rs t * sin (alphas t) * derive_pt alphas t (cond_D1 alphas t)) +
sin (alphas t) *
(Rs t * cos (alphas t) * derive_pt alphas t (cond_D1 alphas t)))%R;
[ idtac | unfold Rsqr in |- *; ring ].
rewrite sin2_cos2; ring.
Qed.
intro.
assert (H := DRs_cos t).
assert (H0 := DRs_sin t).
assert (H1 := Rmult_eq_compat_l (- sin (alphas t)) _ _ H).
assert (H2 := Rmult_eq_compat_l (cos (alphas t)) _ _ H0).
replace (Rs t * derive_pt alphas t (cond_D1 alphas t))%R with
(- sin (alphas t) *
(derive_pt Rs t (Rs_derivable t) * cos (alphas t) -
Rs t * sin (alphas t) * derive_pt alphas t (cond_D1 alphas t)) +
cos (alphas t) *
(derive_pt Rs t (Rs_derivable t) * sin (alphas t) +
Rs t * cos (alphas t) * derive_pt alphas t (cond_D1 alphas t)))%R.
replace (vi intr * sin (thetat t - alphas t))%R with
(- sin (alphas t) * (vi intr * cos (thetat t)) +
cos (alphas t) * (vi intr * sin (thetat t)))%R.
apply eq_plus_eq_is_eq; assumption.
rewrite sin_minus; ring.
unfold Rminus in |- *.
repeat rewrite Rmult_plus_distr_l.
replace
(- sin (alphas t) * (derive_pt Rs t (Rs_derivable t) * cos (alphas t)) +
- sin (alphas t) *
- (Rs t * sin (alphas t) * derive_pt alphas t (cond_D1 alphas t)) +
(cos (alphas t) * (derive_pt Rs t (Rs_derivable t) * sin (alphas t)) +
cos (alphas t) *
(Rs t * cos (alphas t) * derive_pt alphas t (cond_D1 alphas t))))%R with
(Rs t * derive_pt alphas t (cond_D1 alphas t) *
(Rsqr (sin (alphas t)) + Rsqr (cos (alphas t))) +
cos (alphas t) * - sin (alphas t) * derive_pt Rs t (Rs_derivable t) +
sin (alphas t) * cos (alphas t) * derive_pt Rs t (Rs_derivable t))%R;
[ idtac | unfold Rsqr in |- *; ring ].
rewrite sin2_cos2; ring.
Qed.
intro; set (alpha_p := d2 alphas);
set (f := fun x : R => derive_pt alpha_p x (cond_D1 alphas x)).
change (derivable_pt (fun y : R => (Rs y * f y)%R) t) in |- *.
reg.
apply (cond_D2 alphas).
apply Rs_derivable.
Qed.
intro.
set (f := fun x : R => derive_pt alphas x (cond_D1 alphas x)).
replace
(derive_pt (fun y : R => (Rs y * derive_pt alphas y (cond_D1 alphas y))%R) t
(fct_der5 t)) with
(derive_pt (fun y : R => (Rs y * f y)%R) t (fct_der5 t));
[ idtac | reflexivity ].
replace (derive_pt alphas t (cond_D1 alphas t)) with (f t);
[ idtac | reflexivity ].
replace (derive_pt (derive alphas (cond_D1 alphas)) t (cond_D2 alphas t))
with (derive_pt f t (cond_D2 alphas t)); [ idtac | reflexivity ].
cut (derivable_pt Rs t); [ intro X | apply Rs_derivable ].
cut (derivable_pt f t); [ intro X0 | apply (cond_D2 alphas) ].
reg.
replace (derive_pt f t (cond_D2 alphas t)) with (derive_pt f t X0);
[ idtac | apply pr_nu ].
replace (derive_pt Rs t (Rs_derivable t)) with (derive_pt Rs t X);
[ idtac | apply pr_nu ].
ring.
Qed.
unfold thetat in |- *; apply (cond_diff (theta intr)).
Qed.
intro.
cut (derivable_pt (fun x : R => (vi intr * sin (thetat x - alphas x))%R) t).
intro X.
replace
(derive_pt (fun y : R => (Rs y * derive_pt alphas y (cond_D1 alphas y))%R) t
(fct_der5 t)) with
(derive_pt (fun x : R => (vi intr * sin (thetat x - alphas x))%R) t X).
set (f := d2 alphas).
cut (derivable_pt f t); [ intro X0 | apply (cond_D1 alphas) ].
cut (derivable_pt thetat t); [ intro X1 | apply thetat_derivable ].
reg.
unfold fct_cte, minus_fct in |- *.
replace (derive_pt f t (cond_D1 alphas t)) with (derive_pt f t X0);
[ idtac | apply pr_nu ].
replace (derive_pt thetat t (thetat_derivable t)) with
(derive_pt thetat t X1); [ idtac | apply pr_nu ].
ring.
unfold derive_pt in |- *.
case X; case (fct_der5 t); simpl; intros.
eapply uniqueness_limite.
unfold derivable_pt_abs in d0; apply d0.
unfold derivable_pt_lim in |- *; intros.
unfold derivable_pt_abs in d; unfold derivable_pt_lim in d; elim (d eps H);
intros.
exists x1; intros.
do 2 rewrite <- Rs_alphas.
apply H0; assumption.
fold alphas_p in |- *; reg.
apply (cond_D1 alphas).
apply thetat_derivable.
Qed.
intro.
assert (H := D_Rs_alphas1 t).
assert (H0 := D_Rs_alphas2 t).
assert (H1 := DRs t).
rewrite H in H0; rewrite <- H1 in H0.
assert
(H2 :=
Rplus_eq_compat_l
(- derive_pt Rs t (Rs_derivable t) *
(derive_pt thetat t (thetat_derivable t) -
derive_pt alphas t (cond_D1 alphas t)) +
- Rs t * derive_pt (derive alphas (cond_D1 alphas)) t (cond_D2 alphas t))
_ _ H0).
cut
((- derive_pt Rs t (Rs_derivable t) *
(derive_pt thetat t (thetat_derivable t) -
derive_pt alphas t (cond_D1 alphas t)) +
- Rs t * derive_pt (derive alphas (cond_D1 alphas)) t (cond_D2 alphas t) +
(derive_pt Rs t (Rs_derivable t) * derive_pt alphas t (cond_D1 alphas t) +
Rs t * derive_pt (derive alphas (cond_D1 alphas)) t (cond_D2 alphas t)))%R =
(derive_pt Rs t (Rs_derivable t) *
(2 * derive_pt alphas t (cond_D1 alphas t) -
derive_pt thetat t (thetat_derivable t)))%R); [ intro | ring ].
cut
((- derive_pt Rs t (Rs_derivable t) *
(derive_pt thetat t (thetat_derivable t) -
derive_pt alphas t (cond_D1 alphas t)) +
- Rs t * derive_pt (derive alphas (cond_D1 alphas)) t (cond_D2 alphas t) +
derive_pt Rs t (Rs_derivable t) *
(derive_pt thetat t (thetat_derivable t) -
derive_pt alphas t (cond_D1 alphas t)))%R =
(- Rs t * derive_pt (derive alphas (cond_D1 alphas)) t (cond_D2 alphas t))%R);
[ intro | ring ].
rewrite H3 in H2; rewrite H4 in H2.
assumption.
Qed.
intro; rewrite <- Rsqr_mult; rewrite DRs; rewrite Rs_alphas;
repeat rewrite Rsqr_mult; rewrite Rplus_comm;
rewrite <- (Rmult_comm (Rsqr (cos (thetat t - alphas t))));
rewrite <- (Rmult_comm (Rsqr (sin (thetat t - alphas t))));
rewrite <- Rmult_plus_distr_r; rewrite sin2_cos2;
rewrite Rmult_1_l; reflexivity.
Qed.
intro; unfold Rs in |- *; apply sqrt_positivity; apply Rplus_le_le_0_compat;
apply Rle_0_sqr.
Qed.
unfold Rs in |- *; unfold Rminus in |- *; repeat rewrite Rplus_opp_r;
repeat rewrite Rsqr_0; rewrite Rplus_0_r; rewrite sqrt_0;
reflexivity.
Qed.
case (Rtotal_order 0 (derive_pt Rs 0 (Rs_derivable 0%R))); intro.
left; assumption.
elim H; intro.
right; assumption.
generalize (derivable_derive Rs 0 (Rs_derivable 0%R)); intro; elim H1;
intros l H2; rewrite H2 in H0.
generalize (derive_pt_eq_1 Rs 0 l (Rs_derivable 0%R) H2); intros;
cut (0 < - (l / 2))%R.
intro H4; elim (H3 (- (l / 2))%R H4).
intros; cut ((x / 2)%R <> 0%R).
intro H6; cut (Rabs (x / 2) < x)%R.
intro H7; generalize (H5 (x / 2)%R H6 H7); intro H8; rewrite Rs_0 in H8;
rewrite Rplus_0_l in H8; unfold Rminus in H8; rewrite Ropp_0 in H8;
rewrite Rplus_0_r in H8;
generalize (Rabs_def2 (Rs (x / 2) / (x / 2) + - l) (- (l / 2)) H8);
intro H9; elim H9; intros;
generalize
(Rplus_lt_compat_r l (Rs (x / 2) / (x / 2) + - l) (- (l / 2)) H10);
rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
replace (- (l / 2) + l)%R with (l / 2)%R.
intro H12; cut (l / 2 < 0)%R.
intro H13; generalize (Rlt_trans (Rs (x / 2) / (x / 2)) (l / 2) 0 H12 H13);
intro H14; unfold Rdiv in H14; cut (0 < x * / 2)%R.
intro H15;
generalize
(Rmult_lt_compat_r (x * / 2) (Rs (x * / 2) * / (x * / 2)) 0 H15 H14);
rewrite Rmult_0_l; rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
rewrite Rmult_1_r; intro H16;
elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rs (x * / 2)) 0 (Rs_pos (x * / 2)) H16)).
apply prod_neq_R0.
generalize (cond_pos x); intro H16; red in |- *; intro H17;
rewrite H17 in H16; elim (Rlt_irrefl 0 H16).
apply Rinv_neq_0_compat; discrR.
apply Rmult_lt_0_compat;
[ apply (cond_pos x) | apply Rinv_0_lt_compat; prove_sup0 ].
assert (Hyp : (0 < 2)%R).
prove_sup0.
unfold Rdiv in |- *;
generalize (Rmult_lt_compat_r (/ 2) l 0 (Rinv_0_lt_compat 2 Hyp) H0);
rewrite Rmult_0_l; intro H13; exact H13.
pattern l at 3 in |- *; rewrite double_var.
ring.
cut (0 < x / 2)%R.
intro H7; apply Rabs_def1.
pattern x at 1 in |- *; replace (pos x) with (2 * (x / 2))%R.
pattern (x / 2)%R at 1 in |- *; replace (x / 2)%R with (x / 2 + 0)%R.
replace (2 * (x / 2))%R with (x / 2 + x / 2)%R.
apply Rplus_lt_compat_l; assumption.
ring.
apply Rplus_0_r.
pattern (pos x) at 2 in |- *; rewrite double_var.
ring.
apply Rlt_trans with 0%R.
rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply (cond_pos x).
assumption.
unfold Rdiv in |- *; apply Rmult_lt_0_compat;
[ apply (cond_pos x) | apply Rinv_0_lt_compat; prove_sup0 ].
unfold Rdiv in |- *; apply prod_neq_R0.
generalize (cond_pos x); intro H6; red in |- *; intro H7; rewrite H7 in H6;
elim (Rlt_irrefl 0 H6).
apply Rinv_neq_0_compat; discrR.
assert (Hyp : (0 < 2)%R).
prove_sup0.
unfold Rdiv in |- *; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar;
generalize (Rmult_lt_compat_r (/ 2) l 0 (Rinv_0_lt_compat 2 Hyp) H0);
rewrite Rmult_0_l; intro H4; assumption.
Qed.
intros; rewrite H; reflexivity.
Qed.

(**********)
Lemma D_Rs_0_strong : (0 < derive_pt Rs 0 (Rs_derivable 0))%R.